LIB: refactor FileOperation and related Errors

* move FileOperation/Copy/Move types to its own UtilTypes module
* remove runFileOp, since it's hard to really do the correct
  thing here for all possible exceptions... instead, let the
  GUI logic handle this
* introduce copyDirRecursiveOverwrite, copyFileOverwrite and
  easyCopyOverwrite
* use our own throwSameFile on functions to distinguish between
  "same file" and "file already exists"
* don't follow destination in copyFile* either
* improve throwSameFile, by examining device and file ids
* add isWritable
* improve documentation
* adjust and fix tests

hsfm.cabal

@@ -27,6 +27,7 @@ library
                        HSFM.FileSystem.Errors
                        HSFM.FileSystem.FileOperations
                        HSFM.FileSystem.FileType
+                       HSFM.FileSystem.UtilTypes
                        HSFM.Utils.IO
                        HSFM.Utils.MyPrelude
 
@@ -120,7 +121,9 @@ Test-Suite spec
   Main-Is:              Spec.hs
   other-modules:
                         FileSystem.FileOperations.CopyDirRecursiveSpec
+                        FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec
                         FileSystem.FileOperations.CopyFileSpec
+                        FileSystem.FileOperations.CopyFileOverwriteSpec
                         FileSystem.FileOperations.CreateDirSpec
                         FileSystem.FileOperations.CreateRegularFileSpec
                         FileSystem.FileOperations.DeleteDirRecursiveSpec

src/HSFM/FileSystem/Errors.hs

@@ -52,7 +52,11 @@ import System.IO.Error
   )
 
 import qualified System.Posix.Directory.ByteString as PFD
-import System.Posix.FilePath
+import System.Posix.Files.ByteString
+  (
+    fileAccess
+  , getFileStatus
+  )
 import qualified System.Posix.Files.ByteString as PF
 
 
@@ -156,18 +160,28 @@ throwDirDoesNotExist fp =
                                          . P.fromAbs $ fp)
 
 
-throwSameFile :: Path Abs -- ^ will be canonicalized
+-- |Uses `isSameFile` and throws `SameFile` if it returns True.
-              -> Path Abs -- ^ will be canonicalized
+throwSameFile :: Path Abs
+              -> Path Abs
               -> IO ()
-throwSameFile fp1 fp2 = do
+throwSameFile fp1 fp2 =
-  fp1' <- fmap P.fromAbs $ P.canonicalizePath fp1
+  whenM (sameFile fp1 fp2)
-  -- TODO: clean this up... if canonicalizing fp2 fails we try to
+        (throw $ SameFile (P.fromAbs fp1) (P.fromAbs fp2))
-  --       canonicalize `dirname fp2`
+
-  fp2' <- catchIOError (fmap P.fromAbs $ P.canonicalizePath fp2)
+
-                       (\_ -> fmap P.fromAbs
+-- |Check if the files are the same by examining device and file id.
-                       $ (\x -> maybe x (\y -> x P.</> y) $ P.basename fp2)
+-- This follows symbolic links.
-                                <$> (P.canonicalizePath $ P.dirname fp2))
+sameFile :: Path Abs -> Path Abs -> IO Bool
-  when (equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')
+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
@@ -179,14 +193,13 @@ throwDestinationInSource :: Path Abs -- ^ source dir
                                      --   must exist
                          -> IO ()
 throwDestinationInSource source dest = do
-  source' <- P.canonicalizePath source
   dest'   <- (\x -> maybe x (\y -> x P.</> y) $ P.basename dest)
              <$> (P.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.getSymbolicLinkStatus (P.fromAbs source')
+              $ PF.getFileStatus (P.fromAbs source)
   when (elem sid dids)
        (throw $ DestinationInSource (P.fromAbs dest)
                                     (P.fromAbs source))
@@ -210,6 +223,13 @@ doesDirectoryExist 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

src/HSFM/FileSystem/FileOperations.hs

@@ -49,8 +49,7 @@ import Control.Exception
   )
 import Control.Monad
   (
-    forM_
+    void
-  , void
   , when
   )
 import Data.ByteString
@@ -89,6 +88,10 @@ import Foreign.Ptr
   (
     Ptr
   )
+import GHC.IO.Exception
+  (
+    IOErrorType(..)
+  )
 import HPath
   (
     Path
@@ -97,7 +100,13 @@ import HPath
   )
 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
@@ -128,6 +137,7 @@ import System.Posix.Files.ByteString
   , readSymbolicLink
   , removeLink
   , rename
+  , setFileMode
   , unionFileModes
   )
 import qualified System.Posix.Files.ByteString as PF
@@ -150,33 +160,10 @@ import System.Posix.Types
 
 
 
--- TODO: file operations should be threaded and not block the UI
 -- TODO: make sure we do the right thing for BlockDev, CharDev etc...
 --       most operations are not implemented for these
--- TODO: say which low-level syscalls are involved
 
 
--- |Data type describing an actual file operation that can be
--- carried out via `runFileOp`. Useful to build up a list of operations
--- or delay operations.
-data FileOperation = FCopy    Copy
-                   | FMove    Move
-                   | FDelete  [Path Abs]
-                   | FOpen    (Path Abs)
-                   | FExecute (Path Abs) [ByteString]
-                   | None
-
-
--- |Data type describing partial or complete file copy operation.
--- CC stands for a complete operation and can be used for `runFileOp`.
-data Copy = PartialCopy [Path Abs]
-          | Copy        [Path Abs] (Path Abs)
-
-
--- |Data type describing partial or complete file move operation.
--- MC stands for a complete operation and can be used for `runFileOp`.
-data Move = PartialMove [Path Abs]
-          | Move        [Path Abs] (Path Abs)
 
 
 data FileType = Directory
@@ -190,33 +177,6 @@ data FileType = Directory
 
 
 
--- |Run a given FileOperation. If the FileOperation is partial, it will
--- be returned. Returns `Nothing` on success.
---
--- Since file operations can be delayed, this is `Path Abs` based, not
--- `File` based. This makes sure we don't have stale
--- file information.
-runFileOp :: FileOperation -> IO (Maybe FileOperation)
-runFileOp fo' =
-  case fo' of
-    (FCopy (Copy froms to)) -> do
-      forM_ froms $ \x -> do
-        toname <- P.basename x
-        easyCopy x (to P.</> toname)
-      return Nothing
-    (FCopy fo) -> return $ Just $ FCopy fo
-    (FMove (Move froms to)) -> do
-      forM_ froms $ \x -> do
-        toname <- P.basename x
-        moveFile x (to P.</> toname)
-      return Nothing
-    (FMove fo) -> return $ Just $ FMove fo
-    (FDelete fps) ->
-      mapM_ easyDelete fps >> return Nothing
-    (FOpen fp) -> openFile fp >> return Nothing
-    (FExecute fp args) -> executeFile fp args >> return Nothing
-    _ -> return Nothing
-
 
 
     --------------------
@@ -244,15 +204,16 @@ runFileOp fo' =
 --    - `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)
---    - `AlreadyExists` if source and destination are the same directory
+--    - `SameFile` if source and destination are the same file (`FmIOException`)
 --    - `AlreadyExists` if destination already exists
---    - `DestinationInSource` if destination is contained in source
+--    - `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
@@ -275,6 +236,51 @@ copyDirRecursive fromp destdirp
           _            -> 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.
 --
@@ -285,7 +291,7 @@ copyDirRecursive fromp destdirp
 --    - `PermissionDenied` if output directory cannot be written to
 --    - `PermissionDenied` if source directory cannot be opened
 --    - `AlreadyExists` if destination file already exists
---    - `AlreadyExists` if destination and source are the same file
+--    - `SameFile` if source and destination are the same file (`FmIOException`)
 --
 -- Note: calls `symlink`
 recreateSymlink :: Path Abs  -- ^ the old symlink file
@@ -293,11 +299,12 @@ recreateSymlink :: Path Abs  -- ^ the old symlink 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 dir with the given filename.
+-- |Copies the given regular file to the given destination.
 -- Neither follows symbolic links, nor accepts them.
 -- For "copying" symbolic links, use `recreateSymlink` instead.
 --
@@ -308,19 +315,29 @@ recreateSymlink symsource newsym
 --    - `PermissionDenied` if source directory can't be opened
 --    - `InvalidArgument` if source file is wrong type (symlink)
 --    - `InvalidArgument` if source file is wrong type (directory)
---    - `AlreadyExists` if source and destination are the same file
+--    - `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 = _copyFile SPI.defaultFileFlags { exclusive = True } from to
+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.
+-- |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
@@ -328,19 +345,35 @@ copyFile from to = _copyFile SPI.defaultFileFlags { exclusive = True } from to
 --    - `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 = _copyFile SPI.defaultFileFlags { exclusive = False } from to
+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 :: SPI.OpenFileFlags
+_copyFile :: [SPDF.Flags]
+          -> [SPDF.Flags]
           -> Path Abs  -- ^ source file
           -> Path Abs  -- ^ destination file
           -> IO ()
-_copyFile off from to
+_copyFile sflags dflags from to
   =
     -- from sendfile(2) manpage:
     --   Applications  may  wish  to  fall back to read(2)/write(2) in the case
@@ -352,24 +385,26 @@ _copyFile off from to
   where
     -- this is low-level stuff utilizing sendfile(2) for speed
     sendFileCopy source dest =
-      bracket (SPDT.openFd source SPI.ReadOnly [SPDF.oNofollow] Nothing)
+      bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
               SPI.closeFd
               $ \sfd -> do
                 fileM <- System.Posix.Files.ByteString.fileMode
                          <$> getFdStatus sfd
-                bracketeer (SPI.openFd dest SPI.WriteOnly (Just fileM) off)
+                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 [SPDF.oNofollow] Nothing)
+      bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
               SPI.closeFd
               $ \sfd -> do
                 fileM <- System.Posix.Files.ByteString.fileMode
                          <$> getFdStatus sfd
-                bracketeer (SPI.openFd dest SPI.WriteOnly (Just fileM) off)
+                bracketeer (SPDT.openFd dest SPI.WriteOnly
+                             dflags $ Just fileM)
                            SPI.closeFd
                            (\fd -> SPI.closeFd fd >> deleteFile to)
                             $ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->
@@ -408,6 +443,23 @@ easyCopy from to = do
                                              "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
+
+
 
 
 
@@ -576,7 +628,7 @@ createDir dest = createDirectory (P.fromAbs dest) newDirPerms
 --     - `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
+--     - `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 ()
@@ -603,13 +655,14 @@ renameFile fromf tof = do
 --     - `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
+--     - `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 =
+moveFile from to = do
+  throwSameFile from to
   catchErrno [eXDEV] (renameFile from to) $ do
     easyCopy from to
     easyDelete from

src/HSFM/FileSystem/UtilTypes.hs

@@ -0,0 +1,84 @@
+{--
+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 #-}
+{-# 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.UtilTypes where
+
+
+import Data.ByteString
+  (
+    ByteString
+  )
+import HPath
+  (
+    Path
+  , Abs
+  , Fn
+  )
+
+
+-- |Data type describing file operations.
+-- Useful to build up a list of operations or delay operations.
+data FileOperation = FCopy    Copy
+                   | FMove    Move
+                   | FDelete  [Path Abs]
+                   | FOpen    (Path Abs)
+                   | FExecute (Path Abs) [ByteString]
+                   | None
+
+
+-- |Data type describing partial or complete file copy operation.
+data Copy = PartialCopy [Path Abs] -- source files
+          | Copy        [Path Abs] -- source files
+                        (Path Abs) -- base destination directory
+
+
+-- |Data type describing partial or complete file move operation.
+data Move = PartialMove [Path Abs] -- source files
+          | Move        [Path Abs] -- source files
+                        (Path Abs) -- base destination directory
+
+
+-- |Collision modes that describe the behavior in case a file collision
+-- happens.
+data FCollisonMode = Strict  -- ^ fail if the target already exists
+                   | Overwrite
+                   | OverwriteAll
+                   | Skip
+                   | Rename (Path Fn)
+

test/FileSystem/FileOperations/CopyDirRecursiveOverwriteSpec.hs

@@ -0,0 +1,99 @@
+{-# 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
+
+
+
+copyDirRecursiveOverwriteSpec :: Spec
+copyDirRecursiveOverwriteSpec =
+  describe "HSFM.FileSystem.FileOperations.copyDirRecursiveOverwrite" $ do
+
+    -- successes --
+    it "copyDirRecursiveOverwrite, all fine" $ do
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
+      removeDirIfExists "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
+
+    it "copyDirRecursiveOverwrite, all fine and compare" $ do
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
+      (system $ "diff -r --no-dereference "
+                          ++ "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir" ++ " "
+                          ++ "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir")
+        `shouldReturn` ExitSuccess
+      removeDirIfExists "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
+
+    it "copyDirRecursiveOverwrite, destination dir already exists" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/alreadyExistsD"
+
+    -- posix failures --
+    it "copyDirRecursiveOverwrite, source directory does not exist" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/doesNotExist"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == NoSuchThing)
+
+    it "copyDirRecursiveOverwrite, no write permission on output dir" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noWritePerm/foo"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == PermissionDenied)
+
+    it "copyDirRecursiveOverwrite, cannot open output dir" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms/foo"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == PermissionDenied)
+
+    it "copyDirRecursiveOverwrite, cannot open source dir" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/foo"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == PermissionDenied)
+
+    it "copyDirRecursiveOverwrite, destination already exists and is a file" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/alreadyExists"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == InappropriateType)
+
+    it "copyDirRecursiveOverwrite, wrong input (regular file)" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/wrongInput"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == InappropriateType)
+
+    it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/wrongInputSymL"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
+        `shouldThrow`
+        (\e -> ioeGetErrorType e == InvalidArgument)
+
+    -- custom failures
+    it "copyDirRecursiveOverwrite, destination in source" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir/foo"
+        `shouldThrow`
+        isDestinationInSource
+
+    it "copyDirRecursiveOverwrite, destination and source same directory" $
+      copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+                                 "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
+        `shouldThrow`
+        isSameFile

test/FileSystem/FileOperations/CopyDirRecursiveSpec.hs

@@ -75,12 +75,6 @@ copyDirRecursiveSpec =
         `shouldThrow`
         (\e -> ioeGetErrorType e == AlreadyExists)
 
-    it "copyDirRecursive, destination and source same directory" $
-      copyDirRecursive' "test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir"
-                        "test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir"
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-
     it "copyDirRecursive, wrong input (regular file)" $
       copyDirRecursive' "test/FileSystem/FileOperations/copyDirRecursiveSpec/wrongInput"
                         "test/FileSystem/FileOperations/copyDirRecursiveSpec/outputDir"
@@ -100,3 +94,8 @@ copyDirRecursiveSpec =
         `shouldThrow`
         isDestinationInSource
 
+    it "copyDirRecursive, destination and source same directory" $
+      copyDirRecursive' "test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir"
+                        "test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir"
+        `shouldThrow`
+        isSameFile

test/FileSystem/FileOperations/CopyFileOverwriteSpec.hs

@@ -4,6 +4,7 @@ module FileSystem.FileOperations.CopyFileOverwriteSpec where
 
 
 import Test.Hspec
+import HSFM.FileSystem.Errors
 import System.IO.Error
   (
     ioeGetErrorType
@@ -32,10 +33,6 @@ copyFileOverwriteSpec =
       copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
                 "test/FileSystem/FileOperations/copyFileOverwriteSpec/alreadyExists"
 
-    it "copyFileOverwrite, output and input are same file" $
-      copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
-                "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
-
     it "copyFileOverwrite, and compare" $ do
       copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
                 "test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
@@ -87,3 +84,8 @@ copyFileOverwriteSpec =
         `shouldThrow`
         (\e -> ioeGetErrorType e == InappropriateType)
 
+    -- custom failures --
+    it "copyFileOverwrite, output and input are same file" $
+      copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
+                "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
+        `shouldThrow` isSameFile

test/FileSystem/FileOperations/CopyFileSpec.hs

@@ -4,6 +4,7 @@ module FileSystem.FileOperations.CopyFileSpec where
 
 
 import Test.Hspec
+import HSFM.FileSystem.Errors
 import System.IO.Error
   (
     ioeGetErrorType
@@ -73,12 +74,6 @@ copyFileSpec =
         `shouldThrow`
         (\e -> ioeGetErrorType e == InappropriateType)
 
-    it "copyFile, output and input are same file" $
-      copyFile' "test/FileSystem/FileOperations/copyFileSpec/inputFile"
-                "test/FileSystem/FileOperations/copyFileSpec/inputFile"
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-
     it "copyFile, output file already exists" $
       copyFile' "test/FileSystem/FileOperations/copyFileSpec/inputFile"
                 "test/FileSystem/FileOperations/copyFileSpec/alreadyExists"
@@ -91,3 +86,9 @@ copyFileSpec =
         `shouldThrow`
         (\e -> ioeGetErrorType e == AlreadyExists)
 
+    -- custom failures --
+    it "copyFile, output and input are same file" $
+      copyFile' "test/FileSystem/FileOperations/copyFileSpec/inputFile"
+                "test/FileSystem/FileOperations/copyFileSpec/inputFile"
+        `shouldThrow`
+        isSameFile

test/FileSystem/FileOperations/RecreateSymlinkSpec.hs

@@ -4,6 +4,7 @@ module FileSystem.FileOperations.RecreateSymlinkSpec where
 
 
 import Test.Hspec
+import HSFM.FileSystem.Errors
 import System.IO.Error
   (
     ioeGetErrorType
@@ -73,9 +74,10 @@ recreateSymlinkSpec =
         `shouldThrow`
         (\e -> ioeGetErrorType e == AlreadyExists)
 
+    -- custom failures --
     it "recreateSymLink, source and destination are the same file" $
       recreateSymlink' "test/FileSystem/FileOperations/recreateSymlinkSpec/myFileL"
                        "test/FileSystem/FileOperations/recreateSymlinkSpec/myFileL"
         `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
+        isSameFile
 

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/alreadyExistsD/bar/inputFile3

@@ -0,0 +1,8 @@
+dadasasddas
+sda
+
+!!1
+sda
+
+
+11

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/alreadyExistsD/foo/inputFile1

@@ -0,0 +1 @@
+dadasasddas

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/alreadyExistsD/inputFile2

@@ -0,0 +1,4 @@
+dadasasddas
+das
+sda
+sda

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir/bar/inputFile3

@@ -0,0 +1,8 @@
+dadasasddas
+sda
+
+!!1
+sda
+
+
+11

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir/foo/inputFile1

@@ -0,0 +1 @@
+dadasasddas

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir/inputFile2

@@ -0,0 +1,4 @@
+dadasasddas
+das
+sda
+sda

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms/inputDir/bar/inputFile3

@@ -0,0 +1,8 @@
+dadasasddas
+sda
+
+!!1
+sda
+
+
+11

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms/inputDir/foo/inputFile1

@@ -0,0 +1 @@
+dadasasddas

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms/inputDir/inputFile2

@@ -0,0 +1,4 @@
+dadasasddas
+das
+sda
+sda

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/wrongInputSymL

@@ -0,0 +1 @@
+inputDir/

test/FileSystem/FileOperations/copyFileOverwriteSpec/alreadyExists

@@ -1,4 +1,16 @@
-abc
+adaöölsdaöl
-def
+dsalö
+ölsda
+ääödsf
+äsdfä
+öä453
+öä
+435
+ä45343
+5
+453
+453453453
+das
+asd
+das
 
-dsadasdsa

test/Spec.hs

@@ -3,6 +3,7 @@
 import Test.Hspec
 
 import FileSystem.FileOperations.CopyDirRecursiveSpec
+import FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec
 import FileSystem.FileOperations.CopyFileOverwriteSpec
 import FileSystem.FileOperations.CopyFileSpec
 import FileSystem.FileOperations.CreateDirSpec
@@ -26,6 +27,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
   let tests = [copyFileSpec
               ,copyFileOverwriteSpec
               ,copyDirRecursiveSpec
+              ,copyDirRecursiveOverwriteSpec
               ,createDirSpec
               ,createRegularFileSpec
               ,renameFileSpec
@@ -48,6 +50,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
     noWriteDirs =  ["test/FileSystem/FileOperations/copyFileSpec/outputDirNoWrite"
                    ,"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputDirNoWrite"
                    ,"test/FileSystem/FileOperations/copyDirRecursiveSpec/noWritePerm"
+                   ,"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noWritePerm"
                    ,"test/FileSystem/FileOperations/createDirSpec/noWritePerms"
                    ,"test/FileSystem/FileOperations/createRegularFileSpec/noWritePerms"
                    ,"test/FileSystem/FileOperations/renameFileSpec/noWritePerm"
@@ -57,6 +60,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
     noPermsDirs =  ["test/FileSystem/FileOperations/copyFileSpec/noPerms"
                    ,"test/FileSystem/FileOperations/copyFileOverwriteSpec/noPerms"
                    ,"test/FileSystem/FileOperations/copyDirRecursiveSpec/noPerms"
+                   ,"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms"
                    ,"test/FileSystem/FileOperations/createDirSpec/noPerms"
                    ,"test/FileSystem/FileOperations/createRegularFileSpec/noPerms"
                    ,"test/FileSystem/FileOperations/renameFileSpec/noPerms"

test/Utils.hs

@@ -82,6 +82,11 @@ copyDirRecursive' inputDirP outputDirP =
   withPwd' inputDirP outputDirP copyDirRecursive
 
 
+copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO ()
+copyDirRecursiveOverwrite' inputDirP outputDirP =
+  withPwd' inputDirP outputDirP copyDirRecursiveOverwrite
+
+
 createDir' :: ByteString -> IO ()
 createDir' dest = withPwd dest createDir