GTK: pre-set input field when renaming files

And also compare the results.

.gitmodules

@@ -1,9 +1,6 @@
 [submodule "3rdparty/hpath"]
 	path = 3rdparty/hpath
 	url = https://github.com/hasufell/hpath.git
-[submodule "3rdparty/hinotify"]
-	path = 3rdparty/hinotify
-	url = https://github.com/hasufell/hinotify.git
 [submodule "3rdparty/simple-sendfile"]
 	path = 3rdparty/simple-sendfile
 	url = https://github.com/hasufell/simple-sendfile.git

README.md

@@ -23,7 +23,6 @@ Installation
 ```
 git submodule update --init --recursive
 cabal sandbox init
-cabal sandbox add-source 3rdparty/hinotify
 cabal sandbox add-source 3rdparty/hpath
 cabal sandbox add-source 3rdparty/hpath/3rdparty/posix-paths
 cabal sandbox add-source 3rdparty/simple-sendfile

hsfm.cabal

@@ -27,21 +27,18 @@ library
                        HSFM.FileSystem.Errors
                        HSFM.FileSystem.FileOperations
                        HSFM.FileSystem.FileType
-                       HSFM.Settings.Bookmarks
+                       HSFM.FileSystem.UtilTypes
                        HSFM.Utils.IO
                        HSFM.Utils.MyPrelude
 
   build-depends:
-                       attoparsec,
                        base >= 4.7,
                        bytestring,
                        containers,
                        data-default,
-                       errors,
                        filepath >= 1.3.0.0,
-                       hinotify,
+                       hinotify-bytestring,
                        hpath,
-                       monad-loops,
                        mtl >= 2.2,
                        old-locale >= 1,
                        posix-paths,
@@ -52,8 +49,7 @@ library
                        time >= 1.4.2,
                        unix,
                        unix-bytestring,
-                       utf8-string,
-                       word8
+                       utf8-string
   hs-source-dirs:      src
   default-language:    Haskell2010
   Default-Extensions:  RecordWildCards
@@ -71,6 +67,7 @@ executable hsfm-gtk
   other-modules:
                        HSFM.GUI.Glib.GlibString
                        HSFM.GUI.Gtk.Callbacks
+                       HSFM.GUI.Gtk.Callbacks.Utils
                        HSFM.GUI.Gtk.Data
                        HSFM.GUI.Gtk.Dialogs
                        HSFM.GUI.Gtk.Errors
@@ -89,7 +86,7 @@ executable hsfm-gtk
                        filepath >= 1.3.0.0,
                        glib >= 0.13,
                        gtk3 >= 0.14.1,
-                       hinotify,
+                       hinotify-bytestring,
                        hpath,
                        hsfm,
                        mtl >= 2.2,
@@ -116,3 +113,38 @@ executable hsfm-gtk
     -threaded
     -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

src/HSFM/FileSystem/Errors.hs

@@ -17,6 +17,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 -- |Provides error handling.
@@ -26,19 +27,27 @@ module HSFM.FileSystem.Errors where
 import Control.Exception
 import Control.Monad
   (
-    when
-  , forM
+    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
     (
@@ -49,10 +58,15 @@ import HSFM.Utils.IO
 import System.IO.Error
   (
     catchIOError
+  , ioeGetErrorType
   )
 
 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
 
 
@@ -72,7 +86,7 @@ data FmIOException = FileDoesNotExist ByteString
                    | Can'tOpenDirectory ByteString
                    | CopyFailed String
                    | MoveFailed String
-  deriving (Typeable)
+  deriving (Typeable, Eq, Data)
 
 
 instance Show FmIOException where
@@ -106,6 +120,26 @@ 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 ]--
@@ -126,28 +160,38 @@ throwDirDoesExist fp =
 
 throwFileDoesNotExist :: Path Abs -> IO ()
 throwFileDoesNotExist fp =
-  whenM (doesFileExist fp) (throw . FileDoesExist
-                                  . P.fromAbs $ fp)
+  unlessM (doesFileExist fp) (throw . FileDoesNotExist
+                                    . P.fromAbs $ fp)
 
 
 throwDirDoesNotExist :: Path Abs -> IO ()
 throwDirDoesNotExist fp =
-  whenM (doesDirectoryExist fp) (throw . DirDoesExist
-                                       . P.fromAbs $ fp)
+  unlessM (doesDirectoryExist fp) (throw . DirDoesNotExist
+                                         . P.fromAbs $ fp)
 
 
-throwSameFile :: Path Abs -- ^ will be canonicalized
-              -> Path Abs -- ^ will be canonicalized
+-- |Uses `isSameFile` and throws `SameFile` if it returns True.
+throwSameFile :: Path Abs
+              -> Path Abs
               -> IO ()
-throwSameFile fp1 fp2 = do
-  fp1' <- fmap P.fromAbs $ P.canonicalizePath fp1
-  -- TODO: clean this up... if canonicalizing fp2 fails we try to
-  --       canonicalize `dirname fp2`
-  fp2' <- catchIOError (fmap P.fromAbs $ P.canonicalizePath fp2)
-                       (\_ -> fmap P.fromAbs
-                       $ (\x -> maybe x (\y -> x P.</> y) $ P.basename fp2)
-                                <$> (P.canonicalizePath $ P.dirname fp2))
-  when (equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')
+throwSameFile fp1 fp2 =
+  whenM (sameFile fp1 fp2)
+        (throw $ 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
@@ -159,41 +203,45 @@ 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))
 
 
--- |Checks if the given file exists and is not a directory. This follows
--- symlinks, but will return True if the symlink is broken.
+-- |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
-    fp' <- fmap P.fromAbs $ P.canonicalizePath fp
-    fs  <- PF.getFileStatus fp'
+    fs  <- PF.getSymbolicLinkStatus (P.fromAbs fp)
     return $ not . PF.isDirectory $ fs
 
 
--- |Checks if the given file exists and is a directory. This follows
--- symlinks, but will return False if the symlink is broken.
+-- |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
-    fp' <- fmap P.fromAbs $ P.canonicalizePath fp
-    fs  <- PF.getFileStatus fp'
+    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`.
+-- opened. This invokes `openDirStream` which follows symlinks.
 canOpenDirectory :: Path Abs -> IO Bool
 canOpenDirectory fp =
   handleIOError (\_ -> return False) $ do
@@ -249,3 +297,43 @@ rethrowErrnoAs en fmex action = catchErrno en action (throw fmex)
 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

src/HSFM/FileSystem/FileType.hs

@@ -18,39 +18,44 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
--- |This module provides data types for representing directories/files
--- and related operations on it, mostly internal stuff.
+
+-- |This module provides a data type for representing directories/files
+-- in a well-typed and convenient way. This is useful to gather and
+-- save information about a file, so the information can be easily
+-- processed in e.g. a GUI.
 --
--- It doesn't allow to represent the whole filesystem, since that's only
--- possible through IO laziness, which introduces too much internal state.
+-- However, it's not meant to be used to interact with low-level
+-- functions that copy files etc, since there's no guarantee that
+-- the in-memory representation of the type still matches what is
+-- happening on filesystem level.
+--
+-- If you interact with low-level libraries, you must not pattern
+-- match on the `File a` type. Instead, you should only use the saved
+-- `path` and make no assumptions about the file the path might or
+-- might not point to.
 module HSFM.FileSystem.FileType where
 
 
 
 import Data.ByteString(ByteString)
 import Data.Default
-import Data.Maybe
-  (
-    catMaybes
-  )
 import Data.Time.Clock.POSIX
   (
     POSIXTime
   , posixSecondsToUTCTime
   )
 import Data.Time()
-import Foreign.C.Error
-  (
-    eACCES
-  )
 import HPath
   (
     Abs
   , Path
-  , Fn
   )
 import qualified HPath as P
 import HSFM.FileSystem.Errors
+import HSFM.FileSystem.FileOperations
+  (
+    getDirsFiles
+  )
 import HSFM.Utils.MyPrelude
 import Prelude hiding(readFile)
 import System.IO.Error
@@ -64,8 +69,7 @@ import System.Posix.FilePath
   )
 import System.Posix.Directory.Traversals
   (
-    getDirectoryContents
-  , realpath
+    realpath
   )
 import qualified System.Posix.Files.ByteString as PF
 import System.Posix.Types
@@ -93,8 +97,7 @@ import System.Posix.Types
 -- |The String in the path field is always a full path.
 -- The free type variable is used in the File/Dir constructor and can hold
 -- Handles, Strings representing a file's contents or anything else you can
--- think of. We catch any IO errors in the Failed constructor. an Exception
--- can be converted to a String with 'show'.
+-- think of. We catch any IO errors in the Failed constructor.
 data File a =
     Failed {
     path :: !(Path Abs)
@@ -461,19 +464,7 @@ isSocketC _        = False
 ---- IO HELPERS: ----
 
 
--- |Gets all filenames of the given directory. This excludes "." and "..".
-getDirsFiles :: Path Abs        -- ^ dir to read
-             -> IO [Path Abs]
-getDirsFiles p =
-  P.withAbsPath p $ \fp ->
-    rethrowErrnoAs [eACCES] (Can'tOpenDirectory fp)
-    $ return
-        . catMaybes
-        .   fmap (\x -> (P.</>) p <$> (parseMaybe . snd $ x))
-        =<< getDirectoryContents fp
-  where
-    parseMaybe :: ByteString -> Maybe (Path Fn)
-    parseMaybe = P.parseFn
+
 
 
 -- |Gets all file information.

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)
+

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -40,6 +40,10 @@ import Control.Monad.IO.Class
   (
     liftIO
   )
+import Data.ByteString
+  (
+    ByteString
+  )
 import Data.Foldable
   (
     for_
@@ -54,6 +58,8 @@ import HPath
 import HSFM.FileSystem.Errors
 import HSFM.FileSystem.FileOperations
 import HSFM.FileSystem.FileType
+import HSFM.FileSystem.UtilTypes
+import HSFM.GUI.Gtk.Callbacks.Utils
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Dialogs
 import HSFM.GUI.Gtk.MyView
@@ -327,12 +333,12 @@ del :: [Item] -> MyGUI -> MyView -> IO ()
 del [item] _ _ = withErrorDialog $ do
   let cmsg  = "Really delete \"" ++ getFPasStr item ++ "\"?"
   withConfirmationDialog cmsg
-    $ easyDelete item
+    $ easyDelete . path $ item
 -- this throws on the first error that occurs
 del items@(_:_) _ _ = withErrorDialog $ do
   let cmsg  = "Really delete " ++ show (length items) ++ " files?"
   withConfirmationDialog cmsg
-    $ forM_ items $ \item -> easyDelete item
+    $ forM_ items $ \item -> easyDelete . path $ item
 del _ _ _ = withErrorDialog
               . throw $ InvalidOperation
                         "Operation not supported on multiple files"
@@ -341,7 +347,7 @@ del _ _ _ = withErrorDialog
 -- |Initializes a file move operation.
 moveInit :: [Item] -> MyGUI -> MyView -> IO ()
 moveInit items@(_:_) mygui _ = do
-  writeTVarIO (operationBuffer mygui) (FMove . MP1 . map path $ items)
+  writeTVarIO (operationBuffer mygui) (FMove . PartialMove . map path $ items)
   let sbmsg = case items of
               (item:[]) -> "Move buffer: " ++ getFPasStr item
               _         -> "Move buffer: " ++ (show . length $ items)
@@ -355,7 +361,7 @@ moveInit _ _ _ = withErrorDialog
 -- |Supposed to be used with 'withRows'. Initializes a file copy operation.
 copyInit :: [Item] -> MyGUI -> MyView -> IO ()
 copyInit items@(_:_) mygui _ = do
-  writeTVarIO (operationBuffer mygui) (FCopy . CP1 . map path $ items)
+  writeTVarIO (operationBuffer mygui) (FCopy . PartialCopy . map path $ items)
   let sbmsg = case items of
               (item:[]) -> "Copy buffer: " ++ getFPasStr item
               _         -> "Copy buffer: " ++ (show . length $ items)
@@ -375,21 +381,18 @@ operationFinal mygui myview mitem = withErrorDialog $ do
             Nothing -> path <$> getCurrentDir myview
             Just x  -> return $ path x
   case op of
-    FMove (MP1 s) -> do
+    FMove (PartialMove s) -> do
       let cmsg = "Really move " ++ imsg s
                   ++ " to \"" ++ P.fpToString (P.fromAbs cdir)
                   ++ "\"?"
-      withConfirmationDialog cmsg . withCopyModeDialog
-        $ \cm -> do
-             void $ runFileOp (FMove . MC s cdir $ cm)
-             popStatusbar mygui
-             writeTVarIO (operationBuffer mygui) None
-    FCopy (CP1 s) -> do
+      withConfirmationDialog cmsg $ doFileOperation (FMove $ Move s cdir)
+      popStatusbar mygui
+      writeTVarIO (operationBuffer mygui) None
+    FCopy (PartialCopy s) -> do
       let cmsg = "Really copy " ++ imsg s
                  ++ " to \"" ++ P.fpToString (P.fromAbs cdir)
                  ++ "\"?"
-      withConfirmationDialog cmsg . withCopyModeDialog
-        $ \cm -> void $ runFileOp (FCopy . CC s cdir $ cm)
+      withConfirmationDialog cmsg $ doFileOperation (FCopy $ Copy s cdir)
     _ -> return ()
   where
     imsg s = case s of
@@ -400,26 +403,27 @@ operationFinal mygui myview mitem = withErrorDialog $ do
 -- |Create a new file.
 newFile :: MyGUI -> MyView -> IO ()
 newFile _ myview = withErrorDialog $ do
-  mfn   <- textInputDialog "Enter file name"
+  mfn   <- textInputDialog "Enter file name" ("" :: String)
   let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
-    createFile cdir fn
+    createRegularFile (path cdir P.</> fn)
 
 
 -- |Create a new directory.
 newDir :: MyGUI -> MyView -> IO ()
 newDir _ myview = withErrorDialog $ do
-  mfn   <- textInputDialog "Enter directory name"
+  mfn   <- textInputDialog "Enter directory name" ("" :: String)
   let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
-    createDir cdir fn
+    createDir (path cdir P.</> fn)
 
 
 renameF :: [Item] -> MyGUI -> MyView -> IO ()
 renameF [item] _ _ = withErrorDialog $ do
-  mfn  <- textInputDialog "Enter new file name"
+  iname <- P.fromRel <$> (P.basename $ path item)
+  mfn  <- textInputDialog "Enter new file name" (iname :: ByteString)
   let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
   for_ pmfn $ \fn -> do
     let cmsg = "Really rename \"" ++ getFPasStr item
@@ -427,7 +431,8 @@ renameF [item] _ _ = withErrorDialog $ do
                ++ P.fpToString (P.fromAbs $ (P.dirname . path $ item)
                                              P.</> fn) ++ "\"?"
     withConfirmationDialog cmsg $
-      HSFM.FileSystem.FileOperations.renameFile item fn
+      HSFM.FileSystem.FileOperations.renameFile (path item)
+                                                ((P.dirname $ path item) P.</> fn)
 renameF _ _ _ = withErrorDialog
                   . throw $ InvalidOperation
                             "Operation not supported on multiple files"
@@ -461,7 +466,7 @@ goHome mygui myview =  withErrorDialog $ do
 -- |Execute a given file.
 execute :: [Item] -> MyGUI -> MyView -> IO ()
 execute [item] _ _ = withErrorDialog $
-  void $ executeFile item []
+  void $ executeFile (path item) []
 execute _ _ _ = withErrorDialog
                   . throw $ InvalidOperation
                             "Operation not supported on multiple files"
@@ -475,10 +480,10 @@ open [item] mygui myview = withErrorDialog $
       nv <- readFile getFileInfo $ path r
       goDir mygui myview nv
     r ->
-      void $ openFile r
+      void $ openFile . path $ r
 -- this throws on the first error that occurs
 open (FileLikeList fs) _ _ = withErrorDialog $
-  forM_ fs $ \f -> void $ openFile f
+  forM_ fs $ \f -> void $ openFile . path $ f
 open _ _ _ = withErrorDialog
                . throw $ InvalidOperation
                          "Operation not supported on multiple files"
@@ -492,15 +497,6 @@ upDir mygui myview = withErrorDialog $ do
   goDir mygui myview nv
 
 
--- |Helper that is invoked for any directory change operations.
-goDir :: MyGUI -> MyView -> Item -> IO ()
-goDir mygui myview item = do
-  cdir <- getCurrentDir myview
-  modifyTVarIO (history myview)
-    (\(p, _) -> (path cdir `addHistory` p, []))
-  refreshView' mygui myview item
-
-
 -- |Go "back" in the history.
 goHistoryPrev :: MyGUI -> MyView -> IO ()
 goHistoryPrev mygui myview = do

src/HSFM/GUI/Gtk/Callbacks/Utils.hs

@@ -0,0 +1,102 @@
+{--
+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 ScopedTypeVariables #-}
+{-# OPTIONS_HADDOCK ignore-exports #-}
+
+module HSFM.GUI.Gtk.Callbacks.Utils where
+
+
+
+import Control.Monad
+  (
+    forM_
+  )
+import GHC.IO.Exception
+  (
+    IOErrorType(..)
+  )
+import qualified HPath as P
+import HSFM.FileSystem.Errors
+import HSFM.FileSystem.FileOperations
+import HSFM.FileSystem.FileType
+import HSFM.FileSystem.UtilTypes
+import HSFM.GUI.Gtk.Data
+import HSFM.GUI.Gtk.Dialogs
+import HSFM.GUI.Gtk.MyView
+import HSFM.GUI.Gtk.Utils
+import HSFM.Utils.IO
+  (
+    modifyTVarIO
+  )
+import Prelude hiding(readFile)
+
+
+
+
+-- |Carries out a file operation with the appropriate error handling
+-- allowing the user to react to various exceptions with further input.
+doFileOperation :: FileOperation -> IO ()
+doFileOperation (FCopy (Copy (f':fs') to)) =
+  _doFileOperation (f':fs') to easyCopyOverwrite easyCopy
+    $ doFileOperation (FCopy $ Copy fs' to)
+doFileOperation (FMove (Move (f':fs') to)) =
+  _doFileOperation (f':fs') to moveFileOverwrite moveFile
+    $ doFileOperation (FMove $ Move fs' to)
+  where
+
+doFileOperation _ = return ()
+
+
+_doFileOperation :: [P.Path b1]
+                 -> P.Path P.Abs
+                 -> (P.Path b1 -> P.Path P.Abs -> IO b)
+                 -> (P.Path b1 -> P.Path P.Abs -> IO a)
+                 -> IO ()
+                 -> IO ()
+_doFileOperation [] _ _ _ _ = return ()
+_doFileOperation (f:fs) to mcOverwrite mc rest = do
+  toname <- P.basename f
+  let topath = to P.</> toname
+  reactOnError (mc f topath >> rest)
+    [(AlreadyExists  , collisionAction fileCollisionDialog topath)]
+    [(FileDoesExist{}, collisionAction fileCollisionDialog topath)
+    ,(DirDoesExist{} , collisionAction fileCollisionDialog topath)
+    ,(SameFile{}     , collisionAction renameDialog topath)]
+  where
+    collisionAction diag topath = do
+      mcm <- diag . P.fromAbs $ topath
+      forM_ mcm $ \cm -> case cm of
+        Overwrite    -> mcOverwrite f topath >> rest
+        OverwriteAll -> forM_ (f:fs) $ \x -> do
+                          toname' <- P.basename x
+                          mcOverwrite x (to P.</> toname')
+        Skip         -> rest
+        Rename newn  -> mc f (to P.</> newn) >> rest
+        _            -> return ()
+
+
+-- |Helper that is invoked for any directory change operations.
+goDir :: MyGUI -> MyView -> Item -> IO ()
+goDir mygui myview item = do
+  cdir <- getCurrentDir myview
+  modifyTVarIO (history myview)
+    (\(p, _) -> (path cdir `addHistory` p, []))
+  refreshView' mygui myview item
+

src/HSFM/GUI/Gtk/Data.hs

@@ -35,9 +35,9 @@ import HPath
     Abs
   , Path
   )
-import HSFM.FileSystem.FileOperations
 import HSFM.FileSystem.FileType
-import System.INotify.ByteString
+import HSFM.FileSystem.UtilTypes
+import System.INotify
   (
     INotify
   )

src/HSFM/GUI/Gtk/Dialogs.hs

@@ -23,8 +23,7 @@ module HSFM.GUI.Gtk.Dialogs where
 
 import Control.Exception
   (
-    catch
-  , displayException
+    displayException
   , throw
   , IOException
   , catches
@@ -36,7 +35,15 @@ import Control.Monad
   , when
   , void
   )
+import Data.ByteString
+  (
+    ByteString
+  )
 import qualified Data.ByteString as BS
+import Data.ByteString.UTF8
+  (
+    fromString
+  )
 import Data.Version
   (
     showVersion
@@ -62,8 +69,8 @@ import Distribution.Verbosity
 import Graphics.UI.Gtk
 import qualified HPath as P
 import HSFM.FileSystem.Errors
-import HSFM.FileSystem.FileOperations
 import HSFM.FileSystem.FileType
+import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Glib.GlibString()
 import HSFM.GUI.Gtk.Data
 import HSFM.GUI.Gtk.Errors
@@ -71,6 +78,18 @@ import Paths_hsfm
   (
     getDataFileName
   )
+import System.Glib.UTFString
+  (
+    GlibString
+  )
+import System.Posix.FilePath
+  (
+    takeFileName
+  )
+
+
+
+
 
 
 
@@ -108,78 +127,60 @@ showConfirmationDialog str = do
     _           -> return False
 
 
--- |Asks the user which directory copy mode he wants via dialog popup
--- and returns 'DirCopyMode'. Default is always Strict, so this allows
--- switching to Merge/Replace/Rename.
-showCopyModeDialog :: IO (Maybe CopyMode)
-showCopyModeDialog = do
+fileCollisionDialog :: ByteString -> IO (Maybe FCollisonMode)
+fileCollisionDialog t = do
   chooserDialog <- messageDialogNew Nothing
                                     [DialogDestroyWithParent]
                                     MessageQuestion
                                     ButtonsNone
-                                    "Target exists, how to proceed?"
-  _ <- dialogAddButton chooserDialog "Cancel"  (ResponseUser 0)
-  _ <- dialogAddButton chooserDialog "Merge"   (ResponseUser 1)
-  _ <- dialogAddButton chooserDialog "Replace" (ResponseUser 2)
-  _ <- dialogAddButton chooserDialog "Rename"  (ResponseUser 3)
+                                    (fromString "Target \"" `BS.append`
+                                     t `BS.append`
+                                     fromString "\" exists, how to proceed?")
+  _ <- dialogAddButton chooserDialog "Cancel"        (ResponseUser 0)
+  _ <- dialogAddButton chooserDialog "Overwrite"     (ResponseUser 1)
+  _ <- dialogAddButton chooserDialog "Overwrite all" (ResponseUser 2)
+  _ <- dialogAddButton chooserDialog "Skip"          (ResponseUser 3)
+  _ <- dialogAddButton chooserDialog "Rename"        (ResponseUser 4)
   rID <- dialogRun chooserDialog
   widgetDestroy chooserDialog
   case rID of
     ResponseUser 0 -> return Nothing
-    ResponseUser 1 -> return (Just Merge)
-    ResponseUser 2 -> return (Just Replace)
-    ResponseUser 3 -> do
-      mfn   <- textInputDialog "Enter new name"
+    ResponseUser 1 -> return (Just Overwrite)
+    ResponseUser 2 -> return (Just OverwriteAll)
+    ResponseUser 3 -> return (Just Skip)
+    ResponseUser 4 -> do
+      mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
         pfn <- P.parseFn (P.userStringToFP fn)
         return $ Rename pfn
     _              -> throw  UnknownDialogButton
 
 
--- |Stipped version of `showCopyModeDialog` that only allows cancelling
--- or Renaming.
-showRenameDialog :: IO (Maybe CopyMode)
-showRenameDialog = do
+renameDialog :: ByteString -> IO (Maybe FCollisonMode)
+renameDialog t = do
   chooserDialog <- messageDialogNew Nothing
                                     [DialogDestroyWithParent]
                                     MessageQuestion
                                     ButtonsNone
-                                    "Target exists, how to proceed?"
-  _ <- dialogAddButton chooserDialog "Cancel"  (ResponseUser 0)
-  _ <- dialogAddButton chooserDialog "Rename"  (ResponseUser 1)
+                                    (fromString "Target \"" `BS.append`
+                                     t `BS.append`
+                                     fromString "\" exists, how to proceed?")
+  _ <- dialogAddButton chooserDialog "Cancel"        (ResponseUser 0)
+  _ <- dialogAddButton chooserDialog "Skip"          (ResponseUser 1)
+  _ <- dialogAddButton chooserDialog "Rename"        (ResponseUser 2)
   rID <- dialogRun chooserDialog
   widgetDestroy chooserDialog
   case rID of
     ResponseUser 0 -> return Nothing
-    ResponseUser 1 -> do
-      mfn   <- textInputDialog "Enter new name"
+    ResponseUser 1 -> return (Just Skip)
+    ResponseUser 2 -> do
+      mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
         pfn <- P.parseFn (P.userStringToFP fn)
         return $ Rename pfn
     _              -> throw  UnknownDialogButton
 
 
--- |Attempts to run the given function with the `Strict` copy mode.
--- If that raises a `FileDoesExist` or `DirDoesExist`, then it prompts
--- the user for action via `showCopyModeDialog` and then carries out
--- the given function again.
-withCopyModeDialog :: (CopyMode -> IO ()) -> IO ()
-withCopyModeDialog fa =
-  catch (fa Strict) $ \e ->
-    case e of
-      FileDoesExist _ -> doIt showCopyModeDialog
-      DirDoesExist  _ -> doIt showCopyModeDialog
-      SameFile _ _    -> doIt showRenameDialog
-      e'              -> throw e'
-  where
-    doIt getCm = do
-      mcm <- getCm
-      case mcm of
-        (Just Strict) -> return () -- don't try again
-        (Just cm)     -> fa cm
-        Nothing       -> return ()
-
-
 -- |Shows the about dialog from the help menu.
 showAboutDialog :: IO ()
 showAboutDialog = do
@@ -227,14 +228,18 @@ withErrorDialog io =
 
 -- |Asks the user which directory copy mode he wants via dialog popup
 -- and returns 'DirCopyMode'.
-textInputDialog :: String -> IO (Maybe String)
-textInputDialog title = do
+textInputDialog :: GlibString string
+                => string   -- ^ window title
+                -> string   -- ^ initial text in input widget
+                -> IO (Maybe String)
+textInputDialog title inittext = do
   chooserDialog <- messageDialogNew Nothing
                                     [DialogDestroyWithParent]
                                     MessageQuestion
                                     ButtonsNone
                                     title
   entry <- entryNew
+  entrySetText entry inittext
   cbox <- dialogGetActionArea chooserDialog
   _ <- dialogAddButton chooserDialog "Ok"     (ResponseUser 0)
   _ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 1)

src/HSFM/GUI/Gtk/MyGUI.hs

@@ -27,7 +27,7 @@ import Control.Concurrent.STM
     newTVarIO
   )
 import Graphics.UI.Gtk
-import HSFM.FileSystem.FileOperations
+import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Gtk.Data
 import Paths_hsfm
   (

src/HSFM/GUI/Gtk/MyView.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# OPTIONS_HADDOCK ignore-exports #-}
 
 
 module HSFM.GUI.Gtk.MyView where
@@ -70,7 +69,7 @@ import Paths_hsfm
     getDataFileName
   )
 import Prelude hiding(readFile)
-import System.INotify.ByteString
+import System.INotify
   (
     addWatch
   , initINotify
@@ -315,7 +314,9 @@ refreshView' :: MyGUI
              -> MyView
              -> Item
              -> IO ()
-refreshView' mygui myview item@(DirOrSym _) = do
+refreshView' mygui myview SymLink { sdest = d@Dir{} } =
+  refreshView' mygui myview d
+refreshView' mygui myview item@Dir{} = do
   newRawModel  <- fileListStore item myview
   writeTVarIO (rawModel myview) newRawModel
 

src/HSFM/Settings/Bookmarks.hs

@@ -1,139 +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 #-}
-{-# OPTIONS_HADDOCK ignore-exports #-}
-
-module HSFM.Settings.Bookmarks where
-
-
-import Control.Monad
-  (
-    void
-  )
-import Data.Attoparsec.ByteString
-import qualified Data.ByteString as BS
-import Data.ByteString
-  (
-    ByteString
-  )
-import Data.Maybe
-  (
-    catMaybes
-  , fromJust
-  )
-import Data.Word8
-  (
-    _nul
-  )
-import qualified HPath as P
-import HPath
-  (
-    Abs
-  , Fn
-  , Path
-  )
-import HSFM.FileSystem.FileOperations
-import HSFM.FileSystem.FileType
-import Prelude hiding (readFile, writeFile)
-import System.Posix.Env.ByteString
-  (
-    getEnv
-  )
-
-
-
--- |A bookmark. `bkName` is principally a description of the bookmark
--- but must satisfy the constraints of a filename.
-data Bookmark = MkBookmark {
-    bkName :: Path Fn
-  , bkPath :: Path Abs
-} deriving (Show)
-
-
--- |Parses bookmarks from a ByteString that has pairs of
--- name and path. Name and path are separated by one null character
--- and the pairs itself are separated by two null characters from
--- each other.
-bkParser :: Parser [Bookmark]
-bkParser =
-  fmap catMaybes $ many' (fmap toBm $ bookmark <* word8 _nul <* word8 _nul)
-  where
-    toBm :: (ByteString, ByteString) -> Maybe Bookmark
-    toBm (name, path) = MkBookmark <$> P.parseFn name
-                                   <*> P.parseAbs path
-    bookmark :: Parser (ByteString, ByteString)
-    bookmark =
-      (\x y -> (BS.pack x, BS.pack y))
-      <$> many1' char
-      <* (word8 _nul)
-      <*> many1' char
-    char = satisfy (`notElem` [_nul])
-
-
--- |Writes bookmarks to a given file.
-writeBookmarks :: [Bookmark] -> IO ()
-writeBookmarks [] = return ()
-writeBookmarks bs = do
-  bf  <- bookmarksFile
-  bfd <- bookmarksDir
-  mkdirP bfd
-  readFile getFileInfo bfd >>= (\x -> createFile x bookmarksFileName)
-  let str = foldr1 (\x y -> x `BS.append` BS.pack [_nul, _nul]
-                              `BS.append`
-                            y `BS.append` BS.pack [_nul, _nul])
-            (fmap toByteString bs)
-  file <- readFile getFileInfo bf
-  void $ writeFile file str
-    where
-    toByteString :: Bookmark -> ByteString
-    toByteString b =             (P.fromRel $ bkName b)
-                     `BS.append` BS.singleton _nul
-                     `BS.append` (P.fromAbs $ bkPath b)
-
-
--- |Reads bookmarks from a given file.
-readBookmarks :: IO [Bookmark]
-readBookmarks = do
-  p    <- bookmarksFile
-  file <- readFile getFileInfo p
-  c    <- readFileContents file
-  case parseOnly bkParser c of
-    Left _  -> return []
-    Right x -> return x
-
-
-bookmarksDir :: IO (Path Abs)
-bookmarksDir = do
-  mhomedir  <- getEnv "HOME"
-  case mhomedir of
-    Nothing   -> ioError (userError "No valid homedir?!")
-    Just home -> do
-      phome  <- P.parseAbs home
-      reldir <- P.parseRel ".config/hsfm"
-      return $ phome P.</> reldir
-
-
-bookmarksFile :: IO (Path Abs)
-bookmarksFile = do
-  path <- bookmarksDir
-  return $ path P.</> bookmarksFileName
-
-
-bookmarksFileName :: Path Fn
-bookmarksFileName = fromJust $ P.parseFn "bookmarks"

test/FileSystem/FileOperations/CopyDirRecursiveOverwriteSpec.hs

@@ -0,0 +1,110 @@
+{-# 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

test/FileSystem/FileOperations/CopyDirRecursiveSpec.hs

@@ -0,0 +1,112 @@
+{-# 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

test/FileSystem/FileOperations/CopyFileOverwriteSpec.hs

@@ -0,0 +1,109 @@
+{-# 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

test/FileSystem/FileOperations/CopyFileSpec.hs

@@ -0,0 +1,105 @@
+{-# 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

test/FileSystem/FileOperations/CreateDirSpec.hs

@@ -0,0 +1,54 @@
+{-# 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)
+

test/FileSystem/FileOperations/CreateRegularFileSpec.hs

@@ -0,0 +1,54 @@
+{-# 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)
+

test/FileSystem/FileOperations/DeleteDirRecursiveSpec.hs

@@ -0,0 +1,97 @@
+{-# 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)
+
+

test/FileSystem/FileOperations/DeleteDirSpec.hs

@@ -0,0 +1,94 @@
+{-# 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")
+
+
+

test/FileSystem/FileOperations/DeleteFileSpec.hs

@@ -0,0 +1,69 @@
+{-# 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)
+

test/FileSystem/FileOperations/GetDirsFilesSpec.hs

@@ -0,0 +1,88 @@
+{-# 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)
+
+
+
+

test/FileSystem/FileOperations/GetFileTypeSpec.hs

@@ -0,0 +1,70 @@
+{-# 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)
+

test/FileSystem/FileOperations/MoveFileOverwriteSpec.hs

@@ -0,0 +1,93 @@
+{-# 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
+

test/FileSystem/FileOperations/MoveFileSpec.hs

@@ -0,0 +1,95 @@
+{-# 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
+

test/FileSystem/FileOperations/RecreateSymlinkSpec.hs

@@ -0,0 +1,95 @@
+{-# 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
+

test/FileSystem/FileOperations/RenameFileSpec.hs

@@ -0,0 +1,95 @@
+{-# 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
+

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/copyDirRecursiveSpec/inputDir/bar/inputFile3

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

test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir/foo/inputFile1

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

test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir/inputFile2

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

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

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

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

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

test/FileSystem/FileOperations/copyDirRecursiveSpec/noPerms/inputDir/inputFile2

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

test/FileSystem/FileOperations/copyDirRecursiveSpec/wrongInputSymL

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

test/FileSystem/FileOperations/copyFileOverwriteSpec/alreadyExists

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

test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile

@@ -0,0 +1,4 @@
+abc
+def
+
+dsadasdsa

test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFileSymL

@@ -0,0 +1 @@
+inputFile

test/FileSystem/FileOperations/copyFileSpec/inputFile

@@ -0,0 +1,2 @@
+abc
+def

test/FileSystem/FileOperations/copyFileSpec/inputFileSymL

@@ -0,0 +1 @@
+inputFile

test/FileSystem/FileOperations/deleteDirRecursiveSpec/dirSym

@@ -0,0 +1 @@
+dir

test/FileSystem/FileOperations/deleteDirSpec/dirSym

@@ -0,0 +1 @@
+dir

test/FileSystem/FileOperations/deleteFileSpec/syml

@@ -0,0 +1 @@
+foo

test/FileSystem/FileOperations/getDirsFilesSpec/dirsym

@@ -0,0 +1 @@
+dir

test/FileSystem/FileOperations/getDirsFilesSpec/syml

@@ -0,0 +1 @@
+Lala