Skip build with 7.8.4, which has annoying failures

This fixes 'cabal check' warnings.

.gitignore

@@ -6,3 +6,4 @@ cabal.sandbox.config
 *.prof
 *.old
 .liquid/
+3rdparty/hpath

.gitmodules

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

.travis.yml

@@ -0,0 +1,55 @@
+# See https://github.com/hvr/multi-ghc-travis for more information
+
+language: c
+
+sudo: required
+dist: trusty
+
+matrix:
+  include:
+    - env: CABALVER=1.24 GHCVER=7.10.2
+      addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2,libgtk2.0-dev,libgtk-3-dev], sources: [hvr-ghc]}}
+    - env: CABALVER=1.24 GHCVER=8.0.1
+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1,libgtk2.0-dev,libgtk-3-dev], sources: [hvr-ghc]}}
+    - env: CABALVER=head GHCVER=head
+      addons: {apt: {packages: [cabal-install-head,ghc-head,libgtk2.0-dev,libgtk-3-dev],  sources: [hvr-ghc]}}
+
+  allow_failures:
+    - env: CABALVER=head GHCVER=head
+
+before_install:
+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
+
+install:
+ - cabal --version
+ - travis_retry cabal update
+ - cabal sandbox init
+ - cabal install alex happy
+ - export PATH="$(pwd)/.cabal-sandbox/bin:$PATH"
+ - cabal install gtk2hs-buildtools
+ - cabal install --only-dependencies --enable-tests -j
+
+script:
+ - cabal configure --enable-tests -v2
+ - cabal build
+ - cabal test
+ - cabal check
+ - cabal sdist
+# check that the generated source-distribution can be built & installed
+ - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
+   cd dist/;
+   cabal sandbox init;
+   if [ -f "$SRC_TGZ" ]; then
+      cabal install alex happy;
+      export PATH="$(pwd)/.cabal-sandbox/bin:$PATH";
+      cabal install gtk2hs-buildtools;
+      cabal install "$SRC_TGZ" --enable-tests;
+   else
+      echo "expected '$SRC_TGZ' not found";
+      exit 1;
+   fi
+
+notifications:
+  email:
+    - hasufell@posteo.de
+

README.md

@@ -1,7 +1,7 @@
 HSFM
 ====
 
-__NOTE: This project is in a highly experimental state! Don't complain if it deletes your whole home directory. You should use a chroot, docker environment or similar for testing.__
+[![Build Status](https://api.travis-ci.org/hasufell/hsfm.png?branch=master)](http://travis-ci.org/hasufell/hsfm)
 
 A Gtk+:3 filemanager written in Haskell.
 
@@ -21,11 +21,7 @@ Installation
 ------------
 
 ```
-git submodule update --init --recursive
 cabal sandbox init
-cabal sandbox add-source 3rdparty/hpath
-cabal sandbox add-source 3rdparty/hpath/3rdparty/posix-paths
-cabal sandbox add-source 3rdparty/simple-sendfile
 cabal install alex happy
 export PATH="$(pwd)/.cabal-sandbox/bin:$PATH"
 cabal install gtk2hs-buildtools

data/Gtk/builder.xml

@@ -364,6 +364,7 @@
           <object class="GtkNotebook" id="notebook">
             <property name="visible">True</property>
             <property name="can_focus">True</property>
+            <property name="scrollable">True</property>
             <child>
               <placeholder/>
             </child>

hacking/HACKING.md

@@ -19,20 +19,6 @@ documentation.
 
 ## Hacking Overview
 
-The main data structure for the IO related File type is in
-[HSFM.FileSystem.FileType](./../src/HSFM/FileSystem/FileType.hs#L93), which
-should be seen as a library. This is the entry point where
-[directory contents are read](./../src/HSFM/FileSystem/FileType.hs#L465)
-and the File type in general [is constructed](./../src/HSFM/FileSystem/FileType.hs#L302).
-The File type uses a safe Path type under the hood instead of Strings,
-utilizing the [hpath](https://github.com/hasufell/hpath) library.
-Note that mostly only absolute paths are allowed on type level to improve
-path and thread safety.
-
-File operations (like copy, delete etc) are defined at
-[HSFM.FileSystem.FileOperation](./../src/HSFM/FileSystem/FileOperations.hs)
-which use this File type.
-
 Only a GTK GUI is currently implemented, the entry point being
 [HSFM.GUI.Gtk](./../src/HSFM/GUI/Gtk.hs). From there it flows down
 to creating a [MyGUI object](./../src/HSFM/GUI/Gtk/Data.hs#L51) in
@@ -75,6 +61,8 @@ This leads to the following benefits:
 * we can reason about filepaths and rely on them to be valid (don't confuse that with "they exist")
 * filepath functions like `(</>)` are now predictable and safe in contrast to the version from the `filepath` package
 
+The [hpath](https://hackage.haskell.org/package/hpath) library does exactly that for us.
+
 The only problem with this approach is that most libraries are still String
 based. Some provide dedicated `Foo.ByteString` modules though, but it
 might be necessary to fork libraries.
@@ -98,17 +86,10 @@ the call stack at point `b` in time, when the file information in memory
 could already be out of date. There are two approaches to make this less
 sucky:
 * use the hinotify library on GUI level to refresh the view (and the File representation in memory) whenever the contents of a directory changes
-* when we stuff something into the copy buffer, it is not saved as type `File a`, but as `Path Abs`... when the operation is finalized via `runFileOp`, then the file at the given path is read and the copy/move/whatnot function carried out immediately
+* when we stuff something into the copy buffer, it is not saved as type `File a`, but as `Path Abs`... when the operation is finalized  then the file at the given path is read and the copy/move/whatnot function carried out immediately
-
-This means we should only interact with the `HSFM.FileSystem.FileOperation`
-module via the operation data types `FileOperation`, `Copy` and `Move` and
-the `runFileOp` function. This doesn't completely solve the problem, but for
-the rest we have to trust the posix functions to throw the proper exceptions.
 
 In addition, we don't use the `directory` package, which is dangerous
-and broken. Instead, we implement our own low-level wrappers around
+and broken. Instead, we use the [HPath.IO](https://hackage.haskell.org/package/hpath/docs/HPath-IO.html).
-the posix functions, so we have proper control over the internals
-and know the possible exceptions.
 
 ### Exception handling
 
@@ -116,7 +97,7 @@ Exceptions are good. We don't want to wrap everything in Maybe/Either types
 unless we want to handle failure immediately. Otherwise we need to make
 sure that at least at some point IOExceptions are caught and visualized
 to the user. This is often done via e.g. `withErrorDialog` which catches
-`IOException` and `FmIOException`.
+`IOException` and [HPathIOException](https://hackage.haskell.org/package/hpath/docs/HPath-IO-Errors.html#t:HPathIOException).
 
 It's also important to clean up stuff like filedescriptors via
 functions like `bracket` directly in our low-level code in case

hsfm.cabal

@@ -10,7 +10,7 @@ copyright:           Copyright: (c) 2016 Julian Ospald
 homepage:            https://github.com/hasufell/hsfm
 category:            Desktop
 build-type:          Simple
-cabal-version:       >=1.10
+cabal-version:       >=1.24
 
 data-files:
                      LICENSE
@@ -24,31 +24,22 @@ data-files:
 
 library
   exposed-modules:
-                       HSFM.FileSystem.Errors
-                       HSFM.FileSystem.FileOperations
                        HSFM.FileSystem.FileType
                        HSFM.FileSystem.UtilTypes
                        HSFM.Utils.IO
                        HSFM.Utils.MyPrelude
 
   build-depends:
-                       base >= 4.7,
+                       base >= 4.8 && < 5,
                        bytestring,
-                       containers,
                        data-default,
                        filepath >= 1.3.0.0,
                        hinotify-bytestring,
-                       hpath,
+                       hpath >= 0.7.1,
-                       mtl >= 2.2,
-                       old-locale >= 1,
-                       posix-paths,
-                       process,
                        safe,
-                       simple-sendfile,
                        stm,
                        time >= 1.4.2,
                        unix,
-                       unix-bytestring,
                        utf8-string
   hs-source-dirs:      src
   default-language:    Haskell2010
@@ -57,10 +48,7 @@ library
                        FlexibleInstances
                        ViewPatterns
   ghc-options:
-    -O2
-    -threaded
     -Wall
-    "-with-rtsopts=-N"
 
 executable hsfm-gtk
   main-is:             HSFM/GUI/Gtk.hs
@@ -78,20 +66,17 @@ executable hsfm-gtk
                        HSFM.Utils.MyPrelude
 
   build-depends:
-                       Cabal >= 1.22.0.0,
+                       Cabal >= 1.24.0.0,
-                       base >= 4.7,
+                       base >= 4.8 && < 5,
                        bytestring,
-                       containers,
                        data-default,
                        filepath >= 1.3.0.0,
                        glib >= 0.13,
                        gtk3 >= 0.14.1,
                        hinotify-bytestring,
-                       hpath,
+                       hpath >= 0.7.1,
                        hsfm,
-                       mtl >= 2.2,
                        old-locale >= 1,
-                       posix-paths,
                        process,
                        safe,
                        simple-sendfile,
@@ -109,42 +94,9 @@ executable hsfm-gtk
                        FlexibleInstances
                        ViewPatterns
   ghc-options:
-    -O2
-    -threaded
     -Wall
-    "-with-rtsopts=-N"
 
+source-repository head
+  type:     git
+  location: https://github.com/hasufell/hsfm
 
-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

@@ -1,339 +0,0 @@
-{--
-HSFM, a filemanager written in Haskell.
-Copyright (C) 2016 Julian Ospald
-
-This program is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public License
-version 2 as published by the Free Software Foundation.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
---}
-
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_HADDOCK ignore-exports #-}
-
--- |Provides error handling.
-module HSFM.FileSystem.Errors where
-
-
-import Control.Exception
-import Control.Monad
-  (
-    forM
-  , when
-  )
-import Data.ByteString
-  (
-    ByteString
-  )
-import Data.Data
-  (
-    Data(..)
-  )
-import Data.Typeable
-import Foreign.C.Error
-  (
-    getErrno
-  , Errno
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType
-  )
-import qualified HPath as P
-import HPath
-    (
-      Abs
-    , Path
-    )
-import HSFM.Utils.IO
-import System.IO.Error
-  (
-    catchIOError
-  , ioeGetErrorType
-  )
-
-import qualified System.Posix.Directory.ByteString as PFD
-import System.Posix.Files.ByteString
-  (
-    fileAccess
-  , getFileStatus
-  )
-import qualified System.Posix.Files.ByteString as PF
-
-
-data FmIOException = FileDoesNotExist ByteString
-                   | DirDoesNotExist ByteString
-                   | PathNotAbsolute ByteString
-                   | FileNotExecutable ByteString
-                   | SameFile ByteString ByteString
-                   | NotAFile ByteString
-                   | NotADir ByteString
-                   | DestinationInSource ByteString ByteString
-                   | FileDoesExist ByteString
-                   | DirDoesExist ByteString
-                   | IsSymlink ByteString
-                   | InvalidOperation String
-                   | InvalidFileName
-                   | Can'tOpenDirectory ByteString
-                   | CopyFailed String
-                   | MoveFailed String
-  deriving (Typeable, Eq, Data)
-
-
-instance Show FmIOException where
-  show (FileDoesNotExist fp) = "File does not exist:" ++ P.fpToString fp
-  show (DirDoesNotExist fp) = "Directory does not exist: "
-                              ++ P.fpToString fp
-  show (PathNotAbsolute fp) = "Path not absolute: " ++ P.fpToString fp
-  show (FileNotExecutable fp) = "File not executable: "
-                                ++ P.fpToString fp
-  show (SameFile fp1 fp2) = P.fpToString fp1
-                            ++ " and " ++ P.fpToString fp2
-                            ++ " are the same file!"
-  show (NotAFile fp) = "Not a file: " ++ P.fpToString fp
-  show (NotADir fp) = "Not a directory: " ++ P.fpToString fp
-  show (DestinationInSource fp1 fp2) = P.fpToString fp1
-                                       ++ " is contained in "
-                                       ++ P.fpToString fp2
-  show (FileDoesExist fp) = "File does exist: " ++ P.fpToString fp
-  show (DirDoesExist fp) = "Directory does exist: " ++ P.fpToString fp
-  show (IsSymlink fp) = "Is a symlink: " ++ P.fpToString fp
-  show (InvalidOperation str) = "Invalid operation: " ++ str
-  show InvalidFileName = "Invalid file name!"
-  show (Can'tOpenDirectory fp) = "Can't open directory: "
-                                 ++ P.fpToString fp
-  show (CopyFailed str) = "Copying failed: " ++ str
-  show (MoveFailed str) = "Moving failed: " ++ str
-
-
-
-instance Exception FmIOException
-
-
-
-isDestinationInSource :: FmIOException -> Bool
-isDestinationInSource (DestinationInSource _ _) = True
-isDestinationInSource _                         = False
-
-
-isSameFile :: FmIOException -> Bool
-isSameFile (SameFile _ _) = True
-isSameFile _              = False
-
-
-isFileDoesExist :: FmIOException -> Bool
-isFileDoesExist (FileDoesExist _) = True
-isFileDoesExist _                 = False
-
-
-isDirDoesExist :: FmIOException -> Bool
-isDirDoesExist (DirDoesExist _) = True
-isDirDoesExist _                = False
-
-
-
-    ----------------------------
-    --[ Path based functions ]--
-    ----------------------------
-
-
-throwFileDoesExist :: Path Abs -> IO ()
-throwFileDoesExist fp =
-  whenM (doesFileExist fp) (throw . FileDoesExist
-                                  . P.fromAbs $ fp)
-
-
-throwDirDoesExist :: Path Abs -> IO ()
-throwDirDoesExist fp =
-  whenM (doesDirectoryExist fp) (throw . DirDoesExist
-                                       . P.fromAbs $ fp)
-
-
-throwFileDoesNotExist :: Path Abs -> IO ()
-throwFileDoesNotExist fp =
-  unlessM (doesFileExist fp) (throw . FileDoesNotExist
-                                    . P.fromAbs $ fp)
-
-
-throwDirDoesNotExist :: Path Abs -> IO ()
-throwDirDoesNotExist fp =
-  unlessM (doesDirectoryExist fp) (throw . DirDoesNotExist
-                                         . P.fromAbs $ fp)
-
-
--- |Uses `isSameFile` and throws `SameFile` if it returns True.
-throwSameFile :: Path Abs
-              -> Path Abs
-              -> IO ()
-throwSameFile fp1 fp2 =
-  whenM (sameFile fp1 fp2)
-        (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
--- within the source directory by comparing the device+file ID of the
--- source directory with all device+file IDs of the parent directories
--- of the destination.
-throwDestinationInSource :: Path Abs -- ^ source dir
-                         -> Path Abs -- ^ full destination, `dirname dest`
-                                     --   must exist
-                         -> IO ()
-throwDestinationInSource source dest = do
-  dest'   <- (\x -> maybe x (\y -> x P.</> y) $ P.basename dest)
-             <$> (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)
-  when (elem sid dids)
-       (throw $ DestinationInSource (P.fromAbs dest)
-                                    (P.fromAbs source))
-
-
--- |Checks if the given file exists and is not a directory.
--- Does not follow symlinks.
-doesFileExist :: Path Abs -> IO Bool
-doesFileExist fp =
-  handleIOError (\_ -> return False) $ do
-    fs  <- PF.getSymbolicLinkStatus (P.fromAbs fp)
-    return $ not . PF.isDirectory $ fs
-
-
--- |Checks if the given file exists and is a directory.
--- Does not follow symlinks.
-doesDirectoryExist :: Path Abs -> IO Bool
-doesDirectoryExist fp =
-  handleIOError (\_ -> return False) $ do
-    fs  <- PF.getSymbolicLinkStatus (P.fromAbs fp)
-    return $ PF.isDirectory fs
-
-
--- |Checks whether a file or folder is writable.
-isWritable :: Path Abs -> IO Bool
-isWritable fp =
-  handleIOError (\_ -> return False) $
-    fileAccess (P.fromAbs fp) False True False
-
-
--- |Checks whether the directory at the given path exists and can be
--- opened. This invokes `openDirStream` which follows symlinks.
-canOpenDirectory :: Path Abs -> IO Bool
-canOpenDirectory fp =
-  handleIOError (\_ -> return False) $ do
-    bracket (PFD.openDirStream . P.fromAbs $ fp)
-            PFD.closeDirStream
-            (\_ -> return ())
-    return True
-
-
--- |Throws a `Can'tOpenDirectory` FmIOException if the directory at the given
--- path cannot be opened.
-throwCantOpenDirectory :: Path Abs -> IO ()
-throwCantOpenDirectory fp =
-  unlessM (canOpenDirectory fp)
-          (throw . Can'tOpenDirectory . P.fromAbs $ fp)
-
-
-
-    --------------------------------
-    --[ Error handling functions ]--
-    --------------------------------
-
-
--- |Carries out an action, then checks if there is an IOException and
--- a specific errno. If so, then it carries out another action, otherwise
--- it rethrows the error.
-catchErrno :: [Errno] -- ^ errno to catch
-           -> IO a    -- ^ action to try, which can raise an IOException
-           -> IO a    -- ^ action to carry out in case of an IOException and
-                      --   if errno matches
-           -> IO a
-catchErrno en a1 a2 =
-  catchIOError a1 $ \e -> do
-    errno <- getErrno
-    if errno `elem` en
-      then a2
-      else ioError e
-
-
--- |Execute the given action and retrow IO exceptions as a new Exception
--- that have the given errno. If errno does not match the exception is rethrown
--- as is.
-rethrowErrnoAs :: Exception e
-               => [Errno]       -- ^ errno to catch
-               -> e             -- ^ rethrow as if errno matches
-               -> IO a          -- ^ action to try
-               -> IO a
-rethrowErrnoAs en fmex action = catchErrno en action (throw fmex)
-
-
-
--- |Like `catchIOError`, with arguments swapped.
-handleIOError :: (IOError -> IO a) -> IO a -> IO a
-handleIOError = flip catchIOError
-
-
--- |Like `bracket`, but allows to have different clean-up
--- actions depending on whether the in-between computation
--- has raised an exception or not. 
-bracketeer :: IO a        -- ^ computation to run first
-           -> (a -> IO b) -- ^ computation to run last, when
-                          --   no exception was raised
-           -> (a -> IO b) -- ^ computation to run last,
-                          --   when an exception was raised
-           -> (a -> IO c) -- ^ computation to run in-between
-           -> IO c
-bracketeer before after afterEx thing =
-  mask $ \restore -> do
-    a <- before
-    r <- restore (thing a) `onException` afterEx a
-    _ <- after a
-    return r
-
-
-reactOnError :: IO a
-             -> [(IOErrorType, IO a)]   -- ^ reaction on IO errors
-             -> [(FmIOException, IO a)] -- ^ reaction on FmIOException
-             -> IO a
-reactOnError a ios fmios =
-  a `catches` [iohandler, fmiohandler]
-  where
-    iohandler = Handler $
-      \(ex :: IOException) ->
-         foldr (\(t, a') y -> if ioeGetErrorType ex == t
-                                then a'
-                                else y)
-               (throwIO ex)
-               ios
-    fmiohandler = Handler $
-      \(ex :: FmIOException) ->
-         foldr (\(t, a') y -> if toConstr ex == toConstr t
-                                then a'
-                                else y)
-               (throwIO ex)
-               fmios

src/HSFM/FileSystem/FileOperations.hs

@@ -1,799 +0,0 @@
-{--
-HSFM, a filemanager written in Haskell.
-Copyright (C) 2016 Julian Ospald
-
-This program is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public License
-version 2 as published by the Free Software Foundation.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
---}
-
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PackageImports #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# OPTIONS_HADDOCK ignore-exports #-}
-
-
--- |This module provides high-level IO related file operations like
--- copy, delete, move and so on. It only operates on `Path Abs` which
--- guarantees us well-typed paths which are absolute.
---
--- Some functions are just path-safe wrappers around
--- unix functions, others have stricter exception handling
--- and some implement functionality that doesn't have a unix
--- counterpart (like `copyDirRecursive`).
---
--- Some of these operations are due to their nature not _atomic_, which
--- means they may do multiple syscalls which form one context. Some
--- of them also have to examine the filetypes explicitly before the
--- syscalls, so a reasonable decision can be made. That means
--- the result is undefined if another process changes that context
--- while the non-atomic operation is still happening. However, where
--- possible, as few syscalls as possible are used and the underlying
--- exception handling is kept.
-module HSFM.FileSystem.FileOperations where
-
-
-import Control.Exception
-  (
-    bracket
-  , bracketOnError
-  , throw
-  )
-import Control.Monad
-  (
-    void
-  , when
-  )
-import Data.ByteString
-  (
-    ByteString
-  )
-import Data.Foldable
-  (
-    for_
-  )
-import Data.Maybe
-  (
-    catMaybes
-  )
-import Data.Word
-  (
-    Word8
-  )
-import Foreign.C.Error
-  (
-    eEXIST
-  , eINVAL
-  , eNOSYS
-  , eNOTEMPTY
-  , eXDEV
-  )
-import Foreign.C.Types
-  (
-    CSize
-  )
-import Foreign.Marshal.Alloc
-  (
-    allocaBytes
-  )
-import Foreign.Ptr
-  (
-    Ptr
-  )
-import GHC.IO.Exception
-  (
-    IOErrorType(..)
-  )
-import HPath
-  (
-    Path
-  , Abs
-  , Fn
-  )
-import qualified HPath as P
-import HSFM.FileSystem.Errors
-import HSFM.Utils.IO
-import Prelude hiding (readFile)
-import System.IO.Error
-  (
-    catchIOError
-  , ioeGetErrorType
-  )
-import System.Posix.ByteString
-  (
-    exclusive
-  )
-import System.Posix.Directory.ByteString
-  (
-    createDirectory
-  , removeDirectory
-  )
-import System.Posix.Directory.Traversals
-  (
-    getDirectoryContents'
-  )
-import System.Posix.Files.ByteString
-  (
-    createSymbolicLink
-  , fileMode
-  , getFdStatus
-  , groupExecuteMode
-  , groupReadMode
-  , groupWriteMode
-  , otherExecuteMode
-  , otherReadMode
-  , otherWriteMode
-  , ownerModes
-  , ownerReadMode
-  , ownerWriteMode
-  , readSymbolicLink
-  , removeLink
-  , rename
-  , setFileMode
-  , unionFileModes
-  )
-import qualified System.Posix.Files.ByteString as PF
-import qualified "unix" System.Posix.IO.ByteString as SPI
-import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
-import qualified System.Posix.Directory.Traversals as SPDT
-import qualified System.Posix.Directory.Foreign as SPDF
-import System.Posix.IO.Sendfile.ByteString
-  (
-    sendfileFd
-  , FileRange(EntireFile)
-  )
-import qualified System.Posix.Process.ByteString as SPP
-import System.Posix.Types
-  (
-    FileMode
-  , ProcessID
-  , Fd
-  )
-
-
-
--- TODO: make sure we do the right thing for BlockDev, CharDev etc...
---       most operations are not implemented for these
-
-
-
-
-data FileType = Directory
-              | RegularFile
-              | SymbolicLink
-              | BlockDevice
-              | CharacterDevice
-              | NamedPipe
-              | Socket
-  deriving (Eq, Show)
-
-
-
-
-
-    --------------------
-    --[ File Copying ]--
-    --------------------
-
-
-
--- |Copies a directory recursively to the given destination.
--- Does not follow symbolic links.
---
--- Safety/reliability concerns:
---
---    * not atomic
---    * examines filetypes explicitly
---    * an explicit check `throwDestinationInSource` is carried out for the
---      top directory for basic sanity, because otherwise we might end up
---      with an infinite copy loop... however, this operation is not
---      carried out recursively (because it's slow)
---
--- Throws:
---
---    - `NoSuchThing` if source directory does not exist
---    - `PermissionDenied` if output directory is not writable
---    - `PermissionDenied` if source directory can't be opened
---    - `InvalidArgument` if source directory is wrong type (symlink)
---    - `InvalidArgument` if source directory is wrong type (regular file)
---    - `SameFile` if source and destination are the same file (`FmIOException`)
---    - `AlreadyExists` if destination already exists
---    - `DestinationInSource` if destination is contained in source (`FmIOException`)
-copyDirRecursive :: Path Abs  -- ^ source dir
-                 -> Path Abs  -- ^ full destination
-                 -> IO ()
-copyDirRecursive fromp destdirp
-  = do
-    -- for performance, sanity checks are only done for the top dir
-    throwSameFile fromp destdirp
-    throwDestinationInSource fromp destdirp
-    go fromp destdirp
-  where
-    go :: Path Abs -> Path Abs -> IO ()
-    go fromp' destdirp' = do
-      -- order is important here, so we don't get empty directories
-      -- on failure
-      contents <- getDirsFiles fromp'
-
-      fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (P.fromAbs fromp')
-      createDirectory (P.fromAbs destdirp') fmode'
-
-      for_ contents $ \f -> do
-        ftype <- getFileType f
-        newdest <- (destdirp' P.</>) <$> P.basename f
-        case ftype of
-          SymbolicLink -> recreateSymlink f newdest
-          Directory    -> go f newdest
-          RegularFile  -> copyFile f newdest
-          _            -> ioError $ userError $ "No idea what to do with the" ++
-                                                "given filetype: " ++ show ftype
-
--- |Like `copyDirRecursive` except it overwrites contents of directories
--- if any.
---
--- Throws:
---
---    - `NoSuchThing` if source directory does not exist
---    - `PermissionDenied` if output directory is not writable
---    - `PermissionDenied` if source directory can't be opened
---    - `InvalidArgument` if source directory is wrong type (symlink)
---    - `InvalidArgument` if source directory is wrong type (regular file)
---    - `SameFile` if source and destination are the same file (`FmIOException`)
---    - `DestinationInSource` if destination is contained in source (`FmIOException`)
-copyDirRecursiveOverwrite :: Path Abs  -- ^ source dir
-                          -> Path Abs  -- ^ full destination
-                          -> IO ()
-copyDirRecursiveOverwrite fromp destdirp
-  = do
-    -- for performance, sanity checks are only done for the top dir
-    throwSameFile fromp destdirp
-    throwDestinationInSource fromp destdirp
-    go fromp destdirp
-  where
-    go :: Path Abs -> Path Abs -> IO ()
-    go fromp' destdirp' = do
-      -- order is important here, so we don't get empty directories
-      -- on failure
-      contents <- getDirsFiles fromp'
-
-      fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (P.fromAbs fromp')
-      catchIOError (createDirectory (P.fromAbs destdirp') fmode') $ \e ->
-        case ioeGetErrorType e of
-          AlreadyExists -> setFileMode (P.fromAbs destdirp') fmode'
-          _             -> ioError e
-
-      for_ contents $ \f -> do
-        ftype <- getFileType f
-        newdest <- (destdirp' P.</>) <$> P.basename f
-        case ftype of
-          SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest)
-                          >> recreateSymlink f newdest
-          Directory    -> go f newdest
-          RegularFile  -> copyFileOverwrite f newdest
-          _            -> ioError $ userError $ "No idea what to do with the" ++
-                                                "given filetype: " ++ show ftype
-
-
--- |Recreate a symlink.
---
--- Throws:
---
---    - `InvalidArgument` if symlink file is wrong type (file)
---    - `InvalidArgument` if symlink file is wrong type (directory)
---    - `PermissionDenied` if output directory cannot be written to
---    - `PermissionDenied` if source directory cannot be opened
---    - `AlreadyExists` if destination file already exists
---    - `SameFile` if source and destination are the same file (`FmIOException`)
---
--- Note: calls `symlink`
-recreateSymlink :: Path Abs  -- ^ the old symlink file
-                -> Path Abs  -- ^ destination file
-                -> IO ()
-recreateSymlink symsource newsym
-  = do
-    throwSameFile symsource newsym
-    sympoint <- readSymbolicLink (P.fromAbs symsource)
-    createSymbolicLink sympoint (P.fromAbs newsym)
-
-
--- |Copies the given regular file to the given destination.
--- Neither follows symbolic links, nor accepts them.
--- For "copying" symbolic links, use `recreateSymlink` instead.
---
--- Throws:
---
---    - `NoSuchThing` if source file does not exist
---    - `PermissionDenied` if output directory is not writable
---    - `PermissionDenied` if source directory can't be opened
---    - `InvalidArgument` if source file is wrong type (symlink)
---    - `InvalidArgument` if source file is wrong type (directory)
---    - `SameFile` if source and destination are the same file (`FmIOException`)
---    - `AlreadyExists` if destination already exists
---
--- Note: calls `sendfile`
-copyFile :: Path Abs  -- ^ source file
-         -> Path Abs  -- ^ destination file
-         -> IO ()
-copyFile from to = do
-  throwSameFile from to
-  _copyFile [SPDF.oNofollow]
-            [SPDF.oNofollow, SPDF.oExcl]
-            from to
-
-
--- |Like `copyFile` except it overwrites the destination if it already
--- exists.
--- This also works if source and destination are the same file.
---
--- Safety/reliability concerns:
---
---    * not atomic
---    * falls back to delete-copy method with explicit checks
---
--- Throws:
---
---    - `NoSuchThing` if source file does not exist
---    - `PermissionDenied` if output directory is not writable
---    - `PermissionDenied` if source directory can't be opened
---    - `InvalidArgument` if source file is wrong type (symlink)
---    - `InvalidArgument` if source file is wrong type (directory)
---    - `SameFile` if source and destination are the same file (`FmIOException`)
---
--- Note: calls `sendfile`
-copyFileOverwrite :: Path Abs  -- ^ source file
-                  -> Path Abs  -- ^ destination file
-                  -> IO ()
-copyFileOverwrite from to = do
-  throwSameFile from to
-  catchIOError (_copyFile [SPDF.oNofollow]
-                          [SPDF.oNofollow, SPDF.oTrunc]
-                          from to) $ \e ->
-    case ioeGetErrorType e of
-      -- if the destination file is not writable, we need to
-      -- figure out if we can still copy by deleting it first
-      PermissionDenied -> do
-        exists   <- doesFileExist to
-        writable <- isWritable (P.dirname to)
-        if exists && writable
-          then deleteFile to >> copyFile from to
-          else ioError e
-      _ -> ioError e
-
-
-_copyFile :: [SPDF.Flags]
-          -> [SPDF.Flags]
-          -> Path Abs  -- ^ source file
-          -> Path Abs  -- ^ destination file
-          -> IO ()
-_copyFile sflags dflags from to
-  =
-    -- from sendfile(2) manpage:
-    --   Applications  may  wish  to  fall back to read(2)/write(2) in the case
-    --   where sendfile() fails with EINVAL or ENOSYS.
-    P.withAbsPath to $ \to' -> P.withAbsPath from $ \from' ->
-      catchErrno [eINVAL, eNOSYS]
-                 (sendFileCopy from' to')
-                 (void $ fallbackCopy from' to')
-  where
-    -- this is low-level stuff utilizing sendfile(2) for speed
-    sendFileCopy source dest =
-      bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
-              SPI.closeFd
-              $ \sfd -> do
-                fileM <- System.Posix.Files.ByteString.fileMode
-                         <$> getFdStatus sfd
-                bracketeer (SPDT.openFd dest SPI.WriteOnly
-                             dflags $ Just fileM)
-                           SPI.closeFd
-                           (\fd -> SPI.closeFd fd >> deleteFile to)
-                           $ \dfd -> sendfileFd dfd sfd EntireFile
-    -- low-level copy operation utilizing read(2)/write(2)
-    -- in case `sendFileCopy` fails/is unsupported
-    fallbackCopy source dest =
-      bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
-              SPI.closeFd
-              $ \sfd -> do
-                fileM <- System.Posix.Files.ByteString.fileMode
-                         <$> getFdStatus sfd
-                bracketeer (SPDT.openFd dest SPI.WriteOnly
-                             dflags $ Just fileM)
-                           SPI.closeFd
-                           (\fd -> SPI.closeFd fd >> deleteFile to)
-                            $ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->
-                                        write' sfd dfd buf 0
-      where
-        bufSize :: CSize
-        bufSize = 8192
-        write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int
-        write' sfd dfd buf totalsize = do
-            size <- SPB.fdReadBuf sfd buf bufSize
-            if size == 0
-              then return $ fromIntegral totalsize
-              else do rsize <- SPB.fdWriteBuf dfd buf size
-                      -- TODO: switch to IOError?
-                      when (rsize /= size) (throw . CopyFailed $ "wrong size!")
-                      write' sfd dfd buf (totalsize + fromIntegral size)
-
-
--- |Copies anything. In case of a symlink,
--- it is just recreated, even if it points to a directory.
---
--- Safety/reliability concerns:
---
---    * examines filetypes explicitly
---    * calls `copyDirRecursive` for directories
-easyCopy :: Path Abs
-         -> Path Abs
-         -> IO ()
-easyCopy from to = do
-  ftype <- getFileType from
-  case ftype of
-       SymbolicLink -> recreateSymlink from to
-       RegularFile  -> copyFile from to
-       Directory    -> copyDirRecursive from to
-       _            -> ioError $ userError $ "No idea what to do with the" ++
-                                             "given filetype: " ++ show ftype
-
-
--- |Like `easyCopy` except it overwrites the destination if it already exists.
--- For directories, this overwrites contents without pruning them, so the resulting
--- directory may have more files than have been copied.
-easyCopyOverwrite :: Path Abs
-                  -> Path Abs
-                  -> IO ()
-easyCopyOverwrite from to = do
-  ftype <- getFileType from
-  case ftype of
-       SymbolicLink -> whenM (doesFileExist to) (deleteFile to)
-                       >> recreateSymlink from to
-       RegularFile  -> copyFileOverwrite from to
-       Directory    -> copyDirRecursiveOverwrite from to
-       _            -> ioError $ userError $ "No idea what to do with the" ++
-                                             "given filetype: " ++ show ftype
-
-
-
-
-
-
-    ---------------------
-    --[ File Deletion ]--
-    ---------------------
-
-
--- |Deletes the given file, does not follow symlinks. Raises `eISDIR`
--- if run on a directory. Does not follow symbolic links.
---
--- Throws:
---
---    - `InappropriateType` for wrong file type (directory)
---    - `NoSuchThing` if the file does not exist
---    - `PermissionDenied` if the directory cannot be read
-deleteFile :: Path Abs -> IO ()
-deleteFile p = P.withAbsPath p removeLink
-
-
--- |Deletes the given directory, which must be empty, never symlinks.
---
--- Throws:
---
---    - `InappropriateType` for wrong file type (symlink to directory)
---    - `InappropriateType` for wrong file type (regular file)
---    - `NoSuchThing` if directory does not exist
---    - `UnsatisfiedConstraints` if directory is not empty
---    - `PermissionDenied` if we can't open or write to parent directory
---
--- Notes: calls `rmdir`
-deleteDir :: Path Abs -> IO ()
-deleteDir p = P.withAbsPath p removeDirectory
-
-
--- |Deletes the given directory recursively. Does not follow symbolic
--- links. Tries `deleteDir` first before attemtping a recursive
--- deletion.
---
--- Safety/reliability concerns:
---
---    * not atomic
---    * examines filetypes explicitly
---
--- Throws:
---
---    - `InappropriateType` for wrong file type (symlink to directory)
---    - `InappropriateType` for wrong file type (regular file)
---    - `NoSuchThing` if directory does not exist
---    - `PermissionDenied` if we can't open or write to parent directory
-deleteDirRecursive :: Path Abs -> IO ()
-deleteDirRecursive p =
-  catchErrno [eNOTEMPTY, eEXIST]
-             (deleteDir p)
-    $ do
-      files <- getDirsFiles p
-      for_ files $ \file -> do
-        ftype <- getFileType file
-        case ftype of
-          SymbolicLink -> deleteFile file
-          Directory    -> deleteDirRecursive file
-          RegularFile  -> deleteFile file
-          _            -> ioError $ userError $ "No idea what to do with the" ++
-                                                "given filetype: " ++ show ftype
-      removeDirectory . P.toFilePath $ p
-
-
--- |Deletes a file, directory or symlink, whatever it may be.
--- In case of directory, performs recursive deletion. In case of
--- a symlink, the symlink file is deleted.
---
--- Safety/reliability concerns:
---
---    * examines filetypes explicitly
---    * calls `deleteDirRecursive` for directories
-easyDelete :: Path Abs -> IO ()
-easyDelete p = do
-  ftype <- getFileType p
-  case ftype of
-    SymbolicLink -> deleteFile p
-    Directory    -> deleteDirRecursive p
-    RegularFile  -> deleteFile p
-    _            -> ioError $ userError $ "No idea what to do with the" ++
-                                          "given filetype: " ++ show ftype
-
-
-
-
-    --------------------
-    --[ File Opening ]--
-    --------------------
-
-
--- |Opens a file appropriately by invoking xdg-open. The file type
--- is not checked.
-openFile :: Path Abs
-         -> IO ProcessID
-openFile p =
-  P.withAbsPath p $ \fp ->
-    SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing
-
-
--- |Executes a program with the given arguments.
-executeFile :: Path Abs        -- ^ program
-            -> [ByteString]    -- ^ arguments
-            -> IO ProcessID
-executeFile fp args
-  = P.withAbsPath fp $ \fpb ->
-      SPP.forkProcess
-      $ SPP.executeFile fpb True args Nothing
-
-
-
-
-    ---------------------
-    --[ File Creation ]--
-    ---------------------
-
-
--- |Create an empty regular file at the given directory with the given filename.
---
--- Throws:
---
---    - `PermissionDenied` if output directory cannot be written to
---    - `AlreadyExists` if destination file already exists
-createRegularFile :: Path Abs -> IO ()
-createRegularFile dest =
-  bracket (SPI.openFd (P.fromAbs dest) SPI.WriteOnly (Just newFilePerms)
-                      (SPI.defaultFileFlags { exclusive = True }))
-          SPI.closeFd
-          (\_ -> return ())
-
-
--- |Create an empty directory at the given directory with the given filename.
---
--- Throws:
---
---    - `PermissionDenied` if output directory cannot be written to
---    - `AlreadyExists` if destination directory already exists
-createDir :: Path Abs -> IO ()
-createDir dest = createDirectory (P.fromAbs dest) newDirPerms
-
-
-
-
-    ----------------------------
-    --[ File Renaming/Moving ]--
-    ----------------------------
-
-
--- |Rename a given file with the provided filename. Destination and source
--- must be on the same device, otherwise `eXDEV` will be raised.
---
--- Does not follow symbolic links, but renames the symbolic link file.
---
--- Safety/reliability concerns:
---
---    * has a separate set of exception handling, apart from the syscall
---
--- Throws:
---
---     - `NoSuchThing` if source file does not exist
---     - `PermissionDenied` if output directory cannot be written to
---     - `PermissionDenied` if source directory cannot be opened
---     - `UnsupportedOperation` if source and destination are on different devices
---     - `FileDoesExist` if destination file already exists
---     - `DirDoesExist` if destination directory already exists
---     - `SameFile` if destination and source are the same file (`FmIOException`)
---
--- Note: calls `rename` (but does not allow to rename over existing files)
-renameFile :: Path Abs -> Path Abs -> IO ()
-renameFile fromf tof = do
-  throwSameFile fromf tof
-  throwFileDoesExist tof
-  throwDirDoesExist tof
-  rename (P.fromAbs fromf) (P.fromAbs tof)
-
-
--- |Move a file. This also works across devices by copy-delete fallback.
--- And also works on directories.
---
--- Does not follow symbolic links, but renames the symbolic link file.
---
--- Safety/reliability concerns:
---
---    * copy-delete fallback is inherently non-atomic
---
--- Throws:
---
---     - `NoSuchThing` if source file does not exist
---     - `PermissionDenied` if output directory cannot be written to
---     - `PermissionDenied` if source directory cannot be opened
---     - `FileDoesExist` if destination file already exists
---     - `DirDoesExist` if destination directory already exists
---     - `SameFile` if destination and source are the same file (`FmIOException`)
---
--- Note: calls `rename` (but does not allow to rename over existing files)
-moveFile :: Path Abs  -- ^ file to move
-         -> Path Abs  -- ^ destination
-         -> IO ()
-moveFile from to = do
-  throwSameFile from to
-  catchErrno [eXDEV] (renameFile from to) $ do
-    easyCopy from to
-    easyDelete from
-
-
--- |Like `moveFile`, but overwrites the destination if it exists.
---
--- Does not follow symbolic links, but renames the symbolic link file.
---
--- Safety/reliability concerns:
---
---    * copy-delete fallback is inherently non-atomic
---    * checks for file types and destination file existence explicitly
---
--- Throws:
---
---     - `NoSuchThing` if source file does not exist
---     - `PermissionDenied` if output directory cannot be written to
---     - `PermissionDenied` if source directory cannot be opened
---     - `SameFile` if destination and source are the same file (`FmIOException`)
---
--- Note: calls `rename` (but does not allow to rename over existing files)
-moveFileOverwrite :: Path Abs  -- ^ file to move
-                  -> Path Abs  -- ^ destination
-                  -> IO ()
-moveFileOverwrite from to = do
-  throwSameFile from to
-  ft <- getFileType from
-  writable <- isWritable $ P.dirname to
-  case ft of
-    RegularFile -> do
-      exists <- doesFileExist to
-      when (exists && writable) (deleteFile to)
-    SymbolicLink -> do
-      exists <- doesFileExist to
-      when (exists && writable) (deleteFile to)
-    Directory -> do
-      exists <- doesDirectoryExist to
-      when (exists && writable) (deleteDir to)
-    _ -> ioError $ userError $ "Don't know how to handle filetype " ++
-                               show ft
-  moveFile from to
-
-
-
-
-    -----------------------
-    --[ File Permissions]--
-    -----------------------
-
-
--- |Default permissions for a new file.
-newFilePerms :: FileMode
-newFilePerms
-  =                  ownerWriteMode
-    `unionFileModes` ownerReadMode
-    `unionFileModes` groupWriteMode
-    `unionFileModes` groupReadMode
-    `unionFileModes` otherWriteMode
-    `unionFileModes` otherReadMode
-
-
--- |Default permissions for a new directory.
-newDirPerms :: FileMode
-newDirPerms
-  =                  ownerModes
-    `unionFileModes` groupExecuteMode
-    `unionFileModes` groupReadMode
-    `unionFileModes` otherExecuteMode
-    `unionFileModes` otherReadMode
-
-
-
-    -------------------------
-    --[ Directory reading ]--
-    -------------------------
-
-
--- |Gets all filenames of the given directory. This excludes "." and "..".
--- This version does not follow symbolic links.
---
--- Throws:
---
---     - `NoSuchThing` if directory does not exist
---     - `InappropriateType` if file type is wrong (file)
---     - `InappropriateType` if file type is wrong (symlink to file)
---     - `InappropriateType` if file type is wrong (symlink to dir)
---     - `PermissionDenied` if directory cannot be opened
-getDirsFiles :: Path Abs        -- ^ dir to read
-             -> IO [Path Abs]
-getDirsFiles p =
-  P.withAbsPath p $ \fp ->
-    bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing)
-            SPI.closeFd
-            $ \fd ->
-              return
-                . catMaybes
-                .   fmap (\x -> (P.</>) p <$> (parseMaybe . snd $ x))
-                =<< getDirectoryContents' fd
-  where
-    parseMaybe :: ByteString -> Maybe (Path Fn)
-    parseMaybe = P.parseFn
-
-
-
-
-    ---------------------------
-    --[ FileType operations ]--
-    ---------------------------
-
-
--- |Get the file type of the file located at the given path. Does
--- not follow symbolic links.
---
--- Throws:
---
---    - `NoSuchThing` if the file does not exist
---    - `PermissionDenied` if any part of the path is not accessible
-getFileType :: Path Abs -> IO FileType
-getFileType p = do
-  fs <- PF.getSymbolicLinkStatus (P.fromAbs p)
-  decide fs
-  where
-    decide fs
-      | PF.isDirectory fs       = return Directory
-      | PF.isRegularFile fs     = return RegularFile
-      | PF.isSymbolicLink fs    = return SymbolicLink
-      | PF.isBlockDevice fs     = return BlockDevice
-      | PF.isCharacterDevice fs = return CharacterDevice
-      | PF.isNamedPipe fs       = return NamedPipe
-      | PF.isSocket fs          = return Socket
-      | otherwise               = ioError $ userError "No filetype?!"
-

src/HSFM/FileSystem/FileType.hs

@@ -38,6 +38,10 @@ module HSFM.FileSystem.FileType where
 
 
 import Data.ByteString(ByteString)
+import Data.ByteString.UTF8
+  (
+    toString
+  )
 import Data.Default
 import Data.Time.Clock.POSIX
   (
@@ -51,11 +55,8 @@ import HPath
   , Path
   )
 import qualified HPath as P
-import HSFM.FileSystem.Errors
+import HPath.IO hiding (FileType(..))
-import HSFM.FileSystem.FileOperations
+import HPath.IO.Errors
-  (
-    getDirsFiles
-  )
 import HSFM.Utils.MyPrelude
 import Prelude hiding(readFile)
 import System.IO.Error
@@ -340,10 +341,10 @@ readDirectoryContents :: (Path Abs -> IO a)  -- ^ fills free a variable
 readDirectoryContents ff p = do
   files <- getDirsFiles p
   fcs   <- mapM (readFile ff) files
-  return $ removeNonexistent fcs
+  return fcs
 
 
--- |A variant of `readDirectoryContents` where the third argument
+-- |A variant of `readDirectoryContents` where the second argument
 -- is a `File`. If a non-directory is passed returns an empty list.
 getContents :: (Path Abs -> IO a)
             -> File FileInfo
@@ -501,18 +502,6 @@ handleDT p
   = handleIOError $ \e -> return $ Failed p e
 
 
--- DoesNotExist errors not present at the topmost level could happen if a
--- named file or directory is deleted after being listed by
--- getDirectoryContents but before we can get it into memory.
---    So we filter those errors out because the user should not see errors
--- raised by the internal implementation of this module:
---    This leaves the error if it exists in the top (user-supplied) level:
-removeNonexistent :: [File a] -> [File a]
-removeNonexistent = filter isOkConstructor
-  where
-    isOkConstructor c = not (failed c) || isOkError c
-    isOkError = not . isDoesNotExistErrorType . ioeGetErrorType . err
-
 
 ---- SYMLINK HELPERS: ----
 
@@ -526,29 +515,9 @@ isBrokenSymlink (SymLink _ _ Failed{} _) = True
 isBrokenSymlink _ = False
 
 
----- OTHER: ----
 
 
--- |Apply a function on the free variable. If there is no free variable
+---- PACKERS: ----
--- for the given constructor the value from the `Default` class is used.
-fromFreeVar :: (Default d) => (a -> d) -> File a -> d
-fromFreeVar f df = maybeD f $ getFreeVar df
-
-
-getFPasStr :: File a -> String
-getFPasStr = P.fpToString . P.fromAbs . path
-
-
--- |Gets the free variable. Returns Nothing if the constructor is of `Failed`.
-getFreeVar :: File a -> Maybe a
-getFreeVar (Dir _  d)         = Just d
-getFreeVar (RegFile _  d)     = Just d
-getFreeVar (SymLink _  d _ _) = Just d
-getFreeVar (BlockDev _  d)    = Just d
-getFreeVar (CharDev _  d)     = Just d
-getFreeVar (NamedPipe _  d)   = Just d
-getFreeVar (Socket _  d)      = Just d
-getFreeVar _                  = Nothing
 
 
 -- |Pack the modification time into a string.
@@ -616,3 +585,30 @@ packLinkDestination file = case file of
   SymLink { rawdest = dest } -> Just dest
   _                          -> Nothing
 
+
+
+
+---- OTHER: ----
+
+
+-- |Apply a function on the free variable. If there is no free variable
+-- for the given constructor the value from the `Default` class is used.
+fromFreeVar :: (Default d) => (a -> d) -> File a -> d
+fromFreeVar f df = maybeD f $ getFreeVar df
+
+
+getFPasStr :: File a -> String
+getFPasStr = toString . P.fromAbs . path
+
+
+-- |Gets the free variable. Returns Nothing if the constructor is of `Failed`.
+getFreeVar :: File a -> Maybe a
+getFreeVar (Dir _  d)         = Just d
+getFreeVar (RegFile _  d)     = Just d
+getFreeVar (SymLink _  d _ _) = Just d
+getFreeVar (BlockDev _  d)    = Just d
+getFreeVar (CharDev _  d)     = Just d
+getFreeVar (NamedPipe _  d)   = Just d
+getFreeVar (Socket _  d)      = Just d
+getFreeVar _                  = Nothing
+

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -28,7 +28,7 @@ import Control.Concurrent.STM
   )
 import Control.Exception
   (
-    throw
+    throwIO
   )
 import Control.Monad
   (
@@ -44,6 +44,11 @@ import Data.ByteString
   (
     ByteString
   )
+import Data.ByteString.UTF8
+  (
+    fromString
+  , toString
+  )
 import Data.Foldable
   (
     for_
@@ -55,8 +60,9 @@ import HPath
       Abs
     , Path
     )
-import HSFM.FileSystem.Errors
+import HPath.IO
-import HSFM.FileSystem.FileOperations
+import HPath.IO.Errors
+import HPath.IO.Utils
 import HSFM.FileSystem.FileType
 import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Gtk.Callbacks.Utils
@@ -340,8 +346,8 @@ del items@(_:_) _ _ = withErrorDialog $ do
   withConfirmationDialog cmsg
     $ forM_ items $ \item -> easyDelete . path $ item
 del _ _ _ = withErrorDialog
-              . throw $ InvalidOperation
+              . throwIO $ InvalidOperation
-                        "Operation not supported on multiple files"
+                          "Operation not supported on multiple files"
 
 
 -- |Initializes a file move operation.
@@ -355,8 +361,8 @@ moveInit items@(_:_) mygui _ = do
   popStatusbar mygui
   void $ pushStatusBar mygui sbmsg
 moveInit _ _ _ = withErrorDialog
-                   . throw $ InvalidOperation
+                   . throwIO $ InvalidOperation
-                             "No file selected!"
+                               "No file selected!"
 
 -- |Supposed to be used with 'withRows'. Initializes a file copy operation.
 copyInit :: [Item] -> MyGUI -> MyView -> IO ()
@@ -369,8 +375,8 @@ copyInit items@(_:_) mygui _ = do
   popStatusbar mygui
   void $ pushStatusBar mygui sbmsg
 copyInit _ _ _ = withErrorDialog
-                   . throw $ InvalidOperation
+                   . throwIO $ InvalidOperation
-                             "No file selected!"
+                               "No file selected!"
 
 
 -- |Finalizes a file operation, such as copy or move.
@@ -383,20 +389,20 @@ operationFinal mygui myview mitem = withErrorDialog $ do
   case op of
     FMove (PartialMove s) -> do
       let cmsg = "Really move " ++ imsg s
-                  ++ " to \"" ++ P.fpToString (P.fromAbs cdir)
+                  ++ " to \"" ++ toString (P.fromAbs cdir)
                   ++ "\"?"
       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)
+                 ++ " to \"" ++ toString (P.fromAbs cdir)
                  ++ "\"?"
       withConfirmationDialog cmsg $ doFileOperation (FCopy $ Copy s cdir)
     _ -> return ()
   where
     imsg s = case s of
-               (item:[]) -> "\"" ++ P.fpToString (P.fromAbs item) ++ "\""
+               (item:[]) -> "\"" ++ toString (P.fromAbs item) ++ "\""
                items     -> (show . length $ items) ++ " items"
 
 
@@ -404,7 +410,7 @@ operationFinal mygui myview mitem = withErrorDialog $ do
 newFile :: MyGUI -> MyView -> IO ()
 newFile _ myview = withErrorDialog $ do
   mfn   <- textInputDialog "Enter file name" ("" :: String)
-  let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
+  let pmfn = P.parseFn =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
     createRegularFile (path cdir P.</> fn)
@@ -414,7 +420,7 @@ newFile _ myview = withErrorDialog $ do
 newDir :: MyGUI -> MyView -> IO ()
 newDir _ myview = withErrorDialog $ do
   mfn   <- textInputDialog "Enter directory name" ("" :: String)
-  let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
+  let pmfn = P.parseFn =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
     createDir (path cdir P.</> fn)
@@ -424,18 +430,18 @@ renameF :: [Item] -> MyGUI -> MyView -> IO ()
 renameF [item] _ _ = withErrorDialog $ do
   iname <- P.fromRel <$> (P.basename $ path item)
   mfn  <- textInputDialog "Enter new file name" (iname :: ByteString)
-  let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
+  let pmfn = P.parseFn =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     let cmsg = "Really rename \"" ++ getFPasStr item
                ++ "\"" ++ " to \""
-               ++ P.fpToString (P.fromAbs $ (P.dirname . path $ item)
+               ++ toString (P.fromAbs $ (P.dirname . path $ item)
                                              P.</> fn) ++ "\"?"
     withConfirmationDialog cmsg $
-      HSFM.FileSystem.FileOperations.renameFile (path item)
+      HPath.IO.renameFile (path item)
-                                                ((P.dirname $ path item) P.</> fn)
+                          ((P.dirname $ path item) P.</> fn)
 renameF _ _ _ = withErrorDialog
-                  . throw $ InvalidOperation
+                  . throwIO $ InvalidOperation
-                            "Operation not supported on multiple files"
+                              "Operation not supported on multiple files"
 
 
 
@@ -468,8 +474,8 @@ execute :: [Item] -> MyGUI -> MyView -> IO ()
 execute [item] _ _ = withErrorDialog $
   void $ executeFile (path item) []
 execute _ _ _ = withErrorDialog
-                  . throw $ InvalidOperation
+                  . throwIO $ InvalidOperation
-                            "Operation not supported on multiple files"
+                              "Operation not supported on multiple files"
 
 
 -- |Supposed to be used with 'withRows'. Opens a file or directory.
@@ -485,8 +491,8 @@ open [item] mygui myview = withErrorDialog $
 open (FileLikeList fs) _ _ = withErrorDialog $
   forM_ fs $ \f -> void $ openFile . path $ f
 open _ _ _ = withErrorDialog
-               . throw $ InvalidOperation
+               . throwIO $ InvalidOperation
-                         "Operation not supported on multiple files"
+                           "Operation not supported on multiple files"
 
 
 -- |Go up one directory and visualize it in the treeView.

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

@@ -26,15 +26,21 @@ module HSFM.GUI.Gtk.Callbacks.Utils where
 
 import Control.Monad
   (
-    forM_
+    forM
+  , forM_
+  )
+import Control.Monad.IO.Class
+  (
+    liftIO
   )
 import GHC.IO.Exception
   (
     IOErrorType(..)
   )
+import Graphics.UI.Gtk
 import qualified HPath as P
-import HSFM.FileSystem.Errors
+import HPath.IO
-import HSFM.FileSystem.FileOperations
+import HPath.IO.Errors
 import HSFM.FileSystem.FileType
 import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Gtk.Data
@@ -46,6 +52,10 @@ import HSFM.Utils.IO
     modifyTVarIO
   )
 import Prelude hiding(readFile)
+import Control.Concurrent.STM.TVar
+  (
+    readTVarIO
+  )
 
 
 
@@ -59,8 +69,6 @@ doFileOperation (FCopy (Copy (f':fs') to)) =
 doFileOperation (FMove (Move (f':fs') to)) =
   _doFileOperation (f':fs') to moveFileOverwrite moveFile
     $ doFileOperation (FMove $ Move fs' to)
-  where
-
 doFileOperation _ = return ()
 
 

src/HSFM/GUI/Gtk/Dialogs.hs

@@ -21,10 +21,14 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.GUI.Gtk.Dialogs where
 
 
+import Control.Applicative
+  (
+    (<$>)
+  )
 import Control.Exception
   (
     displayException
-  , throw
+  , throwIO
   , IOException
   , catches
   , Handler(..)
@@ -68,7 +72,7 @@ import Distribution.Verbosity
   )
 import Graphics.UI.Gtk
 import qualified HPath as P
-import HSFM.FileSystem.Errors
+import HPath.IO.Errors
 import HSFM.FileSystem.FileType
 import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Glib.GlibString()
@@ -151,9 +155,9 @@ fileCollisionDialog t = do
     ResponseUser 4 -> do
       mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
-        pfn <- P.parseFn (P.userStringToFP fn)
+        pfn <- P.parseFn (fromString fn)
         return $ Rename pfn
-    _              -> throw  UnknownDialogButton
+    _              -> throwIO UnknownDialogButton
 
 
 renameDialog :: ByteString -> IO (Maybe FCollisonMode)
@@ -176,9 +180,9 @@ renameDialog t = do
     ResponseUser 2 -> do
       mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
-        pfn <- P.parseFn (P.userStringToFP fn)
+        pfn <- P.parseFn (fromString fn)
         return $ Rename pfn
-    _              -> throw  UnknownDialogButton
+    _              -> throwIO UnknownDialogButton
 
 
 -- |Shows the about dialog from the help menu.
@@ -222,7 +226,7 @@ withErrorDialog io =
     [ Handler (\e -> showErrorDialog
                        $ displayException (e :: IOException))
     , Handler (\e -> showErrorDialog
-                       $ displayException (e :: FmIOException))
+                       $ displayException (e :: HPathIOException))
     ]
 
 
@@ -250,7 +254,7 @@ textInputDialog title inittext = do
            -- TODO: make this more safe
            ResponseUser 0 -> Just <$> entryGetText entry
            ResponseUser 1 -> return Nothing
-           _              -> throw  UnknownDialogButton
+           _              -> throwIO UnknownDialogButton
   widgetDestroy chooserDialog
   return ret
 

src/HSFM/GUI/Gtk/Errors.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.
 --}
 
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 -- |Provides error handling for Gtk.

src/HSFM/GUI/Gtk/Icons.hs

@@ -22,6 +22,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.GUI.Gtk.Icons where
 
 
+import Control.Applicative
+  (
+    (<$>)
+  )
 import Data.Maybe
   (
     fromJust

src/HSFM/GUI/Gtk/MyView.hs

@@ -21,6 +21,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.GUI.Gtk.MyView where
 
 
+import Control.Applicative
+  (
+    (<$>)
+  )
 import Control.Concurrent.MVar
   (
     newEmptyMVar
@@ -37,6 +41,11 @@ import Control.Exception
     try
   , SomeException
   )
+import Control.Monad
+  (
+    forM_
+  )
+import qualified Data.ByteString as BS
 import Data.Foldable
   (
     for_
@@ -46,7 +55,7 @@ import Data.Maybe
     catMaybes
   , fromJust
   )
-import HSFM.FileSystem.Errors
+import HPath.IO.Errors
   (
     canOpenDirectory
   )
@@ -76,6 +85,11 @@ import System.INotify
   , killINotify
   , EventVariety(..)
   )
+import System.Posix.FilePath
+  (
+    pathSeparator
+  , hiddenFile
+  )
 
 
 
@@ -83,8 +97,12 @@ import System.INotify
 newTab :: MyGUI -> IO FMView -> Path Abs -> IO MyView
 newTab mygui iofmv path = do
   myview <- createMyView mygui iofmv
-  _ <- notebookAppendPage (notebook mygui) (viewBox myview)
+  i <- notebookAppendPage (notebook mygui) (viewBox myview)
        (maybe (P.fromAbs path) P.fromRel $ P.basename path)
+  mpage <- notebookGetNthPage (notebook mygui) i
+  forM_ mpage $ \page -> notebookSetTabReorderable (notebook mygui)
+                                                   page
+                                                   True
   refreshView mygui myview (Just path)
   return myview
 
@@ -303,7 +321,7 @@ refreshView mygui myview mfp =
                                                      Item)
         case ecd of
           Right dir -> return (Just $ path dir)
-          Left _    -> return (P.parseAbs P.pathSeparator')
+          Left _    -> return (P.parseAbs $ BS.singleton pathSeparator)
 
 
 -- |Refreshes the View based on the given directory.
@@ -393,7 +411,7 @@ constructView mygui myview = do
      item   <- treeModelGetRow rawModel' iter >>= (P.basename . path)
      if hidden
        then return True
-       else return $ not . P.hiddenFile $ item
+       else return . not . hiddenFile . P.fromRel $ item
 
   -- sorting
   sortedModel' <- treeModelSortNewWithModel filteredModel'

src/HSFM/GUI/Gtk/Utils.hs

@@ -21,6 +21,10 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 module HSFM.GUI.Gtk.Utils where
 
 
+import Control.Applicative
+  (
+    (<$>)
+  )
 import Control.Concurrent.MVar
   (
     readMVar

src/HSFM/Utils/IO.hs

@@ -33,11 +33,6 @@ import Control.Concurrent.STM.TVar
   , modifyTVar
   , TVar
   )
-import Control.Monad
-  (
-    when
-  , unless
-  )
 
 
 -- |Atomically write a TVar.
@@ -49,14 +44,3 @@ writeTVarIO tvar val = atomically $ writeTVar tvar val
 modifyTVarIO :: TVar a -> (a -> a) -> IO ()
 modifyTVarIO tvar f = atomically $ modifyTVar tvar f
 
-
--- |If the value of the first argument is True, then execute the action
--- provided in the second argument, otherwise do nothing.
-whenM :: Monad m => m Bool -> m () -> m ()
-whenM mb a = mb >>= (`when` a)
-
-
--- |If the value of the first argument is False, then execute the action
--- provided in the second argument, otherwise do nothing.
-unlessM :: Monad m => m Bool -> m () -> m ()
-unlessM mb a = mb >>= (`unless` a)

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