Adjust to new HPath API
This commit is contained in:
parent
5fc77f6b24
commit
41e2ae6131
3
.gitmodules
vendored
3
.gitmodules
vendored
@ -1,6 +1,3 @@
|
||||
[submodule "3rdparty/hpath"]
|
||||
path = 3rdparty/hpath
|
||||
url = https://github.com/hasufell/hpath.git
|
||||
[submodule "3rdparty/simple-sendfile"]
|
||||
path = 3rdparty/simple-sendfile
|
||||
url = https://github.com/hasufell/simple-sendfile.git
|
||||
|
||||
2
3rdparty/hpath
vendored
2
3rdparty/hpath
vendored
@ -1 +1 @@
|
||||
Subproject commit 6638cd8cc1f40e3183039186b7c5d4cccc4aa7f7
|
||||
Subproject commit b9b46583fac6aa34b80524a907c13b8f42dcdfcb
|
||||
1
3rdparty/simple-sendfile
vendored
1
3rdparty/simple-sendfile
vendored
@ -1 +0,0 @@
|
||||
Subproject commit 869c69d3365b61831243989b81f26a2364f24f61
|
||||
@ -24,7 +24,6 @@ Installation
|
||||
git submodule update --init --recursive
|
||||
cabal sandbox init
|
||||
cabal sandbox add-source 3rdparty/hpath
|
||||
cabal sandbox add-source 3rdparty/simple-sendfile
|
||||
cabal install alex happy
|
||||
export PATH="$(pwd)/.cabal-sandbox/bin:$PATH"
|
||||
cabal install gtk2hs-buildtools
|
||||
|
||||
47
hsfm.cabal
47
hsfm.cabal
@ -24,8 +24,6 @@ data-files:
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
HSFM.FileSystem.Errors
|
||||
HSFM.FileSystem.FileOperations
|
||||
HSFM.FileSystem.FileType
|
||||
HSFM.FileSystem.UtilTypes
|
||||
HSFM.Utils.IO
|
||||
@ -34,21 +32,14 @@ library
|
||||
build-depends:
|
||||
base >= 4.7,
|
||||
bytestring,
|
||||
containers,
|
||||
data-default,
|
||||
filepath >= 1.3.0.0,
|
||||
hinotify-bytestring,
|
||||
hpath,
|
||||
mtl >= 2.2,
|
||||
old-locale >= 1,
|
||||
process,
|
||||
safe,
|
||||
simple-sendfile,
|
||||
stm,
|
||||
time >= 1.4.2,
|
||||
unix,
|
||||
unix-bytestring,
|
||||
utf8-string
|
||||
unix
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
Default-Extensions: RecordWildCards
|
||||
@ -80,7 +71,6 @@ executable hsfm-gtk
|
||||
Cabal >= 1.22.0.0,
|
||||
base >= 4.7,
|
||||
bytestring,
|
||||
containers,
|
||||
data-default,
|
||||
filepath >= 1.3.0.0,
|
||||
glib >= 0.13,
|
||||
@ -88,7 +78,6 @@ executable hsfm-gtk
|
||||
hinotify-bytestring,
|
||||
hpath,
|
||||
hsfm,
|
||||
mtl >= 2.2,
|
||||
old-locale >= 1,
|
||||
process,
|
||||
safe,
|
||||
@ -112,37 +101,3 @@ executable hsfm-gtk
|
||||
-Wall
|
||||
"-with-rtsopts=-N"
|
||||
|
||||
|
||||
Test-Suite spec
|
||||
Type: exitcode-stdio-1.0
|
||||
Default-Language: Haskell2010
|
||||
Hs-Source-Dirs: test
|
||||
Main-Is: Main.hs
|
||||
other-modules:
|
||||
Spec
|
||||
FileSystem.FileOperations.CopyDirRecursiveSpec
|
||||
FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec
|
||||
FileSystem.FileOperations.CopyFileSpec
|
||||
FileSystem.FileOperations.CopyFileOverwriteSpec
|
||||
FileSystem.FileOperations.CreateDirSpec
|
||||
FileSystem.FileOperations.CreateRegularFileSpec
|
||||
FileSystem.FileOperations.DeleteDirRecursiveSpec
|
||||
FileSystem.FileOperations.DeleteDirSpec
|
||||
FileSystem.FileOperations.DeleteFileSpec
|
||||
FileSystem.FileOperations.GetDirsFilesSpec
|
||||
FileSystem.FileOperations.GetFileTypeSpec
|
||||
FileSystem.FileOperations.MoveFileSpec
|
||||
FileSystem.FileOperations.MoveFileOverwriteSpec
|
||||
FileSystem.FileOperations.RecreateSymlinkSpec
|
||||
FileSystem.FileOperations.RenameFileSpec
|
||||
Utils
|
||||
GHC-Options: -Wall
|
||||
Build-Depends: base
|
||||
, HUnit
|
||||
, bytestring
|
||||
, hpath
|
||||
, hsfm
|
||||
, hspec >= 1.3
|
||||
, process
|
||||
, unix
|
||||
, utf8-string
|
||||
|
||||
@ -1,343 +0,0 @@
|
||||
{--
|
||||
HSFM, a filemanager written in Haskell.
|
||||
Copyright (C) 2016 Julian Ospald
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
version 2 as published by the Free Software Foundation.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
--}
|
||||
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
-- |Provides error handling.
|
||||
module HSFM.FileSystem.Errors where
|
||||
|
||||
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
(
|
||||
forM
|
||||
, when
|
||||
)
|
||||
import Data.ByteString
|
||||
(
|
||||
ByteString
|
||||
)
|
||||
import Data.Data
|
||||
(
|
||||
Data(..)
|
||||
)
|
||||
import Data.Typeable
|
||||
import Foreign.C.Error
|
||||
(
|
||||
getErrno
|
||||
, Errno
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType
|
||||
)
|
||||
import qualified HPath as P
|
||||
import HPath
|
||||
(
|
||||
Abs
|
||||
, Path
|
||||
)
|
||||
import HPath.IO
|
||||
(
|
||||
canonicalizePath
|
||||
)
|
||||
import HSFM.Utils.IO
|
||||
import System.IO.Error
|
||||
(
|
||||
catchIOError
|
||||
, ioeGetErrorType
|
||||
)
|
||||
|
||||
import qualified System.Posix.Directory.ByteString as PFD
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
fileAccess
|
||||
, getFileStatus
|
||||
)
|
||||
import qualified System.Posix.Files.ByteString as PF
|
||||
|
||||
|
||||
data FmIOException = FileDoesNotExist ByteString
|
||||
| DirDoesNotExist ByteString
|
||||
| PathNotAbsolute ByteString
|
||||
| FileNotExecutable ByteString
|
||||
| SameFile ByteString ByteString
|
||||
| NotAFile ByteString
|
||||
| NotADir ByteString
|
||||
| DestinationInSource ByteString ByteString
|
||||
| FileDoesExist ByteString
|
||||
| DirDoesExist ByteString
|
||||
| IsSymlink ByteString
|
||||
| InvalidOperation String
|
||||
| InvalidFileName
|
||||
| Can'tOpenDirectory ByteString
|
||||
| CopyFailed String
|
||||
| MoveFailed String
|
||||
deriving (Typeable, Eq, Data)
|
||||
|
||||
|
||||
instance Show FmIOException where
|
||||
show (FileDoesNotExist fp) = "File does not exist:" ++ P.fpToString fp
|
||||
show (DirDoesNotExist fp) = "Directory does not exist: "
|
||||
++ P.fpToString fp
|
||||
show (PathNotAbsolute fp) = "Path not absolute: " ++ P.fpToString fp
|
||||
show (FileNotExecutable fp) = "File not executable: "
|
||||
++ P.fpToString fp
|
||||
show (SameFile fp1 fp2) = P.fpToString fp1
|
||||
++ " and " ++ P.fpToString fp2
|
||||
++ " are the same file!"
|
||||
show (NotAFile fp) = "Not a file: " ++ P.fpToString fp
|
||||
show (NotADir fp) = "Not a directory: " ++ P.fpToString fp
|
||||
show (DestinationInSource fp1 fp2) = P.fpToString fp1
|
||||
++ " is contained in "
|
||||
++ P.fpToString fp2
|
||||
show (FileDoesExist fp) = "File does exist: " ++ P.fpToString fp
|
||||
show (DirDoesExist fp) = "Directory does exist: " ++ P.fpToString fp
|
||||
show (IsSymlink fp) = "Is a symlink: " ++ P.fpToString fp
|
||||
show (InvalidOperation str) = "Invalid operation: " ++ str
|
||||
show InvalidFileName = "Invalid file name!"
|
||||
show (Can'tOpenDirectory fp) = "Can't open directory: "
|
||||
++ P.fpToString fp
|
||||
show (CopyFailed str) = "Copying failed: " ++ str
|
||||
show (MoveFailed str) = "Moving failed: " ++ str
|
||||
|
||||
|
||||
|
||||
instance Exception FmIOException
|
||||
|
||||
|
||||
|
||||
isDestinationInSource :: FmIOException -> Bool
|
||||
isDestinationInSource (DestinationInSource _ _) = True
|
||||
isDestinationInSource _ = False
|
||||
|
||||
|
||||
isSameFile :: FmIOException -> Bool
|
||||
isSameFile (SameFile _ _) = True
|
||||
isSameFile _ = False
|
||||
|
||||
|
||||
isFileDoesExist :: FmIOException -> Bool
|
||||
isFileDoesExist (FileDoesExist _) = True
|
||||
isFileDoesExist _ = False
|
||||
|
||||
|
||||
isDirDoesExist :: FmIOException -> Bool
|
||||
isDirDoesExist (DirDoesExist _) = True
|
||||
isDirDoesExist _ = False
|
||||
|
||||
|
||||
|
||||
----------------------------
|
||||
--[ Path based functions ]--
|
||||
----------------------------
|
||||
|
||||
|
||||
throwFileDoesExist :: Path Abs -> IO ()
|
||||
throwFileDoesExist fp =
|
||||
whenM (doesFileExist fp) (throwIO . FileDoesExist
|
||||
. P.fromAbs $ fp)
|
||||
|
||||
|
||||
throwDirDoesExist :: Path Abs -> IO ()
|
||||
throwDirDoesExist fp =
|
||||
whenM (doesDirectoryExist fp) (throwIO . DirDoesExist
|
||||
. P.fromAbs $ fp)
|
||||
|
||||
|
||||
throwFileDoesNotExist :: Path Abs -> IO ()
|
||||
throwFileDoesNotExist fp =
|
||||
unlessM (doesFileExist fp) (throwIO . FileDoesNotExist
|
||||
. P.fromAbs $ fp)
|
||||
|
||||
|
||||
throwDirDoesNotExist :: Path Abs -> IO ()
|
||||
throwDirDoesNotExist fp =
|
||||
unlessM (doesDirectoryExist fp) (throwIO . DirDoesNotExist
|
||||
. P.fromAbs $ fp)
|
||||
|
||||
|
||||
-- |Uses `isSameFile` and throws `SameFile` if it returns True.
|
||||
throwSameFile :: Path Abs
|
||||
-> Path Abs
|
||||
-> IO ()
|
||||
throwSameFile fp1 fp2 =
|
||||
whenM (sameFile fp1 fp2)
|
||||
(throwIO $ SameFile (P.fromAbs fp1) (P.fromAbs fp2))
|
||||
|
||||
|
||||
-- |Check if the files are the same by examining device and file id.
|
||||
-- This follows symbolic links.
|
||||
sameFile :: Path Abs -> Path Abs -> IO Bool
|
||||
sameFile fp1 fp2 =
|
||||
P.withAbsPath fp1 $ \fp1' -> P.withAbsPath fp2 $ \fp2' ->
|
||||
handleIOError (\_ -> return False) $ do
|
||||
fs1 <- getFileStatus fp1'
|
||||
fs2 <- getFileStatus fp2'
|
||||
|
||||
if ((PF.deviceID fs1, PF.fileID fs1) ==
|
||||
(PF.deviceID fs2, PF.fileID fs2))
|
||||
then return True
|
||||
else return False
|
||||
|
||||
|
||||
-- |Checks whether the destination directory is contained
|
||||
-- within the source directory by comparing the device+file ID of the
|
||||
-- source directory with all device+file IDs of the parent directories
|
||||
-- of the destination.
|
||||
throwDestinationInSource :: Path Abs -- ^ source dir
|
||||
-> Path Abs -- ^ full destination, `dirname dest`
|
||||
-- must exist
|
||||
-> IO ()
|
||||
throwDestinationInSource source dest = do
|
||||
dest' <- (\x -> maybe x (\y -> x P.</> y) $ P.basename dest)
|
||||
<$> (canonicalizePath $ P.dirname dest)
|
||||
dids <- forM (P.getAllParents dest') $ \p -> do
|
||||
fs <- PF.getSymbolicLinkStatus (P.fromAbs p)
|
||||
return (PF.deviceID fs, PF.fileID fs)
|
||||
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))
|
||||
$ PF.getFileStatus (P.fromAbs source)
|
||||
when (elem sid dids)
|
||||
(throwIO $ DestinationInSource (P.fromAbs dest)
|
||||
(P.fromAbs source))
|
||||
|
||||
|
||||
-- |Checks if the given file exists and is not a directory.
|
||||
-- Does not follow symlinks.
|
||||
doesFileExist :: Path Abs -> IO Bool
|
||||
doesFileExist fp =
|
||||
handleIOError (\_ -> return False) $ do
|
||||
fs <- PF.getSymbolicLinkStatus (P.fromAbs fp)
|
||||
return $ not . PF.isDirectory $ fs
|
||||
|
||||
|
||||
-- |Checks if the given file exists and is a directory.
|
||||
-- Does not follow symlinks.
|
||||
doesDirectoryExist :: Path Abs -> IO Bool
|
||||
doesDirectoryExist fp =
|
||||
handleIOError (\_ -> return False) $ do
|
||||
fs <- PF.getSymbolicLinkStatus (P.fromAbs fp)
|
||||
return $ PF.isDirectory fs
|
||||
|
||||
|
||||
-- |Checks whether a file or folder is writable.
|
||||
isWritable :: Path Abs -> IO Bool
|
||||
isWritable fp =
|
||||
handleIOError (\_ -> return False) $
|
||||
fileAccess (P.fromAbs fp) False True False
|
||||
|
||||
|
||||
-- |Checks whether the directory at the given path exists and can be
|
||||
-- opened. This invokes `openDirStream` which follows symlinks.
|
||||
canOpenDirectory :: Path Abs -> IO Bool
|
||||
canOpenDirectory fp =
|
||||
handleIOError (\_ -> return False) $ do
|
||||
bracket (PFD.openDirStream . P.fromAbs $ fp)
|
||||
PFD.closeDirStream
|
||||
(\_ -> return ())
|
||||
return True
|
||||
|
||||
|
||||
-- |Throws a `Can'tOpenDirectory` FmIOException if the directory at the given
|
||||
-- path cannot be opened.
|
||||
throwCantOpenDirectory :: Path Abs -> IO ()
|
||||
throwCantOpenDirectory fp =
|
||||
unlessM (canOpenDirectory fp)
|
||||
(throwIO . Can'tOpenDirectory . P.fromAbs $ fp)
|
||||
|
||||
|
||||
|
||||
--------------------------------
|
||||
--[ Error handling functions ]--
|
||||
--------------------------------
|
||||
|
||||
|
||||
-- |Carries out an action, then checks if there is an IOException and
|
||||
-- a specific errno. If so, then it carries out another action, otherwise
|
||||
-- it rethrows the error.
|
||||
catchErrno :: [Errno] -- ^ errno to catch
|
||||
-> IO a -- ^ action to try, which can raise an IOException
|
||||
-> IO a -- ^ action to carry out in case of an IOException and
|
||||
-- if errno matches
|
||||
-> IO a
|
||||
catchErrno en a1 a2 =
|
||||
catchIOError a1 $ \e -> do
|
||||
errno <- getErrno
|
||||
if errno `elem` en
|
||||
then a2
|
||||
else ioError e
|
||||
|
||||
|
||||
-- |Execute the given action and retrow IO exceptions as a new Exception
|
||||
-- that have the given errno. If errno does not match the exception is rethrown
|
||||
-- as is.
|
||||
rethrowErrnoAs :: Exception e
|
||||
=> [Errno] -- ^ errno to catch
|
||||
-> e -- ^ rethrow as if errno matches
|
||||
-> IO a -- ^ action to try
|
||||
-> IO a
|
||||
rethrowErrnoAs en fmex action = catchErrno en action (throwIO fmex)
|
||||
|
||||
|
||||
|
||||
-- |Like `catchIOError`, with arguments swapped.
|
||||
handleIOError :: (IOError -> IO a) -> IO a -> IO a
|
||||
handleIOError = flip catchIOError
|
||||
|
||||
|
||||
-- |Like `bracket`, but allows to have different clean-up
|
||||
-- actions depending on whether the in-between computation
|
||||
-- has raised an exception or not.
|
||||
bracketeer :: IO a -- ^ computation to run first
|
||||
-> (a -> IO b) -- ^ computation to run last, when
|
||||
-- no exception was raised
|
||||
-> (a -> IO b) -- ^ computation to run last,
|
||||
-- when an exception was raised
|
||||
-> (a -> IO c) -- ^ computation to run in-between
|
||||
-> IO c
|
||||
bracketeer before after afterEx thing =
|
||||
mask $ \restore -> do
|
||||
a <- before
|
||||
r <- restore (thing a) `onException` afterEx a
|
||||
_ <- after a
|
||||
return r
|
||||
|
||||
|
||||
reactOnError :: IO a
|
||||
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors
|
||||
-> [(FmIOException, IO a)] -- ^ reaction on FmIOException
|
||||
-> IO a
|
||||
reactOnError a ios fmios =
|
||||
a `catches` [iohandler, fmiohandler]
|
||||
where
|
||||
iohandler = Handler $
|
||||
\(ex :: IOException) ->
|
||||
foldr (\(t, a') y -> if ioeGetErrorType ex == t
|
||||
then a'
|
||||
else y)
|
||||
(throwIO ex)
|
||||
ios
|
||||
fmiohandler = Handler $
|
||||
\(ex :: FmIOException) ->
|
||||
foldr (\(t, a') y -> if toConstr ex == toConstr t
|
||||
then a'
|
||||
else y)
|
||||
(throwIO ex)
|
||||
fmios
|
||||
@ -1,799 +0,0 @@
|
||||
{--
|
||||
HSFM, a filemanager written in Haskell.
|
||||
Copyright (C) 2016 Julian Ospald
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
version 2 as published by the Free Software Foundation.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
--}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PackageImports #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
|
||||
-- |This module provides high-level IO related file operations like
|
||||
-- copy, delete, move and so on. It only operates on `Path Abs` which
|
||||
-- guarantees us well-typed paths which are absolute.
|
||||
--
|
||||
-- Some functions are just path-safe wrappers around
|
||||
-- unix functions, others have stricter exception handling
|
||||
-- and some implement functionality that doesn't have a unix
|
||||
-- counterpart (like `copyDirRecursive`).
|
||||
--
|
||||
-- Some of these operations are due to their nature not _atomic_, which
|
||||
-- means they may do multiple syscalls which form one context. Some
|
||||
-- of them also have to examine the filetypes explicitly before the
|
||||
-- syscalls, so a reasonable decision can be made. That means
|
||||
-- the result is undefined if another process changes that context
|
||||
-- while the non-atomic operation is still happening. However, where
|
||||
-- possible, as few syscalls as possible are used and the underlying
|
||||
-- exception handling is kept.
|
||||
module HSFM.FileSystem.FileOperations where
|
||||
|
||||
|
||||
import Control.Exception
|
||||
(
|
||||
bracket
|
||||
, bracketOnError
|
||||
, throwIO
|
||||
)
|
||||
import Control.Monad
|
||||
(
|
||||
void
|
||||
, when
|
||||
)
|
||||
import Data.ByteString
|
||||
(
|
||||
ByteString
|
||||
)
|
||||
import Data.Foldable
|
||||
(
|
||||
for_
|
||||
)
|
||||
import Data.Maybe
|
||||
(
|
||||
catMaybes
|
||||
)
|
||||
import Data.Word
|
||||
(
|
||||
Word8
|
||||
)
|
||||
import Foreign.C.Error
|
||||
(
|
||||
eEXIST
|
||||
, eINVAL
|
||||
, eNOSYS
|
||||
, eNOTEMPTY
|
||||
, eXDEV
|
||||
)
|
||||
import Foreign.C.Types
|
||||
(
|
||||
CSize
|
||||
)
|
||||
import Foreign.Marshal.Alloc
|
||||
(
|
||||
allocaBytes
|
||||
)
|
||||
import Foreign.Ptr
|
||||
(
|
||||
Ptr
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import HPath
|
||||
(
|
||||
Path
|
||||
, Abs
|
||||
, Fn
|
||||
)
|
||||
import qualified HPath as P
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.Utils.IO
|
||||
import Prelude hiding (readFile)
|
||||
import System.IO.Error
|
||||
(
|
||||
catchIOError
|
||||
, ioeGetErrorType
|
||||
)
|
||||
import System.Posix.ByteString
|
||||
(
|
||||
exclusive
|
||||
)
|
||||
import System.Posix.Directory.ByteString
|
||||
(
|
||||
createDirectory
|
||||
, removeDirectory
|
||||
)
|
||||
import System.Posix.Directory.Traversals
|
||||
(
|
||||
getDirectoryContents'
|
||||
)
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
createSymbolicLink
|
||||
, fileMode
|
||||
, getFdStatus
|
||||
, groupExecuteMode
|
||||
, groupReadMode
|
||||
, groupWriteMode
|
||||
, otherExecuteMode
|
||||
, otherReadMode
|
||||
, otherWriteMode
|
||||
, ownerModes
|
||||
, ownerReadMode
|
||||
, ownerWriteMode
|
||||
, readSymbolicLink
|
||||
, removeLink
|
||||
, rename
|
||||
, setFileMode
|
||||
, unionFileModes
|
||||
)
|
||||
import qualified System.Posix.Files.ByteString as PF
|
||||
import qualified "unix" System.Posix.IO.ByteString as SPI
|
||||
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
|
||||
import qualified System.Posix.Directory.Traversals as SPDT
|
||||
import qualified System.Posix.Directory.Foreign as SPDF
|
||||
import System.Posix.IO.Sendfile.ByteString
|
||||
(
|
||||
sendfileFd
|
||||
, FileRange(EntireFile)
|
||||
)
|
||||
import qualified System.Posix.Process.ByteString as SPP
|
||||
import System.Posix.Types
|
||||
(
|
||||
FileMode
|
||||
, ProcessID
|
||||
, Fd
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- TODO: make sure we do the right thing for BlockDev, CharDev etc...
|
||||
-- most operations are not implemented for these
|
||||
|
||||
|
||||
|
||||
|
||||
data FileType = Directory
|
||||
| RegularFile
|
||||
| SymbolicLink
|
||||
| BlockDevice
|
||||
| CharacterDevice
|
||||
| NamedPipe
|
||||
| Socket
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
--------------------
|
||||
--[ File Copying ]--
|
||||
--------------------
|
||||
|
||||
|
||||
|
||||
-- |Copies a directory recursively to the given destination.
|
||||
-- Does not follow symbolic links.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * not atomic
|
||||
-- * examines filetypes explicitly
|
||||
-- * an explicit check `throwDestinationInSource` is carried out for the
|
||||
-- top directory for basic sanity, because otherwise we might end up
|
||||
-- with an infinite copy loop... however, this operation is not
|
||||
-- carried out recursively (because it's slow)
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source directory does not exist
|
||||
-- - `PermissionDenied` if output directory is not writable
|
||||
-- - `PermissionDenied` if source directory can't be opened
|
||||
-- - `InvalidArgument` if source directory is wrong type (symlink)
|
||||
-- - `InvalidArgument` if source directory is wrong type (regular file)
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
-- - `AlreadyExists` if destination already exists
|
||||
-- - `DestinationInSource` if destination is contained in source (`FmIOException`)
|
||||
copyDirRecursive :: Path Abs -- ^ source dir
|
||||
-> Path Abs -- ^ full destination
|
||||
-> IO ()
|
||||
copyDirRecursive fromp destdirp
|
||||
= do
|
||||
-- for performance, sanity checks are only done for the top dir
|
||||
throwSameFile fromp destdirp
|
||||
throwDestinationInSource fromp destdirp
|
||||
go fromp destdirp
|
||||
where
|
||||
go :: Path Abs -> Path Abs -> IO ()
|
||||
go fromp' destdirp' = do
|
||||
-- order is important here, so we don't get empty directories
|
||||
-- on failure
|
||||
contents <- getDirsFiles fromp'
|
||||
|
||||
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (P.fromAbs fromp')
|
||||
createDirectory (P.fromAbs destdirp') fmode'
|
||||
|
||||
for_ contents $ \f -> do
|
||||
ftype <- getFileType f
|
||||
newdest <- (destdirp' P.</>) <$> P.basename f
|
||||
case ftype of
|
||||
SymbolicLink -> recreateSymlink f newdest
|
||||
Directory -> go f newdest
|
||||
RegularFile -> copyFile f newdest
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
-- |Like `copyDirRecursive` except it overwrites contents of directories
|
||||
-- if any.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source directory does not exist
|
||||
-- - `PermissionDenied` if output directory is not writable
|
||||
-- - `PermissionDenied` if source directory can't be opened
|
||||
-- - `InvalidArgument` if source directory is wrong type (symlink)
|
||||
-- - `InvalidArgument` if source directory is wrong type (regular file)
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
-- - `DestinationInSource` if destination is contained in source (`FmIOException`)
|
||||
copyDirRecursiveOverwrite :: Path Abs -- ^ source dir
|
||||
-> Path Abs -- ^ full destination
|
||||
-> IO ()
|
||||
copyDirRecursiveOverwrite fromp destdirp
|
||||
= do
|
||||
-- for performance, sanity checks are only done for the top dir
|
||||
throwSameFile fromp destdirp
|
||||
throwDestinationInSource fromp destdirp
|
||||
go fromp destdirp
|
||||
where
|
||||
go :: Path Abs -> Path Abs -> IO ()
|
||||
go fromp' destdirp' = do
|
||||
-- order is important here, so we don't get empty directories
|
||||
-- on failure
|
||||
contents <- getDirsFiles fromp'
|
||||
|
||||
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (P.fromAbs fromp')
|
||||
catchIOError (createDirectory (P.fromAbs destdirp') fmode') $ \e ->
|
||||
case ioeGetErrorType e of
|
||||
AlreadyExists -> setFileMode (P.fromAbs destdirp') fmode'
|
||||
_ -> ioError e
|
||||
|
||||
for_ contents $ \f -> do
|
||||
ftype <- getFileType f
|
||||
newdest <- (destdirp' P.</>) <$> P.basename f
|
||||
case ftype of
|
||||
SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest)
|
||||
>> recreateSymlink f newdest
|
||||
Directory -> go f newdest
|
||||
RegularFile -> copyFileOverwrite f newdest
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
|
||||
-- |Recreate a symlink.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `InvalidArgument` if symlink file is wrong type (file)
|
||||
-- - `InvalidArgument` if symlink file is wrong type (directory)
|
||||
-- - `PermissionDenied` if output directory cannot be written to
|
||||
-- - `PermissionDenied` if source directory cannot be opened
|
||||
-- - `AlreadyExists` if destination file already exists
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `symlink`
|
||||
recreateSymlink :: Path Abs -- ^ the old symlink file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
recreateSymlink symsource newsym
|
||||
= do
|
||||
throwSameFile symsource newsym
|
||||
sympoint <- readSymbolicLink (P.fromAbs symsource)
|
||||
createSymbolicLink sympoint (P.fromAbs newsym)
|
||||
|
||||
|
||||
-- |Copies the given regular file to the given destination.
|
||||
-- Neither follows symbolic links, nor accepts them.
|
||||
-- For "copying" symbolic links, use `recreateSymlink` instead.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source file does not exist
|
||||
-- - `PermissionDenied` if output directory is not writable
|
||||
-- - `PermissionDenied` if source directory can't be opened
|
||||
-- - `InvalidArgument` if source file is wrong type (symlink)
|
||||
-- - `InvalidArgument` if source file is wrong type (directory)
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
-- - `AlreadyExists` if destination already exists
|
||||
--
|
||||
-- Note: calls `sendfile`
|
||||
copyFile :: Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
copyFile from to = do
|
||||
throwSameFile from to
|
||||
_copyFile [SPDF.oNofollow]
|
||||
[SPDF.oNofollow, SPDF.oExcl]
|
||||
from to
|
||||
|
||||
|
||||
-- |Like `copyFile` except it overwrites the destination if it already
|
||||
-- exists.
|
||||
-- This also works if source and destination are the same file.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * not atomic
|
||||
-- * falls back to delete-copy method with explicit checks
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source file does not exist
|
||||
-- - `PermissionDenied` if output directory is not writable
|
||||
-- - `PermissionDenied` if source directory can't be opened
|
||||
-- - `InvalidArgument` if source file is wrong type (symlink)
|
||||
-- - `InvalidArgument` if source file is wrong type (directory)
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `sendfile`
|
||||
copyFileOverwrite :: Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
copyFileOverwrite from to = do
|
||||
throwSameFile from to
|
||||
catchIOError (_copyFile [SPDF.oNofollow]
|
||||
[SPDF.oNofollow, SPDF.oTrunc]
|
||||
from to) $ \e ->
|
||||
case ioeGetErrorType e of
|
||||
-- if the destination file is not writable, we need to
|
||||
-- figure out if we can still copy by deleting it first
|
||||
PermissionDenied -> do
|
||||
exists <- doesFileExist to
|
||||
writable <- isWritable (P.dirname to)
|
||||
if exists && writable
|
||||
then deleteFile to >> copyFile from to
|
||||
else ioError e
|
||||
_ -> ioError e
|
||||
|
||||
|
||||
_copyFile :: [SPDF.Flags]
|
||||
-> [SPDF.Flags]
|
||||
-> Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
_copyFile sflags dflags from to
|
||||
=
|
||||
-- from sendfile(2) manpage:
|
||||
-- Applications may wish to fall back to read(2)/write(2) in the case
|
||||
-- where sendfile() fails with EINVAL or ENOSYS.
|
||||
P.withAbsPath to $ \to' -> P.withAbsPath from $ \from' ->
|
||||
catchErrno [eINVAL, eNOSYS]
|
||||
(sendFileCopy from' to')
|
||||
(void $ fallbackCopy from' to')
|
||||
where
|
||||
-- this is low-level stuff utilizing sendfile(2) for speed
|
||||
sendFileCopy source dest =
|
||||
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
|
||||
SPI.closeFd
|
||||
$ \sfd -> do
|
||||
fileM <- System.Posix.Files.ByteString.fileMode
|
||||
<$> getFdStatus sfd
|
||||
bracketeer (SPDT.openFd dest SPI.WriteOnly
|
||||
dflags $ Just fileM)
|
||||
SPI.closeFd
|
||||
(\fd -> SPI.closeFd fd >> deleteFile to)
|
||||
$ \dfd -> sendfileFd dfd sfd EntireFile
|
||||
-- low-level copy operation utilizing read(2)/write(2)
|
||||
-- in case `sendFileCopy` fails/is unsupported
|
||||
fallbackCopy source dest =
|
||||
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
|
||||
SPI.closeFd
|
||||
$ \sfd -> do
|
||||
fileM <- System.Posix.Files.ByteString.fileMode
|
||||
<$> getFdStatus sfd
|
||||
bracketeer (SPDT.openFd dest SPI.WriteOnly
|
||||
dflags $ Just fileM)
|
||||
SPI.closeFd
|
||||
(\fd -> SPI.closeFd fd >> deleteFile to)
|
||||
$ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->
|
||||
write' sfd dfd buf 0
|
||||
where
|
||||
bufSize :: CSize
|
||||
bufSize = 8192
|
||||
write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int
|
||||
write' sfd dfd buf totalsize = do
|
||||
size <- SPB.fdReadBuf sfd buf bufSize
|
||||
if size == 0
|
||||
then return $ fromIntegral totalsize
|
||||
else do rsize <- SPB.fdWriteBuf dfd buf size
|
||||
-- TODO: switch to IOError?
|
||||
when (rsize /= size) (throwIO . CopyFailed $ "wrong size!")
|
||||
write' sfd dfd buf (totalsize + fromIntegral size)
|
||||
|
||||
|
||||
-- |Copies anything. In case of a symlink,
|
||||
-- it is just recreated, even if it points to a directory.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * examines filetypes explicitly
|
||||
-- * calls `copyDirRecursive` for directories
|
||||
easyCopy :: Path Abs
|
||||
-> Path Abs
|
||||
-> IO ()
|
||||
easyCopy from to = do
|
||||
ftype <- getFileType from
|
||||
case ftype of
|
||||
SymbolicLink -> recreateSymlink from to
|
||||
RegularFile -> copyFile from to
|
||||
Directory -> copyDirRecursive from to
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
|
||||
-- |Like `easyCopy` except it overwrites the destination if it already exists.
|
||||
-- For directories, this overwrites contents without pruning them, so the resulting
|
||||
-- directory may have more files than have been copied.
|
||||
easyCopyOverwrite :: Path Abs
|
||||
-> Path Abs
|
||||
-> IO ()
|
||||
easyCopyOverwrite from to = do
|
||||
ftype <- getFileType from
|
||||
case ftype of
|
||||
SymbolicLink -> whenM (doesFileExist to) (deleteFile to)
|
||||
>> recreateSymlink from to
|
||||
RegularFile -> copyFileOverwrite from to
|
||||
Directory -> copyDirRecursiveOverwrite from to
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------
|
||||
--[ File Deletion ]--
|
||||
---------------------
|
||||
|
||||
|
||||
-- |Deletes the given file, does not follow symlinks. Raises `eISDIR`
|
||||
-- if run on a directory. Does not follow symbolic links.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `InappropriateType` for wrong file type (directory)
|
||||
-- - `NoSuchThing` if the file does not exist
|
||||
-- - `PermissionDenied` if the directory cannot be read
|
||||
deleteFile :: Path Abs -> IO ()
|
||||
deleteFile p = P.withAbsPath p removeLink
|
||||
|
||||
|
||||
-- |Deletes the given directory, which must be empty, never symlinks.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `InappropriateType` for wrong file type (symlink to directory)
|
||||
-- - `InappropriateType` for wrong file type (regular file)
|
||||
-- - `NoSuchThing` if directory does not exist
|
||||
-- - `UnsatisfiedConstraints` if directory is not empty
|
||||
-- - `PermissionDenied` if we can't open or write to parent directory
|
||||
--
|
||||
-- Notes: calls `rmdir`
|
||||
deleteDir :: Path Abs -> IO ()
|
||||
deleteDir p = P.withAbsPath p removeDirectory
|
||||
|
||||
|
||||
-- |Deletes the given directory recursively. Does not follow symbolic
|
||||
-- links. Tries `deleteDir` first before attemtping a recursive
|
||||
-- deletion.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * not atomic
|
||||
-- * examines filetypes explicitly
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `InappropriateType` for wrong file type (symlink to directory)
|
||||
-- - `InappropriateType` for wrong file type (regular file)
|
||||
-- - `NoSuchThing` if directory does not exist
|
||||
-- - `PermissionDenied` if we can't open or write to parent directory
|
||||
deleteDirRecursive :: Path Abs -> IO ()
|
||||
deleteDirRecursive p =
|
||||
catchErrno [eNOTEMPTY, eEXIST]
|
||||
(deleteDir p)
|
||||
$ do
|
||||
files <- getDirsFiles p
|
||||
for_ files $ \file -> do
|
||||
ftype <- getFileType file
|
||||
case ftype of
|
||||
SymbolicLink -> deleteFile file
|
||||
Directory -> deleteDirRecursive file
|
||||
RegularFile -> deleteFile file
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
removeDirectory . P.toFilePath $ p
|
||||
|
||||
|
||||
-- |Deletes a file, directory or symlink, whatever it may be.
|
||||
-- In case of directory, performs recursive deletion. In case of
|
||||
-- a symlink, the symlink file is deleted.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * examines filetypes explicitly
|
||||
-- * calls `deleteDirRecursive` for directories
|
||||
easyDelete :: Path Abs -> IO ()
|
||||
easyDelete p = do
|
||||
ftype <- getFileType p
|
||||
case ftype of
|
||||
SymbolicLink -> deleteFile p
|
||||
Directory -> deleteDirRecursive p
|
||||
RegularFile -> deleteFile p
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
|
||||
|
||||
|
||||
--------------------
|
||||
--[ File Opening ]--
|
||||
--------------------
|
||||
|
||||
|
||||
-- |Opens a file appropriately by invoking xdg-open. The file type
|
||||
-- is not checked.
|
||||
openFile :: Path Abs
|
||||
-> IO ProcessID
|
||||
openFile p =
|
||||
P.withAbsPath p $ \fp ->
|
||||
SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing
|
||||
|
||||
|
||||
-- |Executes a program with the given arguments.
|
||||
executeFile :: Path Abs -- ^ program
|
||||
-> [ByteString] -- ^ arguments
|
||||
-> IO ProcessID
|
||||
executeFile fp args
|
||||
= P.withAbsPath fp $ \fpb ->
|
||||
SPP.forkProcess
|
||||
$ SPP.executeFile fpb True args Nothing
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------
|
||||
--[ File Creation ]--
|
||||
---------------------
|
||||
|
||||
|
||||
-- |Create an empty regular file at the given directory with the given filename.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `PermissionDenied` if output directory cannot be written to
|
||||
-- - `AlreadyExists` if destination file already exists
|
||||
createRegularFile :: Path Abs -> IO ()
|
||||
createRegularFile dest =
|
||||
bracket (SPI.openFd (P.fromAbs dest) SPI.WriteOnly (Just newFilePerms)
|
||||
(SPI.defaultFileFlags { exclusive = True }))
|
||||
SPI.closeFd
|
||||
(\_ -> return ())
|
||||
|
||||
|
||||
-- |Create an empty directory at the given directory with the given filename.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `PermissionDenied` if output directory cannot be written to
|
||||
-- - `AlreadyExists` if destination directory already exists
|
||||
createDir :: Path Abs -> IO ()
|
||||
createDir dest = createDirectory (P.fromAbs dest) newDirPerms
|
||||
|
||||
|
||||
|
||||
|
||||
----------------------------
|
||||
--[ File Renaming/Moving ]--
|
||||
----------------------------
|
||||
|
||||
|
||||
-- |Rename a given file with the provided filename. Destination and source
|
||||
-- must be on the same device, otherwise `eXDEV` will be raised.
|
||||
--
|
||||
-- Does not follow symbolic links, but renames the symbolic link file.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * has a separate set of exception handling, apart from the syscall
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source file does not exist
|
||||
-- - `PermissionDenied` if output directory cannot be written to
|
||||
-- - `PermissionDenied` if source directory cannot be opened
|
||||
-- - `UnsupportedOperation` if source and destination are on different devices
|
||||
-- - `FileDoesExist` if destination file already exists
|
||||
-- - `DirDoesExist` if destination directory already exists
|
||||
-- - `SameFile` if destination and source are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `rename` (but does not allow to rename over existing files)
|
||||
renameFile :: Path Abs -> Path Abs -> IO ()
|
||||
renameFile fromf tof = do
|
||||
throwSameFile fromf tof
|
||||
throwFileDoesExist tof
|
||||
throwDirDoesExist tof
|
||||
rename (P.fromAbs fromf) (P.fromAbs tof)
|
||||
|
||||
|
||||
-- |Move a file. This also works across devices by copy-delete fallback.
|
||||
-- And also works on directories.
|
||||
--
|
||||
-- Does not follow symbolic links, but renames the symbolic link file.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * copy-delete fallback is inherently non-atomic
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source file does not exist
|
||||
-- - `PermissionDenied` if output directory cannot be written to
|
||||
-- - `PermissionDenied` if source directory cannot be opened
|
||||
-- - `FileDoesExist` if destination file already exists
|
||||
-- - `DirDoesExist` if destination directory already exists
|
||||
-- - `SameFile` if destination and source are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `rename` (but does not allow to rename over existing files)
|
||||
moveFile :: Path Abs -- ^ file to move
|
||||
-> Path Abs -- ^ destination
|
||||
-> IO ()
|
||||
moveFile from to = do
|
||||
throwSameFile from to
|
||||
catchErrno [eXDEV] (renameFile from to) $ do
|
||||
easyCopy from to
|
||||
easyDelete from
|
||||
|
||||
|
||||
-- |Like `moveFile`, but overwrites the destination if it exists.
|
||||
--
|
||||
-- Does not follow symbolic links, but renames the symbolic link file.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * copy-delete fallback is inherently non-atomic
|
||||
-- * checks for file types and destination file existence explicitly
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source file does not exist
|
||||
-- - `PermissionDenied` if output directory cannot be written to
|
||||
-- - `PermissionDenied` if source directory cannot be opened
|
||||
-- - `SameFile` if destination and source are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `rename` (but does not allow to rename over existing files)
|
||||
moveFileOverwrite :: Path Abs -- ^ file to move
|
||||
-> Path Abs -- ^ destination
|
||||
-> IO ()
|
||||
moveFileOverwrite from to = do
|
||||
throwSameFile from to
|
||||
ft <- getFileType from
|
||||
writable <- isWritable $ P.dirname to
|
||||
case ft of
|
||||
RegularFile -> do
|
||||
exists <- doesFileExist to
|
||||
when (exists && writable) (deleteFile to)
|
||||
SymbolicLink -> do
|
||||
exists <- doesFileExist to
|
||||
when (exists && writable) (deleteFile to)
|
||||
Directory -> do
|
||||
exists <- doesDirectoryExist to
|
||||
when (exists && writable) (deleteDir to)
|
||||
_ -> ioError $ userError $ "Don't know how to handle filetype " ++
|
||||
show ft
|
||||
moveFile from to
|
||||
|
||||
|
||||
|
||||
|
||||
-----------------------
|
||||
--[ File Permissions]--
|
||||
-----------------------
|
||||
|
||||
|
||||
-- |Default permissions for a new file.
|
||||
newFilePerms :: FileMode
|
||||
newFilePerms
|
||||
= ownerWriteMode
|
||||
`unionFileModes` ownerReadMode
|
||||
`unionFileModes` groupWriteMode
|
||||
`unionFileModes` groupReadMode
|
||||
`unionFileModes` otherWriteMode
|
||||
`unionFileModes` otherReadMode
|
||||
|
||||
|
||||
-- |Default permissions for a new directory.
|
||||
newDirPerms :: FileMode
|
||||
newDirPerms
|
||||
= ownerModes
|
||||
`unionFileModes` groupExecuteMode
|
||||
`unionFileModes` groupReadMode
|
||||
`unionFileModes` otherExecuteMode
|
||||
`unionFileModes` otherReadMode
|
||||
|
||||
|
||||
|
||||
-------------------------
|
||||
--[ Directory reading ]--
|
||||
-------------------------
|
||||
|
||||
|
||||
-- |Gets all filenames of the given directory. This excludes "." and "..".
|
||||
-- This version does not follow symbolic links.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if directory does not exist
|
||||
-- - `InappropriateType` if file type is wrong (file)
|
||||
-- - `InappropriateType` if file type is wrong (symlink to file)
|
||||
-- - `InappropriateType` if file type is wrong (symlink to dir)
|
||||
-- - `PermissionDenied` if directory cannot be opened
|
||||
getDirsFiles :: Path Abs -- ^ dir to read
|
||||
-> IO [Path Abs]
|
||||
getDirsFiles p =
|
||||
P.withAbsPath p $ \fp ->
|
||||
bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing)
|
||||
SPI.closeFd
|
||||
$ \fd ->
|
||||
return
|
||||
. catMaybes
|
||||
. fmap (\x -> (P.</>) p <$> (parseMaybe . snd $ x))
|
||||
=<< getDirectoryContents' fd
|
||||
where
|
||||
parseMaybe :: ByteString -> Maybe (Path Fn)
|
||||
parseMaybe = P.parseFn
|
||||
|
||||
|
||||
|
||||
|
||||
---------------------------
|
||||
--[ FileType operations ]--
|
||||
---------------------------
|
||||
|
||||
|
||||
-- |Get the file type of the file located at the given path. Does
|
||||
-- not follow symbolic links.
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if the file does not exist
|
||||
-- - `PermissionDenied` if any part of the path is not accessible
|
||||
getFileType :: Path Abs -> IO FileType
|
||||
getFileType p = do
|
||||
fs <- PF.getSymbolicLinkStatus (P.fromAbs p)
|
||||
decide fs
|
||||
where
|
||||
decide fs
|
||||
| PF.isDirectory fs = return Directory
|
||||
| PF.isRegularFile fs = return RegularFile
|
||||
| PF.isSymbolicLink fs = return SymbolicLink
|
||||
| PF.isBlockDevice fs = return BlockDevice
|
||||
| PF.isCharacterDevice fs = return CharacterDevice
|
||||
| PF.isNamedPipe fs = return NamedPipe
|
||||
| PF.isSocket fs = return Socket
|
||||
| otherwise = ioError $ userError "No filetype?!"
|
||||
|
||||
@ -51,11 +51,8 @@ import HPath
|
||||
, Path
|
||||
)
|
||||
import qualified HPath as P
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.FileSystem.FileOperations
|
||||
(
|
||||
getDirsFiles
|
||||
)
|
||||
import HPath.IO hiding (FileType(..))
|
||||
import HPath.IO.Errors
|
||||
import HSFM.Utils.MyPrelude
|
||||
import Prelude hiding(readFile)
|
||||
import System.IO.Error
|
||||
|
||||
@ -55,8 +55,9 @@ import HPath
|
||||
Abs
|
||||
, Path
|
||||
)
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.FileSystem.FileOperations
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import HPath.IO.Utils
|
||||
import HSFM.FileSystem.FileType
|
||||
import HSFM.FileSystem.UtilTypes
|
||||
import HSFM.GUI.Gtk.Callbacks.Utils
|
||||
@ -431,7 +432,7 @@ renameF [item] _ _ = withErrorDialog $ do
|
||||
++ P.fpToString (P.fromAbs $ (P.dirname . path $ item)
|
||||
P.</> fn) ++ "\"?"
|
||||
withConfirmationDialog cmsg $
|
||||
HSFM.FileSystem.FileOperations.renameFile (path item)
|
||||
HPath.IO.renameFile (path item)
|
||||
((P.dirname $ path item) P.</> fn)
|
||||
renameF _ _ _ = withErrorDialog
|
||||
. throwIO $ InvalidOperation
|
||||
|
||||
@ -33,8 +33,8 @@ import GHC.IO.Exception
|
||||
IOErrorType(..)
|
||||
)
|
||||
import qualified HPath as P
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.FileSystem.FileOperations
|
||||
import HPath.IO
|
||||
import HPath.IO.Errors
|
||||
import HSFM.FileSystem.FileType
|
||||
import HSFM.FileSystem.UtilTypes
|
||||
import HSFM.GUI.Gtk.Data
|
||||
|
||||
@ -68,7 +68,7 @@ import Distribution.Verbosity
|
||||
)
|
||||
import Graphics.UI.Gtk
|
||||
import qualified HPath as P
|
||||
import HSFM.FileSystem.Errors
|
||||
import HPath.IO.Errors
|
||||
import HSFM.FileSystem.FileType
|
||||
import HSFM.FileSystem.UtilTypes
|
||||
import HSFM.GUI.Glib.GlibString()
|
||||
@ -222,7 +222,7 @@ withErrorDialog io =
|
||||
[ Handler (\e -> showErrorDialog
|
||||
$ displayException (e :: IOException))
|
||||
, Handler (\e -> showErrorDialog
|
||||
$ displayException (e :: FmIOException))
|
||||
$ displayException (e :: HPathIOException))
|
||||
]
|
||||
|
||||
|
||||
|
||||
@ -47,7 +47,7 @@ import Data.Maybe
|
||||
catMaybes
|
||||
, fromJust
|
||||
)
|
||||
import HSFM.FileSystem.Errors
|
||||
import HPath.IO.Errors
|
||||
(
|
||||
canOpenDirectory
|
||||
)
|
||||
|
||||
@ -33,11 +33,6 @@ import Control.Concurrent.STM.TVar
|
||||
, modifyTVar
|
||||
, TVar
|
||||
)
|
||||
import Control.Monad
|
||||
(
|
||||
when
|
||||
, unless
|
||||
)
|
||||
|
||||
|
||||
-- |Atomically write a TVar.
|
||||
@ -49,14 +44,3 @@ writeTVarIO tvar val = atomically $ writeTVar tvar val
|
||||
modifyTVarIO :: TVar a -> (a -> a) -> IO ()
|
||||
modifyTVarIO tvar f = atomically $ modifyTVar tvar f
|
||||
|
||||
|
||||
-- |If the value of the first argument is True, then execute the action
|
||||
-- provided in the second argument, otherwise do nothing.
|
||||
whenM :: Monad m => m Bool -> m () -> m ()
|
||||
whenM mb a = mb >>= (`when` a)
|
||||
|
||||
|
||||
-- |If the value of the first argument is False, then execute the action
|
||||
-- provided in the second argument, otherwise do nothing.
|
||||
unlessM :: Monad m => m Bool -> m () -> m ()
|
||||
unlessM mb a = mb >>= (`unless` a)
|
||||
|
||||
@ -1,110 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.copyDirRecursiveOverwrite" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyDirRecursiveOverwrite, all fine" $ do
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "outputDir")
|
||||
removeDirIfExists $ specDir `ba` "outputDir"
|
||||
|
||||
it "copyDirRecursiveOverwrite, all fine and compare" $ do
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "outputDir")
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ specDir' ++ "inputDir" ++ " "
|
||||
++ specDir' ++ "outputDir")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists $ specDir `ba` "outputDir"
|
||||
|
||||
it "copyDirRecursiveOverwrite, destination dir already exists" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "alreadyExistsD")
|
||||
|
||||
-- posix failures --
|
||||
it "copyDirRecursiveOverwrite, source directory does not exist" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "doesNotExist")
|
||||
(specDir `ba` "outputDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyDirRecursiveOverwrite, no write permission on output dir" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "noWritePerm/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursiveOverwrite, cannot open output dir" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "noPerms/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursiveOverwrite, cannot open source dir" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "noPerms/inputDir")
|
||||
(specDir `ba` "foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursiveOverwrite, destination already exists and is a file" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "alreadyExists")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursiveOverwrite, wrong input (regular file)" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "wrongInput")
|
||||
(specDir `ba` "outputDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "wrongInputSymL")
|
||||
(specDir `ba` "outputDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
-- custom failures
|
||||
it "copyDirRecursiveOverwrite, destination in source" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "inputDir/foo")
|
||||
`shouldThrow`
|
||||
isDestinationInSource
|
||||
|
||||
it "copyDirRecursiveOverwrite, destination and source same directory" $
|
||||
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "inputDir")
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
@ -1,112 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.CopyDirRecursiveSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/copyDirRecursiveSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.copyDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyDirRecursive, all fine" $ do
|
||||
copyDirRecursive' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "outputDir")
|
||||
removeDirIfExists (specDir `ba` "outputDir")
|
||||
|
||||
it "copyDirRecursive, all fine and compare" $ do
|
||||
copyDirRecursive' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "outputDir")
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ specDir' ++ "inputDir" ++ " "
|
||||
++ specDir' ++ "outputDir")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists (specDir `ba` "outputDir")
|
||||
|
||||
-- posix failures --
|
||||
it "copyDirRecursive, source directory does not exist" $
|
||||
copyDirRecursive' (specDir `ba` "doesNotExist")
|
||||
(specDir `ba` "outputDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyDirRecursive, no write permission on output dir" $
|
||||
copyDirRecursive' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "noWritePerm/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive, cannot open output dir" $
|
||||
copyDirRecursive' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "noPerms/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive, cannot open source dir" $
|
||||
copyDirRecursive' (specDir `ba` "noPerms/inputDir")
|
||||
(specDir `ba` "foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursive, destination dir already exists" $
|
||||
copyDirRecursive' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "alreadyExistsD")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyDirRecursive, destination already exists and is a file" $
|
||||
copyDirRecursive' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "alreadyExists")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyDirRecursive, wrong input (regular file)" $
|
||||
copyDirRecursive' (specDir `ba` "wrongInput")
|
||||
(specDir `ba` "outputDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursive, wrong input (symlink to directory)" $
|
||||
copyDirRecursive' (specDir `ba` "wrongInputSymL")
|
||||
(specDir `ba` "outputDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
-- custom failures
|
||||
it "copyDirRecursive, destination in source" $
|
||||
copyDirRecursive' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "inputDir/foo")
|
||||
`shouldThrow`
|
||||
isDestinationInSource
|
||||
|
||||
it "copyDirRecursive, destination and source same directory" $
|
||||
copyDirRecursive' (specDir `ba` "inputDir")
|
||||
(specDir `ba` "inputDir")
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
@ -1,109 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.CopyFileOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/copyFileOverwriteSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.copyFileOverwrite" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyFileOverwrite, everything clear" $ do
|
||||
copyFileOverwrite' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "outputFile")
|
||||
removeFileIfExists (specDir `ba` "outputFile")
|
||||
|
||||
it "copyFileOverwrite, output file already exists, all clear" $ do
|
||||
copyFile' (specDir `ba` "alreadyExists") (specDir `ba` "alreadyExists.bak")
|
||||
copyFileOverwrite' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "alreadyExists")
|
||||
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
|
||||
++ specDir' ++ "alreadyExists")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists (specDir `ba` "alreadyExists")
|
||||
copyFile' (specDir `ba` "alreadyExists.bak") (specDir `ba` "alreadyExists")
|
||||
removeFileIfExists (specDir `ba` "alreadyExists.bak")
|
||||
|
||||
it "copyFileOverwrite, and compare" $ do
|
||||
copyFileOverwrite' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "outputFile")
|
||||
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
|
||||
++ specDir' ++ "outputFile")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists (specDir `ba` "outputFile")
|
||||
|
||||
-- posix failures --
|
||||
it "copyFileOverwrite, input file does not exist" $
|
||||
copyFileOverwrite' (specDir `ba` "noSuchFile")
|
||||
(specDir `ba` "outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyFileOverwrite, no permission to write to output directory" $
|
||||
copyFileOverwrite' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "outputDirNoWrite/outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFileOverwrite, cannot open output directory" $
|
||||
copyFileOverwrite' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "noPerms/outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFileOverwrite, cannot open source directory" $
|
||||
copyFileOverwrite' (specDir `ba` "noPerms/inputFile")
|
||||
(specDir `ba` "outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFileOverwrite, wrong input type (symlink)" $
|
||||
copyFileOverwrite' (specDir `ba` "inputFileSymL")
|
||||
(specDir `ba` "outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "copyFileOverwrite, wrong input type (directory)" $
|
||||
copyFileOverwrite' (specDir `ba` "wrongInput")
|
||||
(specDir `ba` "outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyFileOverwrite, output file already exists and is a dir" $
|
||||
copyFileOverwrite' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "alreadyExistsD")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
-- custom failures --
|
||||
it "copyFileOverwrite, output and input are same file" $
|
||||
copyFileOverwrite' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "inputFile")
|
||||
`shouldThrow` isSameFile
|
||||
@ -1,105 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.CopyFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/copyFileSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.copyFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyFile, everything clear" $ do
|
||||
copyFile' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "outputFile")
|
||||
removeFileIfExists (specDir `ba` "outputFile")
|
||||
|
||||
it "copyFile, and compare" $ do
|
||||
copyFile' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "outputFile")
|
||||
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
|
||||
++ specDir' ++ "outputFile")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeFileIfExists (specDir `ba` "outputFile")
|
||||
|
||||
-- posix failures --
|
||||
it "copyFile, input file does not exist" $
|
||||
copyFile' (specDir `ba` "noSuchFile")
|
||||
(specDir `ba` "outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyFile, no permission to write to output directory" $
|
||||
copyFile' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "outputDirNoWrite/outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile, cannot open output directory" $
|
||||
copyFile' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "noPerms/outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile, cannot open source directory" $
|
||||
copyFile' (specDir `ba` "noPerms/inputFile")
|
||||
(specDir `ba` "outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyFile, wrong input type (symlink)" $
|
||||
copyFile' (specDir `ba` "inputFileSymL")
|
||||
(specDir `ba` "outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "copyFile, wrong input type (directory)" $
|
||||
copyFile' (specDir `ba` "wrongInput")
|
||||
(specDir `ba` "outputFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyFile, output file already exists" $
|
||||
copyFile' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "alreadyExists")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyFile, output file already exists and is a dir" $
|
||||
copyFile' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "alreadyExistsD")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
-- custom failures --
|
||||
it "copyFile, output and input are same file" $
|
||||
copyFile' (specDir `ba` "inputFile")
|
||||
(specDir `ba` "inputFile")
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
@ -1,54 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.CreateDirSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/createDirSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.createDir" $ do
|
||||
|
||||
-- successes --
|
||||
it "createDir, all fine" $ do
|
||||
createDir' (specDir `ba` "newDir")
|
||||
removeDirIfExists (specDir `ba` "newDir")
|
||||
|
||||
-- posix failures --
|
||||
it "createDir, can't write to output directory" $
|
||||
createDir' (specDir `ba` "noWritePerms/newDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createDir, can't open output directory" $
|
||||
createDir' (specDir `ba` "noPerms/newDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createDir, destination directory already exists" $
|
||||
createDir' (specDir `ba` "alreadyExists")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
@ -1,54 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.CreateRegularFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/createRegularFileSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.createRegularFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "createRegularFile, all fine" $ do
|
||||
createRegularFile' (specDir `ba` "newDir")
|
||||
removeFileIfExists (specDir `ba` "newDir")
|
||||
|
||||
-- posix failures --
|
||||
it "createRegularFile, can't write to destination directory" $
|
||||
createRegularFile' (specDir `ba` "noWritePerms/newDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createRegularFile, can't write to destination directory" $
|
||||
createRegularFile' (specDir `ba` "noPerms/newDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "createRegularFile, destination file already exists" $
|
||||
createRegularFile' (specDir `ba` "alreadyExists")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
@ -1,97 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.DeleteDirRecursiveSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
getSymbolicLinkStatus
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/deleteDirRecursiveSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.deleteDirRecursive" $ do
|
||||
|
||||
-- successes --
|
||||
it "deleteDirRecursive, empty directory, all fine" $ do
|
||||
createDir' (specDir `ba` "testDir")
|
||||
deleteDirRecursive' (specDir `ba` "testDir")
|
||||
getSymbolicLinkStatus (specDir `ba` "testDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
|
||||
createDir' (specDir `ba` "noPerms/testDir")
|
||||
noPerms (specDir `ba` "noPerms/testDir")
|
||||
deleteDirRecursive' (specDir `ba` "noPerms/testDir")
|
||||
|
||||
it "deleteDirRecursive, non-empty directory, all fine" $ do
|
||||
createDir' (specDir `ba` "nonEmpty")
|
||||
createDir' (specDir `ba` "nonEmpty/dir1")
|
||||
createDir' (specDir `ba` "nonEmpty/dir2")
|
||||
createDir' (specDir `ba` "nonEmpty/dir2/dir3")
|
||||
createRegularFile' (specDir `ba` "nonEmpty/file1")
|
||||
createRegularFile' (specDir `ba` "nonEmpty/dir1/file2")
|
||||
deleteDirRecursive' (specDir `ba` "nonEmpty")
|
||||
getSymbolicLinkStatus (specDir `ba` "nonEmpty")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
-- posix failures --
|
||||
it "deleteDirRecursive, can't open parent directory" $ do
|
||||
createDir' (specDir `ba` "noPerms/foo")
|
||||
noPerms (specDir `ba` "noPerms")
|
||||
(deleteDirRecursive' (specDir `ba` "noPerms/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied))
|
||||
>> normalDirPerms (specDir `ba` "noPerms")
|
||||
>> deleteDir' (specDir `ba` "noPerms/foo")
|
||||
|
||||
it "deleteDirRecursive, can't write to parent directory" $ do
|
||||
createDir' (specDir `ba` "noWritable/foo")
|
||||
noWritableDirPerms (specDir `ba` "noWritable")
|
||||
(deleteDirRecursive' (specDir `ba` "noWritable/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied))
|
||||
normalDirPerms (specDir `ba` "noWritable")
|
||||
deleteDir' (specDir `ba` "noWritable/foo")
|
||||
|
||||
it "deleteDirRecursive, wrong file type (symlink to directory)" $
|
||||
deleteDirRecursive' (specDir `ba` "dirSym")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteDirRecursive, wrong file type (regular file)" $
|
||||
deleteDirRecursive' (specDir `ba` "file")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteDirRecursive, directory does not exist" $
|
||||
deleteDirRecursive' (specDir `ba` "doesNotExist")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
|
||||
@ -1,94 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.DeleteDirSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
getSymbolicLinkStatus
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/deleteDirSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.deleteDir" $ do
|
||||
|
||||
-- successes --
|
||||
it "deleteDir, empty directory, all fine" $ do
|
||||
createDir' (specDir `ba` "testDir")
|
||||
deleteDir' (specDir `ba` "testDir")
|
||||
getSymbolicLinkStatus (specDir `ba` "testDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteDir, directory with null permissions, all fine" $ do
|
||||
createDir' (specDir `ba` "noPerms/testDir")
|
||||
noPerms (specDir `ba` "noPerms/testDir")
|
||||
deleteDir' (specDir `ba` "noPerms/testDir")
|
||||
getSymbolicLinkStatus (specDir `ba` "testDir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
-- posix failures --
|
||||
it "deleteDir, wrong file type (symlink to directory)" $
|
||||
deleteDir' (specDir `ba` "dirSym")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteDir, wrong file type (regular file)" $
|
||||
deleteDir' (specDir `ba` "file")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteDir, directory does not exist" $
|
||||
deleteDir' (specDir `ba` "doesNotExist")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteDir, directory not empty" $
|
||||
deleteDir' (specDir `ba` "dir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
|
||||
|
||||
it "deleteDir, can't open parent directory" $ do
|
||||
createDir' (specDir `ba` "noPerms/foo")
|
||||
noPerms (specDir `ba` "noPerms")
|
||||
(deleteDir' (specDir `ba` "noPerms/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied))
|
||||
>> normalDirPerms (specDir `ba` "noPerms")
|
||||
>> deleteDir' (specDir `ba` "noPerms/foo")
|
||||
|
||||
it "deleteDir, can't write to parent directory, still fine" $ do
|
||||
createDir' (specDir `ba` "noWritable/foo")
|
||||
noWritableDirPerms (specDir `ba` "noWritable")
|
||||
(deleteDir' (specDir `ba` "noWritable/foo")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied))
|
||||
normalDirPerms (specDir `ba` "noWritable")
|
||||
deleteDir' (specDir `ba` "noWritable/foo")
|
||||
|
||||
|
||||
|
||||
@ -1,69 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.DeleteFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
getSymbolicLinkStatus
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/deleteFileSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.deleteFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "deleteFile, regular file, all fine" $ do
|
||||
createRegularFile' (specDir `ba` "testFile")
|
||||
deleteFile' (specDir `ba` "testFile")
|
||||
getSymbolicLinkStatus (specDir `ba` "testFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteFile, symlink, all fine" $ do
|
||||
recreateSymlink' (specDir `ba` "syml")
|
||||
(specDir `ba` "testFile")
|
||||
deleteFile' (specDir `ba` "testFile")
|
||||
getSymbolicLinkStatus (specDir `ba` "testFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
-- posix failures --
|
||||
it "deleteFile, wrong file type (directory)" $
|
||||
deleteFile' (specDir `ba` "dir")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "deleteFile, file does not exist" $
|
||||
deleteFile' (specDir `ba` "doesNotExist")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "deleteFile, can't read directory" $
|
||||
deleteFile' (specDir `ba` "noPerms/blah")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
@ -1,88 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.GetDirsFilesSpec where
|
||||
|
||||
|
||||
import Data.List
|
||||
(
|
||||
sort
|
||||
)
|
||||
import Data.Maybe
|
||||
(
|
||||
fromJust
|
||||
)
|
||||
import qualified HPath as P
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import System.Posix.Env.ByteString
|
||||
(
|
||||
getEnv
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/getDirsFilesSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.getDirsFiles" $ do
|
||||
|
||||
-- successes --
|
||||
it "getDirsFiles, all fine" $ do
|
||||
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
|
||||
expectedFiles <- mapM P.parseRel [(specDir `ba ` ".hidden")
|
||||
,(specDir `ba ` "Lala")
|
||||
,(specDir `ba ` "dir")
|
||||
,(specDir `ba ` "dirsym")
|
||||
,(specDir `ba ` "file")
|
||||
,(specDir `ba ` "noPerms")
|
||||
,(specDir `ba ` "syml")]
|
||||
(fmap sort $ getDirsFiles' specDir)
|
||||
`shouldReturn` fmap (pwd P.</>) expectedFiles
|
||||
|
||||
-- posix failures --
|
||||
it "getDirsFiles, nonexistent directory" $
|
||||
getDirsFiles' (specDir `ba ` "nothingHere")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "getDirsFiles, wrong file type (file)" $
|
||||
getDirsFiles' (specDir `ba ` "file")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "getDirsFiles, wrong file type (symlink to file)" $
|
||||
getDirsFiles' (specDir `ba ` "syml")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "getDirsFiles, wrong file type (symlink to dir)" $
|
||||
getDirsFiles' (specDir `ba ` "dirsym")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "getDirsFiles, can't open directory" $
|
||||
getDirsFiles' (specDir `ba ` "noPerms")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,70 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.GetFileTypeSpec where
|
||||
|
||||
|
||||
import HSFM.FileSystem.FileOperations
|
||||
import Test.Hspec
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/getFileTypeSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.getFileType" $ do
|
||||
|
||||
-- successes --
|
||||
it "getFileType, regular file" $
|
||||
getFileType' (specDir `ba` "regularfile")
|
||||
`shouldReturn` RegularFile
|
||||
|
||||
it "getFileType, directory" $
|
||||
getFileType' (specDir `ba` "directory")
|
||||
`shouldReturn` Directory
|
||||
|
||||
it "getFileType, directory with null permissions" $
|
||||
getFileType' (specDir `ba` "noPerms")
|
||||
`shouldReturn` Directory
|
||||
|
||||
it "getFileType, symlink to file" $
|
||||
getFileType' (specDir `ba` "symlink")
|
||||
`shouldReturn` SymbolicLink
|
||||
|
||||
it "getFileType, symlink to directory" $
|
||||
getFileType' (specDir `ba` "symlinkD")
|
||||
`shouldReturn` SymbolicLink
|
||||
|
||||
it "getFileType, broken symlink" $
|
||||
getFileType' (specDir `ba` "brokenSymlink")
|
||||
`shouldReturn` SymbolicLink
|
||||
|
||||
-- posix failures --
|
||||
it "getFileType, file does not exist" $
|
||||
getFileType' (specDir `ba` "nothingHere")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "getFileType, can't open directory" $
|
||||
getFileType' (specDir `ba` "noPerms/forz")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
@ -1,93 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.MoveFileOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/moveFileOverwriteSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.moveFileOverwrite" $ do
|
||||
|
||||
-- successes --
|
||||
it "moveFileOverwrite, all fine" $
|
||||
moveFileOverwrite' (specDir `ba` "myFile")
|
||||
(specDir `ba` "movedFile")
|
||||
|
||||
it "moveFileOverwrite, all fine" $
|
||||
moveFileOverwrite' (specDir `ba` "myFile")
|
||||
(specDir `ba` "dir/movedFile")
|
||||
|
||||
it "moveFileOverwrite, all fine on symlink" $
|
||||
moveFileOverwrite' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "movedFile")
|
||||
|
||||
it "moveFileOverwrite, all fine on directory" $
|
||||
moveFileOverwrite' (specDir `ba` "dir")
|
||||
(specDir `ba` "movedFile")
|
||||
|
||||
it "moveFileOverwrite, destination file already exists" $
|
||||
moveFileOverwrite' (specDir `ba` "myFile")
|
||||
(specDir `ba` "alreadyExists")
|
||||
|
||||
-- posix failures --
|
||||
it "moveFileOverwrite, source file does not exist" $
|
||||
moveFileOverwrite' (specDir `ba` "fileDoesNotExist")
|
||||
(specDir `ba` "movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "moveFileOverwrite, can't write to destination directory" $
|
||||
moveFileOverwrite' (specDir `ba` "myFile")
|
||||
(specDir `ba` "noWritePerm/movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "moveFileOverwrite, can't open destination directory" $
|
||||
moveFileOverwrite' (specDir `ba` "myFile")
|
||||
(specDir `ba` "noPerms/movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "moveFileOverwrite, can't open source directory" $
|
||||
moveFileOverwrite' (specDir `ba` "noPerms/myFile")
|
||||
(specDir `ba` "movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
-- custom failures --
|
||||
it "moveFileOverwrite, move from file to dir" $
|
||||
moveFileOverwrite' (specDir `ba` "myFile")
|
||||
(specDir `ba` "alreadyExistsD")
|
||||
`shouldThrow`
|
||||
isDirDoesExist
|
||||
|
||||
it "moveFileOverwrite, source and dest are same file" $
|
||||
moveFileOverwrite' (specDir `ba` "myFile")
|
||||
(specDir `ba` "myFile")
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
@ -1,95 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.MoveFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/moveFileSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.moveFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "moveFile, all fine" $
|
||||
moveFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "movedFile")
|
||||
|
||||
it "moveFile, all fine" $
|
||||
moveFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "dir/movedFile")
|
||||
|
||||
it "moveFile, all fine on symlink" $
|
||||
moveFile' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "movedFile")
|
||||
|
||||
it "moveFile, all fine on directory" $
|
||||
moveFile' (specDir `ba` "dir")
|
||||
(specDir `ba` "movedFile")
|
||||
|
||||
-- posix failures --
|
||||
it "moveFile, source file does not exist" $
|
||||
moveFile' (specDir `ba` "fileDoesNotExist")
|
||||
(specDir `ba` "movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "moveFile, can't write to destination directory" $
|
||||
moveFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "noWritePerm/movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "moveFile, can't open destination directory" $
|
||||
moveFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "noPerms/movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "moveFile, can't open source directory" $
|
||||
moveFile' (specDir `ba` "noPerms/myFile")
|
||||
(specDir `ba` "movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
-- custom failures --
|
||||
it "moveFile, destination file already exists" $
|
||||
moveFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "alreadyExists")
|
||||
`shouldThrow`
|
||||
isFileDoesExist
|
||||
|
||||
it "moveFile, move from file to dir" $
|
||||
moveFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "alreadyExistsD")
|
||||
`shouldThrow`
|
||||
isDirDoesExist
|
||||
|
||||
it "moveFile, source and dest are same file" $
|
||||
moveFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "myFile")
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
@ -1,95 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.RecreateSymlinkSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/recreateSymlinkSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.recreateSymlink" $ do
|
||||
|
||||
-- successes --
|
||||
it "recreateSymLink, all fine" $ do
|
||||
recreateSymlink' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "movedFile")
|
||||
removeFileIfExists (specDir `ba` "movedFile")
|
||||
|
||||
it "recreateSymLink, all fine" $ do
|
||||
recreateSymlink' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "dir/movedFile")
|
||||
removeFileIfExists (specDir `ba` "dir/movedFile")
|
||||
|
||||
-- posix failures --
|
||||
it "recreateSymLink, wrong input type (file)" $
|
||||
recreateSymlink' (specDir `ba` "myFile")
|
||||
(specDir `ba` "movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "recreateSymLink, wrong input type (directory)" $
|
||||
recreateSymlink' (specDir `ba` "dir")
|
||||
(specDir `ba` "movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
it "recreateSymLink, can't write to destination directory" $
|
||||
recreateSymlink' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "noWritePerm/movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "recreateSymLink, can't open destination directory" $
|
||||
recreateSymlink' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "noPerms/movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "recreateSymLink, can't open source directory" $
|
||||
recreateSymlink' (specDir `ba` "noPerms/myFileL")
|
||||
(specDir `ba` "movedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "recreateSymLink, destination file already exists" $
|
||||
recreateSymlink' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "alreadyExists")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "recreateSymLink, destination already exists and is a dir" $
|
||||
recreateSymlink' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "alreadyExistsD")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
-- custom failures --
|
||||
it "recreateSymLink, source and destination are the same file" $
|
||||
recreateSymlink' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "myFileL")
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
@ -1,95 +0,0 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.RenameFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import Utils
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.ByteString.UTF8 (toString)
|
||||
|
||||
|
||||
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
|
||||
ba = BS.append
|
||||
|
||||
specDir :: BS.ByteString
|
||||
specDir = "test/FileSystem/FileOperations/renameFileSpec/"
|
||||
|
||||
specDir' :: String
|
||||
specDir' = toString specDir
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "HSFM.FileSystem.FileOperations.renameFile" $ do
|
||||
|
||||
-- successes --
|
||||
it "renameFile, all fine" $
|
||||
renameFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "renamedFile")
|
||||
|
||||
it "renameFile, all fine" $
|
||||
renameFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "dir/renamedFile")
|
||||
|
||||
it "renameFile, all fine on symlink" $
|
||||
renameFile' (specDir `ba` "myFileL")
|
||||
(specDir `ba` "renamedFile")
|
||||
|
||||
it "renameFile, all fine on directory" $
|
||||
renameFile' (specDir `ba` "dir")
|
||||
(specDir `ba` "renamedFile")
|
||||
|
||||
-- posix failures --
|
||||
it "renameFile, source file does not exist" $
|
||||
renameFile' (specDir `ba` "fileDoesNotExist")
|
||||
(specDir `ba` "renamedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "renameFile, can't write to output directory" $
|
||||
renameFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "noWritePerm/renamedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "renameFile, can't open output directory" $
|
||||
renameFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "noPerms/renamedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "renameFile, can't open source directory" $
|
||||
renameFile' (specDir `ba` "noPerms/myFile")
|
||||
(specDir `ba` "renamedFile")
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
-- custom failures --
|
||||
it "renameFile, destination file already exists" $
|
||||
renameFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "alreadyExists")
|
||||
`shouldThrow`
|
||||
isFileDoesExist
|
||||
|
||||
it "renameFile, move from file to dir" $
|
||||
renameFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "alreadyExistsD")
|
||||
`shouldThrow`
|
||||
isDirDoesExist
|
||||
|
||||
it "renameFile, source and dest are same file" $
|
||||
renameFile' (specDir `ba` "myFile")
|
||||
(specDir `ba` "myFile")
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@ -1 +0,0 @@
|
||||
inputDir/
|
||||
@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@ -1 +0,0 @@
|
||||
inputDir/
|
||||
@ -1,16 +0,0 @@
|
||||
adaöölsdaöl
|
||||
dsalö
|
||||
ölsda
|
||||
ääödsf
|
||||
äsdfä
|
||||
öä453
|
||||
öä
|
||||
435
|
||||
ä45343
|
||||
5
|
||||
453
|
||||
453453453
|
||||
das
|
||||
asd
|
||||
das
|
||||
|
||||
@ -1,4 +0,0 @@
|
||||
abc
|
||||
def
|
||||
|
||||
dsadasdsa
|
||||
@ -1 +0,0 @@
|
||||
inputFile
|
||||
@ -1,2 +0,0 @@
|
||||
abc
|
||||
def
|
||||
@ -1 +0,0 @@
|
||||
inputFile
|
||||
@ -1 +0,0 @@
|
||||
dir
|
||||
@ -1 +0,0 @@
|
||||
dir
|
||||
@ -1 +0,0 @@
|
||||
foo
|
||||
@ -1 +0,0 @@
|
||||
dir
|
||||
@ -1 +0,0 @@
|
||||
Lala
|
||||
@ -1 +0,0 @@
|
||||
broken
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user