Blub

.gitmodules

@@ -1,6 +1,9 @@
 [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,6 +23,7 @@ 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,18 +27,21 @@ library
                        HSFM.FileSystem.Errors
                        HSFM.FileSystem.FileOperations
                        HSFM.FileSystem.FileType
-                       HSFM.FileSystem.UtilTypes
+                       HSFM.Settings.Bookmarks
                        HSFM.Utils.IO
                        HSFM.Utils.MyPrelude
 
   build-depends:
+                       attoparsec,
                        base >= 4.7,
                        bytestring,
                        containers,
                        data-default,
+                       errors,
                        filepath >= 1.3.0.0,
-                       hinotify-bytestring,
+                       hinotify,
                        hpath,
+                       monad-loops,
                        mtl >= 2.2,
                        old-locale >= 1,
                        posix-paths,
@@ -49,7 +52,8 @@ library
                        time >= 1.4.2,
                        unix,
                        unix-bytestring,
-                       utf8-string
+                       utf8-string,
+                       word8
   hs-source-dirs:      src
   default-language:    Haskell2010
   Default-Extensions:  RecordWildCards
@@ -67,7 +71,6 @@ 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
@@ -86,7 +89,7 @@ executable hsfm-gtk
                        filepath >= 1.3.0.0,
                        glib >= 0.13,
                        gtk3 >= 0.14.1,
-                       hinotify-bytestring,
+                       hinotify,
                        hpath,
                        hsfm,
                        mtl >= 2.2,
@@ -113,38 +116,3 @@ 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,7 +17,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
 {-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 -- |Provides error handling.
@@ -27,27 +26,19 @@ module HSFM.FileSystem.Errors where
 import Control.Exception
 import Control.Monad
   (
-    forM
+    when
-  , when
+  , forM
   )
 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
     (
@@ -58,15 +49,10 @@ import HSFM.Utils.IO
 import System.IO.Error
   (
     catchIOError
-  , ioeGetErrorType
   )
 
 import qualified System.Posix.Directory.ByteString as PFD
-import System.Posix.Files.ByteString
+import System.Posix.FilePath
-  (
-    fileAccess
-  , getFileStatus
-  )
 import qualified System.Posix.Files.ByteString as PF
 
 
@@ -86,7 +72,7 @@ data FmIOException = FileDoesNotExist ByteString
                    | Can'tOpenDirectory ByteString
                    | CopyFailed String
                    | MoveFailed String
-  deriving (Typeable, Eq, Data)
+  deriving (Typeable)
 
 
 instance Show FmIOException where
@@ -120,26 +106,6 @@ 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 ]--
@@ -160,38 +126,28 @@ throwDirDoesExist fp =
 
 throwFileDoesNotExist :: Path Abs -> IO ()
 throwFileDoesNotExist fp =
-  unlessM (doesFileExist fp) (throw . FileDoesNotExist
+  whenM (doesFileExist fp) (throw . FileDoesExist
-                                    . P.fromAbs $ fp)
+                                  . P.fromAbs $ fp)
 
 
 throwDirDoesNotExist :: Path Abs -> IO ()
 throwDirDoesNotExist fp =
-  unlessM (doesDirectoryExist fp) (throw . DirDoesNotExist
+  whenM (doesDirectoryExist fp) (throw . DirDoesExist
-                                         . P.fromAbs $ fp)
+                                       . P.fromAbs $ fp)
 
 
--- |Uses `isSameFile` and throws `SameFile` if it returns True.
+throwSameFile :: Path Abs -- ^ will be canonicalized
-throwSameFile :: Path Abs
+              -> Path Abs -- ^ will be canonicalized
-              -> Path Abs
               -> IO ()
-throwSameFile fp1 fp2 =
+throwSameFile fp1 fp2 = do
-  whenM (sameFile fp1 fp2)
+  fp1' <- fmap P.fromAbs $ P.canonicalizePath fp1
-        (throw $ SameFile (P.fromAbs fp1) (P.fromAbs fp2))
+  -- TODO: clean this up... if canonicalizing fp2 fails we try to
-
+  --       canonicalize `dirname fp2`
-
+  fp2' <- catchIOError (fmap P.fromAbs $ P.canonicalizePath fp2)
--- |Check if the files are the same by examining device and file id.
+                       (\_ -> fmap P.fromAbs
--- This follows symbolic links.
+                       $ (\x -> maybe x (\y -> x P.</> y) $ P.basename fp2)
-sameFile :: Path Abs -> Path Abs -> IO Bool
+                                <$> (P.canonicalizePath $ P.dirname fp2))
-sameFile fp1 fp2 =
+  when (equalFilePath fp1' fp2') (throw $ 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
@@ -203,45 +159,41 @@ 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.getFileStatus (P.fromAbs source)
+              $ PF.getSymbolicLinkStatus (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.
+-- |Checks if the given file exists and is not a directory. This follows
--- Does not follow symlinks.
+-- symlinks, but will return True if the symlink is broken.
 doesFileExist :: Path Abs -> IO Bool
 doesFileExist fp =
   handleIOError (\_ -> return False) $ do
-    fs  <- PF.getSymbolicLinkStatus (P.fromAbs fp)
+    fp' <- fmap P.fromAbs $ P.canonicalizePath fp
+    fs  <- PF.getFileStatus fp'
     return $ not . PF.isDirectory $ fs
 
 
--- |Checks if the given file exists and is a directory.
+-- |Checks if the given file exists and is a directory. This follows
--- Does not follow symlinks.
+-- symlinks, but will return False if the symlink is broken.
 doesDirectoryExist :: Path Abs -> IO Bool
 doesDirectoryExist fp =
   handleIOError (\_ -> return False) $ do
-    fs  <- PF.getSymbolicLinkStatus (P.fromAbs fp)
+    fp' <- fmap P.fromAbs $ P.canonicalizePath fp
+    fs  <- PF.getFileStatus 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.
+-- opened. This invokes `openDirStream`.
 canOpenDirectory :: Path Abs -> IO Bool
 canOpenDirectory fp =
   handleIOError (\_ -> return False) $ do
@@ -297,43 +249,3 @@ 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,44 +18,39 @@ 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
--- |This module provides a data type for representing directories/files
+-- and related operations on it, mostly internal stuff.
--- 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.
 --
--- However, it's not meant to be used to interact with low-level
+-- It doesn't allow to represent the whole filesystem, since that's only
--- functions that copy files etc, since there's no guarantee that
+-- possible through IO laziness, which introduces too much internal state.
--- 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
@@ -69,7 +64,8 @@ import System.Posix.FilePath
   )
 import System.Posix.Directory.Traversals
   (
-    realpath
+    getDirectoryContents
+  , realpath
   )
 import qualified System.Posix.Files.ByteString as PF
 import System.Posix.Types
@@ -97,7 +93,8 @@ 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.
+-- think of. We catch any IO errors in the Failed constructor. an Exception
+-- can be converted to a String with 'show'.
 data File a =
     Failed {
     path :: !(Path Abs)
@@ -464,7 +461,19 @@ 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

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

@@ -1,102 +0,0 @@
-{--
-HSFM, a filemanager written in Haskell.
-Copyright (C) 2016 Julian Ospald
-
-This program is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public License
-version 2 as published by the Free Software Foundation.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
---}
-
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE 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 HSFM.FileSystem.UtilTypes
+import System.INotify.ByteString
-import System.INotify
   (
     INotify
   )

src/HSFM/GUI/Gtk/Dialogs.hs

@@ -23,7 +23,8 @@ module HSFM.GUI.Gtk.Dialogs where
 
 import Control.Exception
   (
-    displayException
+    catch
+  , displayException
   , throw
   , IOException
   , catches
@@ -35,15 +36,7 @@ import Control.Monad
   , when
   , void
   )
-import Data.ByteString
-  (
-    ByteString
-  )
 import qualified Data.ByteString as BS
-import Data.ByteString.UTF8
-  (
-    fromString
-  )
 import Data.Version
   (
     showVersion
@@ -69,8 +62,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
@@ -78,18 +71,6 @@ import Paths_hsfm
   (
     getDataFileName
   )
-import System.Glib.UTFString
-  (
-    GlibString
-  )
-import System.Posix.FilePath
-  (
-    takeFileName
-  )
-
-
-
-
 
 
 
@@ -127,60 +108,78 @@ showConfirmationDialog str = do
     _           -> return False
 
 
-fileCollisionDialog :: ByteString -> IO (Maybe FCollisonMode)
+-- |Asks the user which directory copy mode he wants via dialog popup
-fileCollisionDialog t = do
+-- and returns 'DirCopyMode'. Default is always Strict, so this allows
+-- switching to Merge/Replace/Rename.
+showCopyModeDialog :: IO (Maybe CopyMode)
+showCopyModeDialog = do
   chooserDialog <- messageDialogNew Nothing
                                     [DialogDestroyWithParent]
                                     MessageQuestion
                                     ButtonsNone
-                                    (fromString "Target \"" `BS.append`
+                                    "Target exists, how to proceed?"
-                                     t `BS.append`
+  _ <- dialogAddButton chooserDialog "Cancel"  (ResponseUser 0)
-                                     fromString "\" exists, how to proceed?")
+  _ <- dialogAddButton chooserDialog "Merge"   (ResponseUser 1)
-  _ <- dialogAddButton chooserDialog "Cancel"        (ResponseUser 0)
+  _ <- dialogAddButton chooserDialog "Replace" (ResponseUser 2)
-  _ <- dialogAddButton chooserDialog "Overwrite"     (ResponseUser 1)
+  _ <- dialogAddButton chooserDialog "Rename"  (ResponseUser 3)
-  _ <- 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 Overwrite)
+    ResponseUser 1 -> return (Just Merge)
-    ResponseUser 2 -> return (Just OverwriteAll)
+    ResponseUser 2 -> return (Just Replace)
-    ResponseUser 3 -> return (Just Skip)
+    ResponseUser 3 -> do
-    ResponseUser 4 -> do
+      mfn   <- textInputDialog "Enter new name"
-      mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
         pfn <- P.parseFn (P.userStringToFP fn)
         return $ Rename pfn
     _              -> throw  UnknownDialogButton
 
 
-renameDialog :: ByteString -> IO (Maybe FCollisonMode)
+-- |Stipped version of `showCopyModeDialog` that only allows cancelling
-renameDialog t = do
+-- or Renaming.
+showRenameDialog :: IO (Maybe CopyMode)
+showRenameDialog = do
   chooserDialog <- messageDialogNew Nothing
                                     [DialogDestroyWithParent]
                                     MessageQuestion
                                     ButtonsNone
-                                    (fromString "Target \"" `BS.append`
+                                    "Target exists, how to proceed?"
-                                     t `BS.append`
+  _ <- dialogAddButton chooserDialog "Cancel"  (ResponseUser 0)
-                                     fromString "\" exists, how to proceed?")
+  _ <- dialogAddButton chooserDialog "Rename"  (ResponseUser 1)
-  _ <- 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 -> return (Just Skip)
+    ResponseUser 1 -> do
-    ResponseUser 2 -> do
+      mfn   <- textInputDialog "Enter new name"
-      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
@@ -228,18 +227,14 @@ withErrorDialog io =
 
 -- |Asks the user which directory copy mode he wants via dialog popup
 -- and returns 'DirCopyMode'.
-textInputDialog :: GlibString string
+textInputDialog :: String -> IO (Maybe String)
-                => string   -- ^ window title
+textInputDialog title = do
-                -> 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.UtilTypes
+import HSFM.FileSystem.FileOperations
 import HSFM.GUI.Gtk.Data
 import Paths_hsfm
   (

src/HSFM/GUI/Gtk/MyView.hs

@@ -16,6 +16,7 @@ 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
@@ -69,7 +70,7 @@ import Paths_hsfm
     getDataFileName
   )
 import Prelude hiding(readFile)
-import System.INotify
+import System.INotify.ByteString
   (
     addWatch
   , initINotify
@@ -314,9 +315,7 @@ refreshView' :: MyGUI
              -> MyView
              -> Item
              -> IO ()
-refreshView' mygui myview SymLink { sdest = d@Dir{} } =
+refreshView' mygui myview item@(DirOrSym _) = do
-  refreshView' mygui myview d
-refreshView' mygui myview item@Dir{} = do
   newRawModel  <- fileListStore item myview
   writeTVarIO (rawModel myview) newRawModel
 

src/HSFM/Settings/Bookmarks.hs

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

@@ -1,110 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec where
-
-
-import Test.Hspec
-import HSFM.FileSystem.Errors
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import System.Exit
-import System.Process
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.copyDirRecursiveOverwrite" $ do
-
-    -- successes --
-    it "copyDirRecursiveOverwrite, all fine" $ do
-      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
-                                 (specDir `ba` "outputDir")
-      removeDirIfExists $ specDir `ba` "outputDir"
-
-    it "copyDirRecursiveOverwrite, all fine and compare" $ do
-      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
-                                 (specDir `ba` "outputDir")
-      (system $ "diff -r --no-dereference "
-                          ++ specDir' ++ "inputDir" ++ " "
-                          ++ specDir' ++ "outputDir")
-        `shouldReturn` ExitSuccess
-      removeDirIfExists $ specDir `ba` "outputDir"
-
-    it "copyDirRecursiveOverwrite, destination dir already exists" $
-      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
-                                 (specDir `ba` "alreadyExistsD")
-
-    -- posix failures --
-    it "copyDirRecursiveOverwrite, source directory does not exist" $
-      copyDirRecursiveOverwrite' (specDir `ba` "doesNotExist")
-                                 (specDir `ba` "outputDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "copyDirRecursiveOverwrite, no write permission on output dir" $
-      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
-                                 (specDir `ba` "noWritePerm/foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyDirRecursiveOverwrite, cannot open output dir" $
-      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
-                                 (specDir `ba` "noPerms/foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyDirRecursiveOverwrite, cannot open source dir" $
-      copyDirRecursiveOverwrite' (specDir `ba` "noPerms/inputDir")
-                                 (specDir `ba` "foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyDirRecursiveOverwrite, destination already exists and is a file" $
-      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
-                                 (specDir `ba` "alreadyExists")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "copyDirRecursiveOverwrite, wrong input (regular file)" $
-      copyDirRecursiveOverwrite' (specDir `ba` "wrongInput")
-                                 (specDir `ba` "outputDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $
-      copyDirRecursiveOverwrite' (specDir `ba` "wrongInputSymL")
-                                 (specDir `ba` "outputDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InvalidArgument)
-
-    -- custom failures
-    it "copyDirRecursiveOverwrite, destination in source" $
-      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
-                                 (specDir `ba` "inputDir/foo")
-        `shouldThrow`
-        isDestinationInSource
-
-    it "copyDirRecursiveOverwrite, destination and source same directory" $
-      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
-                                 (specDir `ba` "inputDir")
-        `shouldThrow`
-        isSameFile

test/FileSystem/FileOperations/CopyDirRecursiveSpec.hs

@@ -1,112 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.CopyDirRecursiveSpec where
-
-
-import Test.Hspec
-import HSFM.FileSystem.Errors
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import System.Exit
-import System.Process
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/copyDirRecursiveSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.copyDirRecursive" $ do
-
-    -- successes --
-    it "copyDirRecursive, all fine" $ do
-      copyDirRecursive' (specDir `ba` "inputDir")
-                        (specDir `ba` "outputDir")
-      removeDirIfExists (specDir `ba` "outputDir")
-
-    it "copyDirRecursive, all fine and compare" $ do
-      copyDirRecursive' (specDir `ba` "inputDir")
-                        (specDir `ba` "outputDir")
-      (system $ "diff -r --no-dereference "
-                          ++ specDir' ++ "inputDir" ++ " "
-                          ++ specDir' ++ "outputDir")
-        `shouldReturn` ExitSuccess
-      removeDirIfExists (specDir `ba` "outputDir")
-
-    -- posix failures --
-    it "copyDirRecursive, source directory does not exist" $
-      copyDirRecursive' (specDir `ba` "doesNotExist")
-                        (specDir `ba` "outputDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "copyDirRecursive, no write permission on output dir" $
-      copyDirRecursive' (specDir `ba` "inputDir")
-                        (specDir `ba` "noWritePerm/foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyDirRecursive, cannot open output dir" $
-      copyDirRecursive' (specDir `ba` "inputDir")
-                        (specDir `ba` "noPerms/foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyDirRecursive, cannot open source dir" $
-      copyDirRecursive' (specDir `ba` "noPerms/inputDir")
-                        (specDir `ba` "foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyDirRecursive, destination dir already exists" $
-      copyDirRecursive' (specDir `ba` "inputDir")
-                        (specDir `ba` "alreadyExistsD")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-
-    it "copyDirRecursive, destination already exists and is a file" $
-      copyDirRecursive' (specDir `ba` "inputDir")
-                        (specDir `ba` "alreadyExists")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-
-    it "copyDirRecursive, wrong input (regular file)" $
-      copyDirRecursive' (specDir `ba` "wrongInput")
-                        (specDir `ba` "outputDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "copyDirRecursive, wrong input (symlink to directory)" $
-      copyDirRecursive' (specDir `ba` "wrongInputSymL")
-                        (specDir `ba` "outputDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InvalidArgument)
-
-    -- custom failures
-    it "copyDirRecursive, destination in source" $
-      copyDirRecursive' (specDir `ba` "inputDir")
-                        (specDir `ba` "inputDir/foo")
-        `shouldThrow`
-        isDestinationInSource
-
-    it "copyDirRecursive, destination and source same directory" $
-      copyDirRecursive' (specDir `ba` "inputDir")
-                        (specDir `ba` "inputDir")
-        `shouldThrow`
-        isSameFile

test/FileSystem/FileOperations/CopyFileOverwriteSpec.hs

@@ -1,109 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.CopyFileOverwriteSpec where
-
-
-import Test.Hspec
-import HSFM.FileSystem.Errors
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import System.Exit
-import System.Process
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/copyFileOverwriteSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.copyFileOverwrite" $ do
-
-    -- successes --
-    it "copyFileOverwrite, everything clear" $ do
-      copyFileOverwrite' (specDir `ba` "inputFile")
-                (specDir `ba` "outputFile")
-      removeFileIfExists (specDir `ba` "outputFile")
-
-    it "copyFileOverwrite, output file already exists, all clear" $ do
-      copyFile' (specDir `ba` "alreadyExists") (specDir `ba` "alreadyExists.bak")
-      copyFileOverwrite' (specDir `ba` "inputFile")
-                         (specDir `ba` "alreadyExists")
-      (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
-                          ++ specDir' ++ "alreadyExists")
-        `shouldReturn` ExitSuccess
-      removeFileIfExists (specDir `ba` "alreadyExists")
-      copyFile' (specDir `ba` "alreadyExists.bak") (specDir `ba` "alreadyExists")
-      removeFileIfExists (specDir `ba` "alreadyExists.bak")
-
-    it "copyFileOverwrite, and compare" $ do
-      copyFileOverwrite' (specDir `ba` "inputFile")
-                (specDir `ba` "outputFile")
-      (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
-                          ++ specDir' ++ "outputFile")
-        `shouldReturn` ExitSuccess
-      removeFileIfExists (specDir `ba` "outputFile")
-
-    -- posix failures --
-    it "copyFileOverwrite, input file does not exist" $
-      copyFileOverwrite' (specDir `ba` "noSuchFile")
-                (specDir `ba` "outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "copyFileOverwrite, no permission to write to output directory" $
-      copyFileOverwrite' (specDir `ba` "inputFile")
-                (specDir `ba` "outputDirNoWrite/outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyFileOverwrite, cannot open output directory" $
-      copyFileOverwrite' (specDir `ba` "inputFile")
-                (specDir `ba` "noPerms/outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyFileOverwrite, cannot open source directory" $
-      copyFileOverwrite' (specDir `ba` "noPerms/inputFile")
-                (specDir `ba` "outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyFileOverwrite, wrong input type (symlink)" $
-      copyFileOverwrite' (specDir `ba` "inputFileSymL")
-                (specDir `ba` "outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InvalidArgument)
-
-    it "copyFileOverwrite, wrong input type (directory)" $
-      copyFileOverwrite' (specDir `ba` "wrongInput")
-                (specDir `ba` "outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "copyFileOverwrite, output file already exists and is a dir" $
-      copyFileOverwrite' (specDir `ba` "inputFile")
-                (specDir `ba` "alreadyExistsD")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    -- custom failures --
-    it "copyFileOverwrite, output and input are same file" $
-      copyFileOverwrite' (specDir `ba` "inputFile")
-                (specDir `ba` "inputFile")
-        `shouldThrow` isSameFile

test/FileSystem/FileOperations/CopyFileSpec.hs

@@ -1,105 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.CopyFileSpec where
-
-
-import Test.Hspec
-import HSFM.FileSystem.Errors
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import System.Exit
-import System.Process
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/copyFileSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.copyFile" $ do
-
-    -- successes --
-    it "copyFile, everything clear" $ do
-      copyFile' (specDir `ba` "inputFile")
-                (specDir `ba` "outputFile")
-      removeFileIfExists (specDir `ba` "outputFile")
-
-    it "copyFile, and compare" $ do
-      copyFile' (specDir `ba` "inputFile")
-                (specDir `ba` "outputFile")
-      (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
-                          ++ specDir' ++ "outputFile")
-        `shouldReturn` ExitSuccess
-      removeFileIfExists (specDir `ba` "outputFile")
-
-    -- posix failures --
-    it "copyFile, input file does not exist" $
-      copyFile' (specDir `ba` "noSuchFile")
-                (specDir `ba` "outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "copyFile, no permission to write to output directory" $
-      copyFile' (specDir `ba` "inputFile")
-                (specDir `ba` "outputDirNoWrite/outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyFile, cannot open output directory" $
-      copyFile' (specDir `ba` "inputFile")
-                (specDir `ba` "noPerms/outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyFile, cannot open source directory" $
-      copyFile' (specDir `ba` "noPerms/inputFile")
-                (specDir `ba` "outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "copyFile, wrong input type (symlink)" $
-      copyFile' (specDir `ba` "inputFileSymL")
-                (specDir `ba` "outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InvalidArgument)
-
-    it "copyFile, wrong input type (directory)" $
-      copyFile' (specDir `ba` "wrongInput")
-                (specDir `ba` "outputFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "copyFile, output file already exists" $
-      copyFile' (specDir `ba` "inputFile")
-                (specDir `ba` "alreadyExists")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-
-    it "copyFile, output file already exists and is a dir" $
-      copyFile' (specDir `ba` "inputFile")
-                (specDir `ba` "alreadyExistsD")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-
-    -- custom failures --
-    it "copyFile, output and input are same file" $
-      copyFile' (specDir `ba` "inputFile")
-                (specDir `ba` "inputFile")
-        `shouldThrow`
-        isSameFile

test/FileSystem/FileOperations/CreateDirSpec.hs

@@ -1,54 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.CreateDirSpec where
-
-
-import Test.Hspec
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/createDirSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.createDir" $ do
-
-    -- successes --
-    it "createDir, all fine" $ do
-      createDir' (specDir `ba` "newDir")
-      removeDirIfExists (specDir `ba` "newDir")
-
-    -- posix failures --
-    it "createDir, can't write to output directory" $
-      createDir' (specDir `ba` "noWritePerms/newDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "createDir, can't open output directory" $
-      createDir' (specDir `ba` "noPerms/newDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "createDir, destination directory already exists" $
-      createDir' (specDir `ba` "alreadyExists")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-

test/FileSystem/FileOperations/CreateRegularFileSpec.hs

@@ -1,54 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.CreateRegularFileSpec where
-
-
-import Test.Hspec
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/createRegularFileSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.createRegularFile" $ do
-
-    -- successes --
-    it "createRegularFile, all fine" $ do
-      createRegularFile' (specDir `ba` "newDir")
-      removeFileIfExists (specDir `ba` "newDir")
-
-    -- posix failures --
-    it "createRegularFile, can't write to destination directory" $
-      createRegularFile' (specDir `ba` "noWritePerms/newDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "createRegularFile, can't write to destination directory" $
-      createRegularFile' (specDir `ba` "noPerms/newDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "createRegularFile, destination file already exists" $
-      createRegularFile' (specDir `ba` "alreadyExists")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-

test/FileSystem/FileOperations/DeleteDirRecursiveSpec.hs

@@ -1,97 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.DeleteDirRecursiveSpec where
-
-
-import Test.Hspec
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import System.Posix.Files.ByteString
-  (
-    getSymbolicLinkStatus
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/deleteDirRecursiveSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.deleteDirRecursive" $ do
-
-    -- successes --
-    it "deleteDirRecursive, empty directory, all fine" $ do
-      createDir' (specDir `ba` "testDir")
-      deleteDirRecursive' (specDir `ba` "testDir")
-      getSymbolicLinkStatus (specDir `ba` "testDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
-      createDir' (specDir `ba` "noPerms/testDir")
-      noPerms (specDir `ba` "noPerms/testDir")
-      deleteDirRecursive' (specDir `ba` "noPerms/testDir")
-
-    it "deleteDirRecursive, non-empty directory, all fine" $ do
-      createDir' (specDir `ba` "nonEmpty")
-      createDir' (specDir `ba` "nonEmpty/dir1")
-      createDir' (specDir `ba` "nonEmpty/dir2")
-      createDir' (specDir `ba` "nonEmpty/dir2/dir3")
-      createRegularFile' (specDir `ba` "nonEmpty/file1")
-      createRegularFile' (specDir `ba` "nonEmpty/dir1/file2")
-      deleteDirRecursive' (specDir `ba` "nonEmpty")
-      getSymbolicLinkStatus (specDir `ba` "nonEmpty")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    -- posix failures --
-    it "deleteDirRecursive, can't open parent directory" $ do
-      createDir' (specDir `ba` "noPerms/foo")
-      noPerms (specDir `ba` "noPerms")
-      (deleteDirRecursive' (specDir `ba` "noPerms/foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied))
-        >> normalDirPerms (specDir `ba` "noPerms")
-        >> deleteDir' (specDir `ba` "noPerms/foo")
-
-    it "deleteDirRecursive, can't write to parent directory" $ do
-      createDir' (specDir `ba` "noWritable/foo")
-      noWritableDirPerms (specDir `ba` "noWritable")
-      (deleteDirRecursive' (specDir `ba` "noWritable/foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied))
-      normalDirPerms (specDir `ba` "noWritable")
-      deleteDir' (specDir `ba` "noWritable/foo")
-
-    it "deleteDirRecursive, wrong file type (symlink to directory)" $
-      deleteDirRecursive' (specDir `ba` "dirSym")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "deleteDirRecursive, wrong file type (regular file)" $
-      deleteDirRecursive' (specDir `ba` "file")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "deleteDirRecursive, directory does not exist" $
-      deleteDirRecursive' (specDir `ba` "doesNotExist")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-

test/FileSystem/FileOperations/DeleteDirSpec.hs

@@ -1,94 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.DeleteDirSpec where
-
-
-import Test.Hspec
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import System.Posix.Files.ByteString
-  (
-    getSymbolicLinkStatus
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/deleteDirSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.deleteDir" $ do
-
-    -- successes --
-    it "deleteDir, empty directory, all fine" $ do
-      createDir' (specDir `ba` "testDir")
-      deleteDir' (specDir `ba` "testDir")
-      getSymbolicLinkStatus (specDir `ba` "testDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "deleteDir, directory with null permissions, all fine" $ do
-      createDir' (specDir `ba` "noPerms/testDir")
-      noPerms (specDir `ba` "noPerms/testDir")
-      deleteDir' (specDir `ba` "noPerms/testDir")
-      getSymbolicLinkStatus (specDir `ba` "testDir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    -- posix failures --
-    it "deleteDir, wrong file type (symlink to directory)" $
-      deleteDir' (specDir `ba` "dirSym")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "deleteDir, wrong file type (regular file)" $
-      deleteDir' (specDir `ba` "file")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "deleteDir, directory does not exist" $
-      deleteDir' (specDir `ba` "doesNotExist")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "deleteDir, directory not empty" $
-      deleteDir' (specDir `ba` "dir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == UnsatisfiedConstraints)
-
-    it "deleteDir, can't open parent directory" $ do
-      createDir' (specDir `ba` "noPerms/foo")
-      noPerms (specDir `ba` "noPerms")
-      (deleteDir' (specDir `ba` "noPerms/foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied))
-        >> normalDirPerms (specDir `ba` "noPerms")
-        >> deleteDir' (specDir `ba` "noPerms/foo")
-
-    it "deleteDir, can't write to parent directory, still fine" $ do
-      createDir' (specDir `ba` "noWritable/foo")
-      noWritableDirPerms (specDir `ba` "noWritable")
-      (deleteDir' (specDir `ba` "noWritable/foo")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied))
-      normalDirPerms (specDir `ba` "noWritable")
-      deleteDir' (specDir `ba` "noWritable/foo")
-
-
-

test/FileSystem/FileOperations/DeleteFileSpec.hs

@@ -1,69 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.DeleteFileSpec where
-
-
-import Test.Hspec
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import System.Posix.Files.ByteString
-  (
-    getSymbolicLinkStatus
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/deleteFileSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.deleteFile" $ do
-
-    -- successes --
-    it "deleteFile, regular file, all fine" $ do
-      createRegularFile' (specDir `ba` "testFile")
-      deleteFile' (specDir `ba` "testFile")
-      getSymbolicLinkStatus (specDir `ba` "testFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "deleteFile, symlink, all fine" $ do
-      recreateSymlink' (specDir `ba` "syml")
-                       (specDir `ba` "testFile")
-      deleteFile' (specDir `ba` "testFile")
-      getSymbolicLinkStatus (specDir `ba` "testFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    -- posix failures --
-    it "deleteFile, wrong file type (directory)" $
-      deleteFile' (specDir `ba` "dir")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "deleteFile, file does not exist" $
-      deleteFile' (specDir `ba` "doesNotExist")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "deleteFile, can't read directory" $
-      deleteFile' (specDir `ba` "noPerms/blah")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-

test/FileSystem/FileOperations/GetDirsFilesSpec.hs

@@ -1,88 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.GetDirsFilesSpec where
-
-
-import Data.List
-  (
-    sort
-  )
-import Data.Maybe
-  (
-    fromJust
-  )
-import qualified HPath as P
-import Test.Hspec
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import System.Posix.Env.ByteString
-  (
-    getEnv
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/getDirsFilesSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.getDirsFiles" $ do
-
-    -- successes --
-    it "getDirsFiles, all fine" $ do
-      pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
-      expectedFiles <- mapM P.parseRel [(specDir `ba ` ".hidden")
-                                       ,(specDir `ba ` "Lala")
-                                       ,(specDir `ba ` "dir")
-                                       ,(specDir `ba ` "dirsym")
-                                       ,(specDir `ba ` "file")
-                                       ,(specDir `ba ` "noPerms")
-                                       ,(specDir `ba ` "syml")]
-      (fmap sort $ getDirsFiles' specDir)
-        `shouldReturn` fmap (pwd P.</>) expectedFiles
-
-    -- posix failures --
-    it "getDirsFiles, nonexistent directory" $
-      getDirsFiles' (specDir `ba ` "nothingHere")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "getDirsFiles, wrong file type (file)" $
-      getDirsFiles' (specDir `ba ` "file")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InappropriateType)
-
-    it "getDirsFiles, wrong file type (symlink to file)" $
-      getDirsFiles' (specDir `ba ` "syml")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InvalidArgument)
-
-    it "getDirsFiles, wrong file type (symlink to dir)" $
-      getDirsFiles' (specDir `ba ` "dirsym")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InvalidArgument)
-
-    it "getDirsFiles, can't open directory" $
-      getDirsFiles' (specDir `ba ` "noPerms")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-
-
-

test/FileSystem/FileOperations/GetFileTypeSpec.hs

@@ -1,70 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.GetFileTypeSpec where
-
-
-import HSFM.FileSystem.FileOperations
-import Test.Hspec
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/getFileTypeSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.getFileType" $ do
-
-    -- successes --
-    it "getFileType, regular file" $
-      getFileType' (specDir `ba` "regularfile")
-        `shouldReturn` RegularFile
-
-    it "getFileType, directory" $
-      getFileType' (specDir `ba` "directory")
-        `shouldReturn` Directory
-
-    it "getFileType, directory with null permissions" $
-      getFileType' (specDir `ba` "noPerms")
-        `shouldReturn` Directory
-
-    it "getFileType, symlink to file" $
-      getFileType' (specDir `ba` "symlink")
-        `shouldReturn` SymbolicLink
-
-    it "getFileType, symlink to directory" $
-      getFileType' (specDir `ba` "symlinkD")
-        `shouldReturn` SymbolicLink
-
-    it "getFileType, broken symlink" $
-      getFileType' (specDir `ba` "brokenSymlink")
-        `shouldReturn` SymbolicLink
-
-    -- posix failures --
-    it "getFileType, file does not exist" $
-      getFileType' (specDir `ba` "nothingHere")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "getFileType, can't open directory" $
-      getFileType' (specDir `ba` "noPerms/forz")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-

test/FileSystem/FileOperations/MoveFileOverwriteSpec.hs

@@ -1,93 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.MoveFileOverwriteSpec where
-
-
-import Test.Hspec
-import HSFM.FileSystem.Errors
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/moveFileOverwriteSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.moveFileOverwrite" $ do
-
-    -- successes --
-    it "moveFileOverwrite, all fine" $
-      moveFileOverwrite' (specDir `ba` "myFile")
-                         (specDir `ba` "movedFile")
-
-    it "moveFileOverwrite, all fine" $
-      moveFileOverwrite' (specDir `ba` "myFile")
-                         (specDir `ba` "dir/movedFile")
-
-    it "moveFileOverwrite, all fine on symlink" $
-      moveFileOverwrite' (specDir `ba` "myFileL")
-                         (specDir `ba` "movedFile")
-
-    it "moveFileOverwrite, all fine on directory" $
-      moveFileOverwrite' (specDir `ba` "dir")
-                         (specDir `ba` "movedFile")
-
-    it "moveFileOverwrite, destination file already exists" $
-      moveFileOverwrite' (specDir `ba` "myFile")
-                         (specDir `ba` "alreadyExists")
-
-    -- posix failures --
-    it "moveFileOverwrite, source file does not exist" $
-      moveFileOverwrite' (specDir `ba` "fileDoesNotExist")
-                         (specDir `ba` "movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "moveFileOverwrite, can't write to destination directory" $
-      moveFileOverwrite' (specDir `ba` "myFile")
-                         (specDir `ba` "noWritePerm/movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "moveFileOverwrite, can't open destination directory" $
-      moveFileOverwrite' (specDir `ba` "myFile")
-                         (specDir `ba` "noPerms/movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "moveFileOverwrite, can't open source directory" $
-      moveFileOverwrite' (specDir `ba` "noPerms/myFile")
-                         (specDir `ba` "movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    -- custom failures --
-    it "moveFileOverwrite, move from file to dir" $
-      moveFileOverwrite' (specDir `ba` "myFile")
-                         (specDir `ba` "alreadyExistsD")
-        `shouldThrow`
-        isDirDoesExist
-
-    it "moveFileOverwrite, source and dest are same file" $
-      moveFileOverwrite' (specDir `ba` "myFile")
-                         (specDir `ba` "myFile")
-        `shouldThrow`
-        isSameFile
-

test/FileSystem/FileOperations/MoveFileSpec.hs

@@ -1,95 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.MoveFileSpec where
-
-
-import Test.Hspec
-import HSFM.FileSystem.Errors
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/moveFileSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.moveFile" $ do
-
-    -- successes --
-    it "moveFile, all fine" $
-      moveFile' (specDir `ba` "myFile")
-                (specDir `ba` "movedFile")
-
-    it "moveFile, all fine" $
-      moveFile' (specDir `ba` "myFile")
-                (specDir `ba` "dir/movedFile")
-
-    it "moveFile, all fine on symlink" $
-      moveFile' (specDir `ba` "myFileL")
-                (specDir `ba` "movedFile")
-
-    it "moveFile, all fine on directory" $
-      moveFile' (specDir `ba` "dir")
-                (specDir `ba` "movedFile")
-
-    -- posix failures --
-    it "moveFile, source file does not exist" $
-      moveFile' (specDir `ba` "fileDoesNotExist")
-                (specDir `ba` "movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "moveFile, can't write to destination directory" $
-      moveFile' (specDir `ba` "myFile")
-                (specDir `ba` "noWritePerm/movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "moveFile, can't open destination directory" $
-      moveFile' (specDir `ba` "myFile")
-                (specDir `ba` "noPerms/movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "moveFile, can't open source directory" $
-      moveFile' (specDir `ba` "noPerms/myFile")
-                (specDir `ba` "movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    -- custom failures --
-    it "moveFile, destination file already exists" $
-      moveFile' (specDir `ba` "myFile")
-                (specDir `ba` "alreadyExists")
-        `shouldThrow`
-        isFileDoesExist
-
-    it "moveFile, move from file to dir" $
-      moveFile' (specDir `ba` "myFile")
-                (specDir `ba` "alreadyExistsD")
-        `shouldThrow`
-        isDirDoesExist
-
-    it "moveFile, source and dest are same file" $
-      moveFile' (specDir `ba` "myFile")
-                (specDir `ba` "myFile")
-        `shouldThrow`
-        isSameFile
-

test/FileSystem/FileOperations/RecreateSymlinkSpec.hs

@@ -1,95 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.RecreateSymlinkSpec where
-
-
-import Test.Hspec
-import HSFM.FileSystem.Errors
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/recreateSymlinkSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.recreateSymlink" $ do
-
-    -- successes --
-    it "recreateSymLink, all fine" $ do
-      recreateSymlink' (specDir `ba` "myFileL")
-                       (specDir `ba` "movedFile")
-      removeFileIfExists (specDir `ba` "movedFile")
-
-    it "recreateSymLink, all fine" $ do
-      recreateSymlink' (specDir `ba` "myFileL")
-                       (specDir `ba` "dir/movedFile")
-      removeFileIfExists (specDir `ba` "dir/movedFile")
-
-    -- posix failures --
-    it "recreateSymLink, wrong input type (file)" $
-      recreateSymlink' (specDir `ba` "myFile")
-                       (specDir `ba` "movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InvalidArgument)
-
-    it "recreateSymLink, wrong input type (directory)" $
-      recreateSymlink' (specDir `ba` "dir")
-                       (specDir `ba` "movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == InvalidArgument)
-
-    it "recreateSymLink, can't write to destination directory" $
-      recreateSymlink' (specDir `ba` "myFileL")
-                       (specDir `ba` "noWritePerm/movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "recreateSymLink, can't open destination directory" $
-      recreateSymlink' (specDir `ba` "myFileL")
-                       (specDir `ba` "noPerms/movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "recreateSymLink, can't open source directory" $
-      recreateSymlink' (specDir `ba` "noPerms/myFileL")
-                       (specDir `ba` "movedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "recreateSymLink, destination file already exists" $
-      recreateSymlink' (specDir `ba` "myFileL")
-                       (specDir `ba` "alreadyExists")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-
-    it "recreateSymLink, destination already exists and is a dir" $
-      recreateSymlink' (specDir `ba` "myFileL")
-                       (specDir `ba` "alreadyExistsD")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == AlreadyExists)
-
-    -- custom failures --
-    it "recreateSymLink, source and destination are the same file" $
-      recreateSymlink' (specDir `ba` "myFileL")
-                       (specDir `ba` "myFileL")
-        `shouldThrow`
-        isSameFile
-

test/FileSystem/FileOperations/RenameFileSpec.hs

@@ -1,95 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module FileSystem.FileOperations.RenameFileSpec where
-
-
-import Test.Hspec
-import HSFM.FileSystem.Errors
-import System.IO.Error
-  (
-    ioeGetErrorType
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import Utils
-import qualified Data.ByteString as BS
-import           Data.ByteString.UTF8 (toString)
-
-
-ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
-ba = BS.append
-
-specDir :: BS.ByteString
-specDir = "test/FileSystem/FileOperations/renameFileSpec/"
-
-specDir' :: String
-specDir' = toString specDir
-
-
-spec :: Spec
-spec =
-  describe "HSFM.FileSystem.FileOperations.renameFile" $ do
-
-    -- successes --
-    it "renameFile, all fine" $
-      renameFile' (specDir `ba` "myFile")
-                  (specDir `ba` "renamedFile")
-
-    it "renameFile, all fine" $
-      renameFile' (specDir `ba` "myFile")
-                  (specDir `ba` "dir/renamedFile")
-
-    it "renameFile, all fine on symlink" $
-      renameFile' (specDir `ba` "myFileL")
-                  (specDir `ba` "renamedFile")
-
-    it "renameFile, all fine on directory" $
-      renameFile' (specDir `ba` "dir")
-                  (specDir `ba` "renamedFile")
-
-    -- posix failures --
-    it "renameFile, source file does not exist" $
-      renameFile' (specDir `ba` "fileDoesNotExist")
-                  (specDir `ba` "renamedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == NoSuchThing)
-
-    it "renameFile, can't write to output directory" $
-      renameFile' (specDir `ba` "myFile")
-                  (specDir `ba` "noWritePerm/renamedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "renameFile, can't open output directory" $
-      renameFile' (specDir `ba` "myFile")
-                  (specDir `ba` "noPerms/renamedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    it "renameFile, can't open source directory" $
-      renameFile' (specDir `ba` "noPerms/myFile")
-                  (specDir `ba` "renamedFile")
-        `shouldThrow`
-        (\e -> ioeGetErrorType e == PermissionDenied)
-
-    -- custom failures --
-    it "renameFile, destination file already exists" $
-      renameFile' (specDir `ba` "myFile")
-                  (specDir `ba` "alreadyExists")
-        `shouldThrow`
-        isFileDoesExist
-
-    it "renameFile, move from file to dir" $
-      renameFile' (specDir `ba` "myFile")
-                  (specDir `ba` "alreadyExistsD")
-        `shouldThrow`
-        isDirDoesExist
-
-    it "renameFile, source and dest are same file" $
-      renameFile' (specDir `ba` "myFile")
-                  (specDir `ba` "myFile")
-        `shouldThrow`
-        isSameFile
-

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

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

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

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

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/alreadyExistsD/inputFile2

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

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

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

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

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

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir/inputFile2

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

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

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

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

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

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

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

test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/wrongInputSymL

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

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

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

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

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

test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir/inputFile2

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

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

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

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

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

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

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

test/FileSystem/FileOperations/copyDirRecursiveSpec/wrongInputSymL

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

test/FileSystem/FileOperations/copyFileOverwriteSpec/alreadyExists

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

test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile

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

test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFileSymL

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

test/FileSystem/FileOperations/copyFileSpec/inputFile

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

test/FileSystem/FileOperations/copyFileSpec/inputFileSymL

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

test/FileSystem/FileOperations/deleteDirRecursiveSpec/dirSym

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

test/FileSystem/FileOperations/deleteDirSpec/dirSym

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

test/FileSystem/FileOperations/deleteFileSpec/syml

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

test/FileSystem/FileOperations/getDirsFilesSpec/dirsym

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

test/FileSystem/FileOperations/getDirsFilesSpec/syml

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