LIB: overhaul file operations and improve overall performance

This introduces a lot of changes and uses a more solid
file copy operation.

.gitmodules

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

3rdparty/simple-sendfile

@@ -0,0 +1 @@
+Subproject commit 28f95d506969ffd0c67aabbe48b315b7ae26c604

hsfm.cabal

@@ -42,6 +42,7 @@ library
                        old-locale >= 1,
                        process,
                        safe,
+                       simple-sendfile,
                        stm,
                        time >= 1.4.2,
                        unix,
@@ -89,6 +90,7 @@ executable hsfm-gtk
                        old-locale >= 1,
                        process,
                        safe,
+                       simple-sendfile,
                        stm,
                        time >= 1.4.2,
                        transformers,

src/HSFM/FileSystem/Errors.hs

@@ -65,6 +65,7 @@ data FmIOException = FileDoesNotExist String
                    | InvalidOperation String
                    | InvalidFileName
                    | Can'tOpenDirectory String
+                   | CopyFailed String
   deriving (Show, Typeable)
 
 
@@ -186,7 +187,7 @@ throwCantOpenDirectory fp =
 -- |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
+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
@@ -194,7 +195,7 @@ catchErrno :: Errno   -- ^ errno to catch
 catchErrno en a1 a2 =
   catchIOError a1 $ \e -> do
     errno <- getErrno
-    if errno == en
+    if errno `elem` en
       then a2
       else ioError e
 
@@ -203,7 +204,7 @@ catchErrno en a1 a2 =
 -- that have the given errno. If errno does not match the exception is rethrown
 -- as is.
 rethrowErrnoAs :: Exception e
-               => Errno         -- ^ errno to catch
+               => [Errno]       -- ^ errno to catch
                -> e             -- ^ rethrow as if errno matches
                -> IO a          -- ^ action to try
                -> IO a

src/HSFM/FileSystem/FileOperations.hs

@@ -38,6 +38,7 @@ import Control.Exception
 import Control.Monad
   (
     unless
+  , when
   , void
   )
 import Data.ByteString
@@ -48,19 +49,38 @@ import Data.Foldable
   (
     for_
   )
+import Data.Word
+  (
+    Word8
+  )
 import Foreign.C.Error
   (
     eXDEV
+  , eINVAL
+  , eNOSYS
+  )
+import Foreign.Marshal.Alloc
+  (
+    allocaBytes
+  )
+import Foreign.Ptr
+  (
+    Ptr
   )
 import HPath
-    (
+  (
-      Path
+    Path
-    , Fn
+  , Fn
-    )
+  )
 import qualified HPath as P
 import HSFM.FileSystem.Errors
 import HSFM.FileSystem.FileType
 import HSFM.Utils.IO
+import Network.Sendfile
+  (
+    sendfileFd
+  , FileRange(EntireFile)
+  )
 import System.Posix.Directory.ByteString
   (
     createDirectory
@@ -69,9 +89,9 @@ import System.Posix.Directory.ByteString
 import System.Posix.Files.ByteString
   (
     createSymbolicLink
-  , fileMode
   , readSymbolicLink
-  , getSymbolicLinkStatus
+  , fileMode
+  , getFdStatus
   , groupExecuteMode
   , groupReadMode
   , groupWriteMode
@@ -85,16 +105,15 @@ import System.Posix.Files.ByteString
   , unionFileModes
   , removeLink
   )
+import qualified System.Posix.Files.ByteString as PF
 import qualified "unix" System.Posix.IO.ByteString as SPI
-import "unix-bytestring" System.Posix.IO.ByteString
+import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
-  (
-    fdWrite
-  )
 import qualified System.Posix.Process.ByteString as SPP
 import System.Posix.Types
   (
     FileMode
   , ProcessID
+  , Fd
   )
 
 
@@ -107,30 +126,30 @@ import System.Posix.Types
 -- |Data type describing an actual file operation that can be
 -- carried out via `doFile`. Useful to build up a list of operations
 -- or delay operations.
-data FileOperation = FCopy    Copy
+data FileOperation a = FCopy    (Copy a)
-                   | FMove    Move
+                     | FMove    (Move a)
-                   | FDelete  [AnchoredFile FileInfo]
+                     | FDelete  [AnchoredFile a]
-                   | FOpen    (AnchoredFile FileInfo)
+                     | FOpen    (AnchoredFile a)
-                   | FExecute (AnchoredFile FileInfo) [ByteString]
+                     | FExecute (AnchoredFile a) [ByteString]
-                   | None
+                     | None
 
 
 -- |Data type describing partial or complete file copy operation.
 -- CC stands for a complete operation and can be used for `runFileOp`.
-data Copy = CP1 [AnchoredFile FileInfo]
+data Copy a = CP1 [AnchoredFile a]
-          | CP2 [AnchoredFile FileInfo]
+            | CP2 [AnchoredFile a]
-                (AnchoredFile FileInfo)
+                  (AnchoredFile a)
-          | CC  [AnchoredFile FileInfo]
+            | CC  [AnchoredFile a]
-                (AnchoredFile FileInfo)
+                  (AnchoredFile a)
-                CopyMode
+                  CopyMode
 
 
 -- |Data type describing partial or complete file move operation.
 -- MC stands for a complete operation and can be used for `runFileOp`.
-data Move = MP1 [AnchoredFile FileInfo]
+data Move a = MP1 [AnchoredFile a]
-          | MC  [AnchoredFile FileInfo]
+            | MC  [AnchoredFile a]
-                (AnchoredFile FileInfo)
+                  (AnchoredFile a)
-                CopyMode
+                  CopyMode
 
 
 -- |Copy modes.
@@ -144,7 +163,7 @@ data CopyMode = Strict  -- ^ fail if the target already exists
 
 -- |Run a given FileOperation. If the FileOperation is partial, it will
 -- be returned.
-runFileOp :: FileOperation -> IO (Maybe FileOperation)
+runFileOp :: FileOperation a -> IO (Maybe (FileOperation a))
 runFileOp (FCopy (CC froms to cm)) = mapM_ (\x -> easyCopy cm x to) froms
                                        >> return Nothing
 runFileOp (FCopy fo)               = return              $ Just $ FCopy fo
@@ -166,9 +185,9 @@ runFileOp _                        = return Nothing
 -- |Copies a directory to the given destination with the specified
 -- `DirCopyMode`. Excludes symlinks.
 copyDir :: CopyMode
-        -> AnchoredFile FileInfo  -- ^ source dir
+        -> AnchoredFile a  -- ^ source dir
-        -> AnchoredFile FileInfo  -- ^ destination dir
+        -> AnchoredFile a  -- ^ destination dir
-        -> Path Fn                -- ^ destination dir name
+        -> Path Fn         -- ^ destination dir name
         -> IO ()
 copyDir _ AFileInvFN _ _ = throw InvalidFileName
 copyDir _ _ AFileInvFN _ = throw InvalidFileName
@@ -179,54 +198,65 @@ copyDir       (Rename fn)
            _
   = copyDir Strict from to fn
 -- this branch must never get `Rename` as CopyMode
-copyDir cm from@(_ :/ Dir _ FileInfo{ fileMode = fmode })
+copyDir cm from@(_ :/ Dir {})
              to@(_ :/ Dir {})
              fn
   = do
     let fromp    = fullPath from
         top      = fullPath to
         destdirp = top P.</> fn
+    -- for performance, sanity checks are only done for the top dir
     throwDestinationInSource fromp destdirp
     throwSameFile fromp destdirp
     throwCantOpenDirectory fromp
     throwCantOpenDirectory top
-
+    go cm from to fn
-    createDestdir destdirp fmode
-    destdir <- HSFM.FileSystem.FileType.readFileWithFileInfo destdirp
-
-    contents <- readDirectoryContentsWithFileInfo' (fullPath from)
-
-    for_ contents $ \f ->
-      case f of
-        (_ :/ SymLink {})  -> recreateSymlink cm f destdir (name . file $ f)
-        (_ :/ Dir {})      -> copyDir cm f destdir (name . file $ f)
-        (_ :/ RegFile {})  -> copyFile Replace f destdir (name . file $ f)
-        _                  -> return ()
   where
-    createDestdir destdir fmode' =
+    go :: CopyMode -> AnchoredFile a -> AnchoredFile a -> Path Fn -> IO ()
-      let destdir' = P.toFilePath destdir
+    go cm' from'@(_ :/ Dir {})
-      in case cm of
+             to'@(_ :/ Dir {})
-        Merge   ->
+             fn' = do
-          unlessM (doesDirectoryExist destdir)
+      fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fullPathS from')
-                  (createDirectory destdir' fmode')
+      createDestdir (fullPath to' P.</> fn') fmode'
-        Strict  -> do
+      destdir <- readFileUnsafe (\_ -> return undefined)
-          throwDirDoesExist destdir
+                   (fullPath to' P.</> fn')
-          createDirectory destdir' fmode'
+      contents <- readDirectoryContentsUnsafe
-        Replace -> do
+                    getDirsFiles (\_ -> return undefined) (fullPath from')
-          whenM (doesDirectoryExist destdir)
+
-                (deleteDirRecursive =<<
+      for_ contents $ \f ->
-                   HSFM.FileSystem.FileType.readFileWithFileInfo destdir)
+        case f of
-          createDirectory destdir' fmode'
+          (_ :/ SymLink {})  -> recreateSymlink cm' f destdir (name . file $ f)
-        _ -> throw $ InvalidOperation "Internal error, wrong CopyMode!"
+          (_ :/ Dir {})      -> go cm' f destdir (name . file $ f)
+          (_ :/ RegFile {})  -> unsafeCopyFile Replace f destdir
+                                               (name . file $ f)
+          _                  -> return ()
+      where
+        createDestdir destdir fmode' =
+          let destdir' = P.toFilePath destdir
+          in case cm' of
+            Merge   ->
+              unlessM (doesDirectoryExist destdir)
+                      (createDirectory destdir' fmode')
+            Strict  -> do
+              throwDirDoesExist destdir
+              createDirectory destdir' fmode'
+            Replace -> do
+              whenM (doesDirectoryExist destdir)
+                    (deleteDirRecursive =<<
+                       readFileUnsafe
+                         (\_ -> return undefined) destdir)
+              createDirectory destdir' fmode'
+            _ -> throw $ InvalidOperation "Internal error, wrong CopyMode!"
+    go _ _ _ _ = throw $ InvalidOperation "wrong input type"
 copyDir _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Recreate a symlink.
 recreateSymlink :: CopyMode
-                -> AnchoredFile FileInfo  -- ^ the old symlink file
+                -> AnchoredFile a  -- ^ the old symlink file
-                -> AnchoredFile FileInfo  -- ^ destination dir of the
+                -> AnchoredFile a  -- ^ destination dir of the
-                                          --   new symlink file
+                                   --   new symlink file
-                -> Path Fn                -- ^ destination file name
+                -> Path Fn         -- ^ destination file name
                 -> IO ()
 recreateSymlink _ AFileInvFN _ _ = throw InvalidFileName
 recreateSymlink _ _ AFileInvFN _ = throw InvalidFileName
@@ -245,7 +275,7 @@ recreateSymlink cm symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) fn
     createSymbolicLink sympoint (P.fromAbs symname)
   where
     delOld symname = do
-      f <- HSFM.FileSystem.FileType.readFileWithFileInfo symname
+      f <- readFileUnsafe (\_ -> return undefined) symname
       unless (failed . file $ f)
              (easyDelete f)
 recreateSymlink _ _ _ _ = throw $ InvalidOperation "wrong input type"
@@ -255,9 +285,9 @@ recreateSymlink _ _ _ _ = throw $ InvalidOperation "wrong input type"
 -- |Copies the given regular file to the given dir with the given filename.
 -- Excludes symlinks.
 copyFile :: CopyMode
-         -> AnchoredFile FileInfo  -- ^ source file
+         -> AnchoredFile a  -- ^ source file
-         -> AnchoredFile FileInfo  -- ^ destination dir
+         -> AnchoredFile a  -- ^ destination dir
-         -> Path Fn                -- ^ destination file name
+         -> Path Fn         -- ^ destination file name
          -> IO ()
 copyFile _ AFileInvFN _ _ = throw InvalidFileName
 copyFile _ _ AFileInvFN _ = throw InvalidFileName
@@ -266,29 +296,79 @@ copyFile (Rename pn) from@(_ :/ RegFile {}) to@(_ :/ Dir {}) _
   = copyFile Strict from to pn
 copyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
   = do
-    let from' = fullPath from
+    let to'   = fullPath to P.</> fn
-        to'   = fullPath to P.</> fn
     throwCantOpenDirectory $ fullPath to
+    throwCantOpenDirectory . P.dirname . fullPath $ from
+    throwSameFile (fullPath from) to'
+    unsafeCopyFile cm from to fn
+copyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
+
+
+-- |Unsafe version of `copyFile` without initial sanity checks. Thise
+-- holds the actual copy logic though and is called by `copyFile` in the end.
+unsafeCopyFile :: CopyMode
+               -> AnchoredFile a  -- ^ source file
+               -> AnchoredFile a  -- ^ destination dir
+               -> Path Fn         -- ^ destination file name
+               -> IO ()
+unsafeCopyFile _ AFileInvFN _ _ = throw InvalidFileName
+unsafeCopyFile _ _ AFileInvFN _ = throw InvalidFileName
+unsafeCopyFile _ _ _ InvFN      = throw InvalidFileName
+unsafeCopyFile (Rename pn) from@(_ :/ RegFile {}) to@(_ :/ Dir {}) _
+  = copyFile Strict from to pn
+unsafeCopyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
+  = do
+    let to'   = fullPath to P.</> fn
     case cm of
       Strict -> throwFileDoesExist to'
       _      -> return ()
 
-    throwCantOpenDirectory . P.dirname . fullPath $ from
+    catchErrno [eINVAL, eNOSYS]
-    throwCantOpenDirectory . fullPath $ to
+               (sendFileCopy (fullPathS from) (P.fromAbs to'))
-    fromFstatus <- getSymbolicLinkStatus (P.fromAbs from')
+               (void $ fallbackCopy (fullPathS from) (P.fromAbs to'))
-    fromContent <- readFileContents from
+  where
-    bracket (SPI.createFile (P.fromAbs to')
+    -- this is low-level stuff utilizing sendfile(2) for speed
-                $ System.Posix.Files.ByteString.fileMode fromFstatus)
+    -- TODO: preserve permissions
-            SPI.closeFd
+    sendFileCopy source dest =
-            (\fd -> void $ fdWrite fd fromContent)
+      bracket (SPI.openFd source SPI.ReadOnly Nothing SPI.defaultFileFlags)
-copyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
+              SPI.closeFd
+              $ \sfd -> do
+                fileM <- System.Posix.Files.ByteString.fileMode
+                         <$> getFdStatus sfd
+                bracket (SPI.openFd dest SPI.WriteOnly (Just fileM)
+                                    SPI.defaultFileFlags)
+                        SPI.closeFd
+                        $ \dfd -> sendfileFd dfd sfd EntireFile (return ())
+    -- low-level copy operation utilizing read(2)/write(2)
+    -- in case `sendFileCopy` fails/is unsupported
+    fallbackCopy source dest =
+      bracket (SPI.openFd source SPI.ReadOnly Nothing SPI.defaultFileFlags)
+              SPI.closeFd
+              $ \sfd -> do
+                fileM <- System.Posix.Files.ByteString.fileMode
+                         <$> getFdStatus sfd
+                bracket (SPI.openFd dest SPI.WriteOnly (Just fileM)
+                                    SPI.defaultFileFlags)
+                        SPI.closeFd
+                        $ \dfd -> allocaBytes 8192 $ \buf ->
+                                    write' sfd dfd buf 0
+      where
+        write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int
+        write' sfd dfd buf totalsize = do
+            size <- SPB.fdReadBuf sfd buf 8192
+            if (size == 0)
+              then return $ fromIntegral totalsize
+              else do rsize <- SPB.fdWriteBuf dfd buf size
+                      when (rsize /= size) (throw . CopyFailed $ "wrong size!")
+                      write' sfd dfd buf (totalsize + fromIntegral size)
+unsafeCopyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Copies a regular file, directory or symlink. In case of a symlink,
 -- it is just recreated, even if it points to a directory.
 easyCopy :: CopyMode
-         -> AnchoredFile FileInfo
+         -> AnchoredFile a
-         -> AnchoredFile FileInfo
+         -> AnchoredFile a
          -> IO ()
 easyCopy cm from@(_ :/ SymLink{})
               to@(_ :/ Dir{})
@@ -311,7 +391,7 @@ easyCopy _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes a symlink, which can either point to a file or directory.
-deleteSymlink :: AnchoredFile FileInfo -> IO ()
+deleteSymlink :: AnchoredFile a -> IO ()
 deleteSymlink AFileInvFN = throw InvalidFileName
 deleteSymlink f@(_ :/ SymLink {})
   = removeLink (P.toFilePath . fullPath $ f)
@@ -319,7 +399,7 @@ deleteSymlink _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given regular file, never symlinks.
-deleteFile :: AnchoredFile FileInfo -> IO ()
+deleteFile :: AnchoredFile a -> IO ()
 deleteFile AFileInvFN = throw InvalidFileName
 deleteFile f@(_ :/ RegFile {})
   = removeLink (P.toFilePath . fullPath $ f)
@@ -327,7 +407,7 @@ deleteFile _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given directory, never symlinks.
-deleteDir :: AnchoredFile FileInfo -> IO ()
+deleteDir :: AnchoredFile a -> IO ()
 deleteDir AFileInvFN = throw InvalidFileName
 deleteDir f@(_ :/ Dir {})
   = removeDirectory (P.toFilePath . fullPath $ f)
@@ -335,28 +415,35 @@ deleteDir _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Deletes the given directory recursively.
-deleteDirRecursive :: AnchoredFile FileInfo -> IO ()
+deleteDirRecursive :: AnchoredFile a -> IO ()
 deleteDirRecursive AFileInvFN = throw InvalidFileName
-deleteDirRecursive f@(_ :/ Dir {}) = do
+deleteDirRecursive f'@(_ :/ Dir {}) = do
-  let fp = fullPath f
+  let fp = fullPath f'
   throwCantOpenDirectory fp
-  files <- readDirectoryContentsWithFileInfo' fp
+  go f'
-  for_ files $ \file ->
+  where
-    case file of
+    go :: AnchoredFile a -> IO ()
-      (_ :/ SymLink {}) -> deleteSymlink file
+    go f@(_ :/ Dir {}) = do
-      (_ :/ Dir {})     -> deleteDirRecursive file
+      let fp = fullPath f
-      (_ :/ RegFile {}) -> removeLink (P.toFilePath . fullPath $ file)
+      files <- readDirectoryContentsUnsafe getDirsFiles
-      _                 -> throw $ FileDoesExist
+                 (\_ -> return undefined) fp
-                                   (P.fpToString . P.toFilePath . fullPath
+      for_ files $ \file ->
-                                                 $ file)
+        case file of
-  removeDirectory . P.toFilePath $ fp
+          (_ :/ SymLink {}) -> deleteSymlink file
+          (_ :/ Dir {})     -> go file
+          (_ :/ RegFile {}) -> removeLink (P.toFilePath . fullPath $ file)
+          _                 -> throw $ FileDoesExist
+                                       (P.fpToString . P.toFilePath . fullPath
+                                                     $ file)
+      removeDirectory . P.toFilePath $ fp
+    go _ = throw $ InvalidOperation "wrong input type"
 deleteDirRecursive _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |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.
-easyDelete :: AnchoredFile FileInfo -> IO ()
+easyDelete :: AnchoredFile a -> IO ()
 easyDelete f@(_ :/ SymLink {}) = deleteSymlink f
 easyDelete f@(_ :/ RegFile {})
   = deleteFile f
@@ -382,8 +469,8 @@ openFile f =
 
 
 -- |Executes a program with the given arguments.
-executeFile :: AnchoredFile FileInfo  -- ^ program
+executeFile :: AnchoredFile a  -- ^ program
-            -> [ByteString]           -- ^ arguments
+            -> [ByteString]    -- ^ arguments
             -> IO ProcessID
 executeFile AFileInvFN _ = throw InvalidFileName
 executeFile prog@(_ :/ RegFile {}) args
@@ -431,7 +518,7 @@ createDir _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Rename a given file with the provided filename.
-renameFile :: AnchoredFile FileInfo -> Path Fn -> IO ()
+renameFile :: AnchoredFile a -> Path Fn -> IO ()
 renameFile AFileInvFN _ = throw InvalidFileName
 renameFile _ InvFN      = throw InvalidFileName
 renameFile af (ValFN fn) = do
@@ -445,9 +532,9 @@ renameFile _ _ = throw $ InvalidOperation "wrong input type"
 
 -- |Move a given file to the given target directory.
 moveFile :: CopyMode
-         -> AnchoredFile FileInfo -- ^ file to move
+         -> AnchoredFile a -- ^ file to move
-         -> AnchoredFile FileInfo -- ^ base target directory
+         -> AnchoredFile a -- ^ base target directory
-         -> Path Fn               -- ^ target file name
+         -> Path Fn        -- ^ target file name
          -> IO ()
 moveFile _ AFileInvFN _ _ = throw InvalidFileName
 moveFile _ _ AFileInvFN _ = throw InvalidFileName
@@ -464,20 +551,20 @@ moveFile cm from to@(_ :/ Dir {}) fn = do
     Replace  -> delOld to'
     Rename _ -> throw $ InvalidOperation "Internal error! Wrong CopyMode!"
   throwSameFile from' to'
-  catchErrno eXDEV (rename froms' tos') $ do
+  catchErrno [eXDEV] (rename froms' tos') $ do
     easyCopy Strict from to
     easyDelete from
   where
     delOld fp = do
-      to' <- HSFM.FileSystem.FileType.readFileWithFileInfo fp
+      to' <- readFileUnsafe (\_ -> return undefined) fp
       unless (failed . file $ to') (easyDelete to')
 moveFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |Like `moveFile` except it uses the filename of the source as target.
 easyMove :: CopyMode
-         -> AnchoredFile FileInfo -- ^ file to move
+         -> AnchoredFile a -- ^ file to move
-         -> AnchoredFile FileInfo -- ^ base target directory
+         -> AnchoredFile a -- ^ base target directory
          -> IO ()
 easyMove cm from to = moveFile cm from to (name . file $ from)
 

src/HSFM/FileSystem/FileType.hs

@@ -392,15 +392,22 @@ readFile :: (Path Abs -> IO a)  -- ^ function that fills the free
          -> Path Abs            -- ^ Path to read
          -> IO (AnchoredFile a)
 readFile ff p = do
+  cdp <- P.canonicalizePath (P.dirname p)
+  readFileUnsafe ff (cdp P.</> P.basename p)
+
+
+readFileUnsafe :: (Path Abs -> IO a)
+               -> Path Abs
+               -> IO (AnchoredFile a)
+readFileUnsafe ff p = do
   let fn = P.basename p
       bd = P.dirname p
       p' = P.toFilePath p
-  bd' <- P.canonicalizePath bd
+  handleDT bd fn $ do
-  handleDT bd' fn $ do
     fs   <- PF.getSymbolicLinkStatus p'
     fv   <- ff p
-    file <- constructFile fs fv bd' fn
+    file <- constructFile fs fv bd fn
-    return (bd' :/ file)
+    return (bd :/ file)
   where
     constructFile fs fv bd' fn'
       | PF.isSymbolicLink    fs = do
@@ -442,6 +449,16 @@ readDirectoryContents getfiles ff p = do
   return $ removeNonexistent fcs
 
 
+readDirectoryContentsUnsafe :: (Path Abs -> IO [Path Fn])
+                            -> (Path Abs -> IO a)
+                            -> Path Abs
+                            -> IO [AnchoredFile a]
+readDirectoryContentsUnsafe getfiles ff p = do
+  files <- getfiles p
+  fcs <- mapM (\x -> readFileUnsafe ff $ p P.</> x) files
+  return $ removeNonexistent fcs
+
+
 -- |Build a list of AnchoredFile, given the path to a directory, filling
 -- the free variables via `getFileInfo`. This includes the "." and ".."
 -- directories.
@@ -544,6 +561,7 @@ comparingConstr t t'  = compare (name t) (name t')
 
 -- |Reads a file and returns the content as a ByteString.
 -- Follows symbolic links.
+-- TODO: maybe make this lazy?! The strict form will likely blow up memory
 readFileContents :: AnchoredFile a -> IO ByteString
 readFileContents af@(_ :/ RegFile{}) =
     bracket (PIO.openFd f PIO.ReadOnly Nothing PIO.defaultFileFlags)
@@ -612,7 +630,7 @@ getDirsFiles' :: (Path Fn -> [Path Fn] -> [Path Fn]) -- ^ filter function
               -> Path Abs                            -- ^ dir to read
               -> IO [Path Fn]
 getDirsFiles' filterf fp =
-  rethrowErrnoAs eACCES (Can'tOpenDirectory . P.fpToString . P.fromAbs $ fp)
+  rethrowErrnoAs [eACCES] (Can'tOpenDirectory . P.fpToString . P.fromAbs $ fp)
   $ bracket (PFD.openDirStream . P.toFilePath $ fp)
           PFD.closeDirStream
           $ \dirstream ->

src/HSFM/GUI/Gtk/Data.hs

@@ -101,7 +101,7 @@ data MyView = MkMyView {
   , rawModel        :: TVar (ListStore Item)
   , sortedModel     :: TVar (TypedTreeModelSort Item)
   , filteredModel   :: TVar (TypedTreeModelFilter Item)
-  , operationBuffer :: TVar FileOperation
+  , operationBuffer :: TVar (FileOperation FileInfo)
   , inotify         :: MVar INotify
 }