LIB: various cleanups

src/HSFM/FileSystem/Errors.hs

@@ -158,14 +158,19 @@ doesDirectoryExist fp =
     return $ PF.isDirectory fs
 
 
+-- |Checks whether the directory at the given path exists and can be
+-- opened. This invokes `openDirStream`.
 canOpenDirectory :: Path Abs -> IO Bool
 canOpenDirectory fp =
   handleIOError (\_ -> return False) $ do
-    dirstream <- PFD.openDirStream . P.fromAbs $ fp
+    bracket (PFD.openDirStream . P.fromAbs $ fp)
-    PFD.closeDirStream dirstream
+            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)
@@ -194,6 +199,7 @@ catchErrno en a1 a2 =
       else ioError e
 
 
+-- |Like `catchIOError`, with arguments swapped.
 handleIOError :: (IOError -> IO a) -> IO a -> IO a
 handleIOError a1 a2 = catchIOError a2 a1
 

src/HSFM/FileSystem/FileOperations.hs

@@ -32,12 +32,13 @@ module HSFM.FileSystem.FileOperations where
 
 import Control.Exception
   (
-    throw
+    bracket
-  , onException
+  , throw
   )
 import Control.Monad
   (
     unless
+  , void
   )
 import Data.ByteString
   (
@@ -185,7 +186,7 @@ copyDir cm from@(_ :/ Dir _ FileInfo{ fileMode = fmode })
     createDestdir destdirp fmode
     destdir <- HSFM.FileSystem.FileType.readFileWithFileInfo destdirp
 
-    contents <- readDirectoryContents' (fullPath from)
+    contents <- readDirectoryContentsWithFileInfo' (fullPath from)
 
     for_ contents $ \f ->
       case f of
@@ -240,9 +241,7 @@ recreateSymlink _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
 -- |TODO: handle EAGAIN exception for non-blocking IO
--- TODO: implement for non-regular file? This would deprecate the logic
+-- |Copies the given regular file to the given dir with the given filename.
---       in copyDir
--- |Copies the given file to the given dir with the given filename.
 -- Excludes symlinks.
 copyFile :: CopyMode
          -> AnchoredFile FileInfo  -- ^ source file
@@ -265,16 +264,16 @@ copyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
     throwCantOpenDirectory . fullPath $ to
     fromFstatus <- getSymbolicLinkStatus (P.fromAbs from')
     fromContent <- readFileContents from
-    fd          <- SPI.createFile (P.fromAbs to')
+    bracket (SPI.createFile (P.fromAbs to')
-                     (System.Posix.Files.ByteString.fileMode fromFstatus)
+                $ System.Posix.Files.ByteString.fileMode fromFstatus)
-    _ <- onException (fdWrite fd fromContent) (SPI.closeFd fd)
+            SPI.closeFd
-    SPI.closeFd fd
+            (\fd -> void $ fdWrite fd fromContent)
 
 copyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
--- |Copies a file, directory or symlink. In case of a symlink, it is just
+-- |Copies a regular file, directory or symlink. In case of a symlink,
--- recreated, even if it points to a directory.
+-- it is just recreated, even if it points to a directory.
 easyCopy :: CopyMode
          -> AnchoredFile FileInfo
          -> AnchoredFile FileInfo
@@ -307,7 +306,7 @@ deleteSymlink f@(_ :/ SymLink {})
 deleteSymlink _ = throw $ InvalidOperation "wrong input type"
 
 
--- |Deletes the given file, never symlinks.
+-- |Deletes the given regular file, never symlinks.
 deleteFile :: AnchoredFile FileInfo -> IO ()
 deleteFile AFileInvFN = throw InvalidFileName
 deleteFile f@(_ :/ RegFile {})
@@ -329,7 +328,7 @@ deleteDirRecursive AFileInvFN = throw InvalidFileName
 deleteDirRecursive f@(_ :/ Dir {}) = do
   let fp = fullPath f
   throwCantOpenDirectory fp
-  files <- readDirectoryContents' fp
+  files <- readDirectoryContentsWithFileInfo' fp
   for_ files $ \file ->
     case file of
       (_ :/ SymLink {}) -> deleteSymlink file
@@ -361,7 +360,8 @@ easyDelete _ = throw $ InvalidOperation "wrong input type"
     --------------------
 
 
--- |Opens a file appropriately by invoking xdg-open.
+-- |Opens a file appropriately by invoking xdg-open. The file type
+-- is not checked.
 openFile :: AnchoredFile a
          -> IO ProcessID
 openFile AFileInvFN = throw InvalidFileName
@@ -376,6 +376,8 @@ executeFile :: AnchoredFile FileInfo  -- ^ program
 executeFile AFileInvFN _ = throw InvalidFileName
 executeFile prog@(_ :/ RegFile {}) args
   = SPP.forkProcess $ SPP.executeFile (fullPathS prog) True args Nothing
+executeFile prog@(_ :/ SymLink { sdest = (_ :/ RegFile {}) }) args
+  = SPP.forkProcess $ SPP.executeFile (fullPathS prog) True args Nothing
 executeFile _ _ = throw $ InvalidOperation "wrong input type"
 
 
@@ -386,6 +388,7 @@ executeFile _ _ = throw $ InvalidOperation "wrong input type"
     ---------------------
 
 
+-- |Create an empty regular file at the given directory with the given filename.
 createFile :: AnchoredFile FileInfo -> Path Fn -> IO ()
 createFile AFileInvFN _ = throw InvalidFileName
 createFile _ InvFN      = throw InvalidFileName
@@ -397,6 +400,7 @@ createFile (ADirOrSym td) (ValFN fn) = do
 createFile _ _ = throw $ InvalidOperation "wrong input type"
 
 
+-- |Create an empty directory at the given directory with the given filename.
 createDir :: AnchoredFile FileInfo -> Path Fn -> IO ()
 createDir AFileInvFN _ = throw InvalidFileName
 createDir _ InvFN      = throw InvalidFileName
@@ -414,6 +418,7 @@ createDir _ _ = throw $ InvalidOperation "wrong input type"
     ----------------------------
 
 
+-- |Rename a given file with the provided filename.
 renameFile :: AnchoredFile FileInfo -> Path Fn -> IO ()
 renameFile AFileInvFN _ = throw InvalidFileName
 renameFile _ InvFN      = throw InvalidFileName
@@ -461,6 +466,7 @@ moveFile _ _ _ = throw $ InvalidOperation "wrong input type"
     -----------------------
 
 
+-- |Default permissions for a new file.
 newFilePerms :: FileMode
 newFilePerms
   =                  ownerWriteMode
@@ -471,6 +477,7 @@ newFilePerms
     `unionFileModes` otherReadMode
 
 
+-- |Default permissions for a new directory.
 newDirPerms :: FileMode
 newDirPerms
   =                  ownerModes
@@ -478,3 +485,4 @@ newDirPerms
     `unionFileModes` groupReadMode
     `unionFileModes` otherExecuteMode
     `unionFileModes` otherReadMode
+

src/HSFM/FileSystem/FileType.hs

@@ -21,7 +21,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 -- |This module provides data types for representing directories/files
--- and related operations on it, mostly internal stuff, not actual IO actions.
+-- and related operations on it, mostly internal stuff.
 --
 -- It doesn't allow to represent the whole filesystem, since that's only
 -- possible through IO laziness, which introduces too much internal state.
@@ -44,6 +44,7 @@ import Control.Monad.State.Lazy
 
   )
 import Data.ByteString(ByteString)
+import qualified Data.ByteString as B
 import Data.Default
 import Data.Time.Clock.POSIX
   (
@@ -60,11 +61,16 @@ import HPath
     )
 import qualified HPath as P
 import HSFM.Utils.MyPrelude
+import Prelude hiding(readFile)
 import System.IO.Error
   (
     ioeGetErrorType
   , isDoesNotExistErrorType
   )
+import qualified System.Posix.Directory.ByteString as PFD
+import qualified System.Posix.Files.ByteString as PF
+import qualified "unix" System.Posix.IO.ByteString as PIO
+import qualified "unix-bytestring" System.Posix.IO.ByteString as PIOB
 import System.Posix.Types
   (
     DeviceID
@@ -77,11 +83,6 @@ import System.Posix.Types
   , UserID
   )
 
-import qualified Data.ByteString as B
-import qualified System.Posix.Directory.ByteString as PFD
-import qualified System.Posix.Files.ByteString as PF
-import qualified "unix" System.Posix.IO.ByteString as PIO
-import qualified "unix-bytestring" System.Posix.IO.ByteString as PIOB
 
 
 
@@ -117,7 +118,6 @@ data File a =
     name :: Path Fn
   , fvar :: a
   }
-  -- TODO: add raw symlink dest (not normalized) to SymLink?
   | SymLink {
     name    :: Path Fn
   , fvar    :: a
@@ -143,7 +143,7 @@ data File a =
   } deriving (Show, Eq)
 
 
--- |All possible file information we could ever need.
+-- |Low-level file information.
 data FileInfo = FileInfo {
     deviceID :: DeviceID
   , fileID :: FileID
@@ -383,11 +383,11 @@ instance Ord (AnchoredFile FileInfo) where
 -- anchor of `AnchoredFile` is always canonicalized.
 --
 -- Exceptions: when `canonicalizePath` fails, throws IOError
-readWith :: (Path Abs -> IO a)  -- ^ function that fills the free
+readFile :: (Path Abs -> IO a)  -- ^ function that fills the free
                                 --   a variable
          -> Path Abs            -- ^ Path to read
          -> IO (AnchoredFile a)
-readWith ff p = do
+readFile ff p = do
   let fn = P.basename p
       bd = P.dirname p
       p' = P.toFilePath p
@@ -410,7 +410,7 @@ readWith ff p = do
             -- to something like '/' after normalization?
             let sfp = (P.fromAbs bd') `P.combine` x
             rsfp <- P.realPath sfp
-            readWith ff =<< P.parseAbs rsfp
+            readFile ff =<< P.parseAbs rsfp
           return $ SymLink fn' fv resolvedSyml x
       | PF.isDirectory       fs = return $ Dir       fn' fv
       | PF.isRegularFile     fs = return $ RegFile   fn' fv
@@ -421,40 +421,63 @@ readWith ff p = do
       | otherwise               = return $ Failed    fn' (userError
                                                           "Unknown filetype!")
 
-
+-- |Reads a file via `readFile` and fills the free variable via `getFileInfo`.
--- |Reads a file Path into an AnchoredFile.
-readFile :: (Path Abs -> IO a) -> Path Abs -> IO (AnchoredFile a)
-readFile ff fp = readWith ff fp
-
 readFileWithFileInfo :: Path Abs -> IO (AnchoredFile FileInfo)
-readFileWithFileInfo = HSFM.FileSystem.FileType.readFile getFileInfo
+readFileWithFileInfo = readFile getFileInfo
+
+
+-- |Same as readDirectoryContents but allows us to, for example, use
+-- ByteString.readFile to return a tree of ByteStrings.
+readDirectoryContents :: (Path Abs -> IO [Path Fn])
+                      -> (Path Abs -> IO a)
+                      -> Path Abs
+                      -> IO [AnchoredFile a]
+readDirectoryContents getfiles ff p = do
+  files <- getfiles p
+  fcs <- mapM (\x -> readFile 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.
-readDirectoryContents :: Path Abs -> IO [AnchoredFile FileInfo]
+readDirectoryContentsWithFileInfo :: Path Abs -> IO [AnchoredFile FileInfo]
-readDirectoryContents fp = readDirectoryContentsWith getAllDirsFiles getFileInfo fp
+readDirectoryContentsWithFileInfo fp
+  = readDirectoryContents getAllDirsFiles getFileInfo fp
 
 
 -- |Build a list of AnchoredFile, given the path to a directory, filling
 -- the free variables via `getFileInfo`. This excludes the "." and ".."
 -- directories.
-readDirectoryContents' :: Path Abs -> IO [AnchoredFile FileInfo]
+readDirectoryContentsWithFileInfo' :: Path Abs -> IO [AnchoredFile FileInfo]
-readDirectoryContents' fp = readDirectoryContentsWith getDirsFiles getFileInfo fp
+readDirectoryContentsWithFileInfo' fp
+  = readDirectoryContents getDirsFiles getFileInfo fp
 
 
--- |Same as readDirectoryContents but allows us to, for example, use
+-- |Get the contents of a directory, including "." and "..".
--- ByteString.readFile to return a tree of ByteStrings.
+getContents :: AnchoredFile FileInfo
-readDirectoryContentsWith :: (Path Abs -> IO [Path Fn])
+            -> IO [AnchoredFile FileInfo]
-                          -> (Path Abs -> IO a)
+getContents (ADirOrSym af) = readDirectoryContentsWithFileInfo (fullPath af)
-                          -> Path Abs
+getContents _              = return []
-                          -> IO [AnchoredFile a]
-readDirectoryContentsWith getfiles ff p = do
-  files <- getfiles p
-  fcs <- mapM (\x -> HSFM.FileSystem.FileType.readFile ff $ p P.</> x) files
-  return $ removeNonexistent fcs
 
 
+-- |Get the contents of a directory, including "." and "..".
+getContents' :: AnchoredFile FileInfo
+             -> IO [AnchoredFile FileInfo]
+getContents' (ADirOrSym af) = readDirectoryContentsWithFileInfo' (fullPath af)
+getContents' _              = return []
+
+
+-- |Go up one directory in the filesystem hierarchy.
+goUp :: AnchoredFile FileInfo -> IO (AnchoredFile FileInfo)
+goUp af@(Path "" :/ _) = return af
+goUp    (bp      :/ _) = readFile getFileInfo bp
+
+
+-- |Go up one directory in the filesystem hierarchy.
+goUp' :: Path Abs -> IO (AnchoredFile FileInfo)
+goUp' fp = readFile getFileInfo $ P.dirname fp
+
 
 
 
@@ -467,22 +490,22 @@ readDirectoryContentsWith getfiles ff p = do
 ---- HANDLING FAILURES ----
 
 
--- | True if any Failed constructors in the tree
+-- |True if any Failed constructors in the tree.
 anyFailed :: [File a] -> Bool
 anyFailed = not . successful
 
--- | True if there are no Failed constructors in the tree
+-- |True if there are no Failed constructors in the tree.
 successful :: [File a] -> Bool
 successful = null . failures
 
 
--- | returns true if argument is a `Failed` constructor:
+-- |Returns true if argument is a `Failed` constructor.
 failed :: File a -> Bool
 failed (Failed _ _) = True
 failed _            = False
 
 
--- | returns a list of 'Failed' constructors only:
+-- |Returns a list of 'Failed' constructors only.
 failures :: [File a] -> [File a]
 failures = filter failed
 
@@ -515,14 +538,15 @@ comparingConstr t t'  = compare (name t) (name t')
     ---------------------------
 
 
--- |Follows symbolic links.
+-- |Reads a file and returns the content as a ByteString.
+-- Follows symbolic links.
 readFileContents :: AnchoredFile a -> IO ByteString
 readFileContents af@(_ :/ RegFile{}) =
     bracket (PIO.openFd f PIO.ReadOnly Nothing PIO.defaultFileFlags)
             PIO.closeFd
-    $ \fd -> do
+            $ \fd -> do
-      filesz   <- fmap PF.fileSize $ PF.getFdStatus fd
+              filesz   <- fmap PF.fileSize $ PF.getFdStatus fd
-      PIOB.fdRead fd ((fromIntegral filesz `max` 0) + 1)
+              PIOB.fdRead fd ((fromIntegral filesz `max` 0) + 1)
   where
     f = fullPathS af
 readFileContents _ = return B.empty
@@ -562,7 +586,6 @@ isCharC (CharDev _ _) = True
 isCharC _             = False
 
 
-
 isNamedC :: File a -> Bool
 isNamedC (NamedPipe _ _) = True
 isNamedC _               = False
@@ -578,44 +601,29 @@ isSocketC _            = False
 ---- IO HELPERS: ----
 
 
--- |Go up one directory in the filesystem hierarchy.
+-- |Gets all filenames of the given directory.
-goUp :: AnchoredFile FileInfo -> IO (AnchoredFile FileInfo)
+-- The first argument is a filter function that allows to exclude
-goUp af@(Path "" :/ _) = return af
+-- filenames from the result.
-goUp    (bp :/ _)      = HSFM.FileSystem.FileType.readFile getFileInfo bp
+getDirsFiles' :: (Path Fn -> [Path Fn] -> [Path Fn]) -- ^ filter function
-
+              -> Path Abs                            -- ^ dir to read
-
--- |Go up one directory in the filesystem hierarchy.
-goUp' :: Path Abs -> IO (AnchoredFile FileInfo)
-goUp' fp = HSFM.FileSystem.FileType.readFile getFileInfo $ P.dirname fp
-
-
--- |Get the contents of a directory.
-getContents :: AnchoredFile FileInfo
-            -> IO [AnchoredFile FileInfo]
-getContents (ADirOrSym af) = readDirectoryContents (fullPath af)
-getContents _              = return []
-
-
-getDirsFiles' :: (Path Fn -> [Path Fn] -> [Path Fn])
-              -> Path Abs
               -> IO [Path Fn]
-getDirsFiles' filterf fp = do
+getDirsFiles' filterf fp =
-  dirstream <- PFD.openDirStream . P.toFilePath $ fp
+  bracket (PFD.openDirStream . P.toFilePath $ fp)
-  let mdirs :: [Path Fn] -> IO [Path Fn]
+          PFD.closeDirStream
-      mdirs dirs = do
+          $ \dirstream ->
-        -- make sure we close the directory stream in case of errors
+            let mdirs :: [Path Fn] -> IO [Path Fn]
-        -- TODO: more explicit error handling?
+                mdirs dirs = do
-        --       both the parsing and readin the stream can fail!
+                  -- make sure we close the directory stream in case of errors
-        dir <- onException (PFD.readDirStream dirstream)
+                  -- TODO: more explicit error handling?
-                           (PFD.closeDirStream dirstream)
+                  --       both the parsing and readin the stream can fail!
-        case dir of
+                  dir <- onException (PFD.readDirStream dirstream)
-          "" -> return dirs
+                                     (PFD.closeDirStream dirstream)
-          _  -> do
+                  case dir of
-                  pdir <- P.parseFn dir
+                    "" -> return dirs
-                  mdirs $ pdir `filterf` dirs
+                    _  -> do
-  dirs <- mdirs []
+                            pdir <- P.parseFn dir
-  PFD.closeDirStream dirstream
+                            mdirs $ pdir `filterf` dirs
-  return dirs
+            in mdirs []
 
 
 -- |Get all files of a given directory and return them as a List.
@@ -772,3 +780,4 @@ packPermissions dt = fromFreeVar (pStr . fileMode) dt
           | hasFM fm  = str
           | otherwise = "-"
         hasFM fm = ffm `PF.intersectFileModes` fm == fm
+

src/HSFM/Utils/IO.hs

@@ -1,6 +1,6 @@
 {--
 HSFM, a filemanager written in Haskell.
-Copyright (C) 2015 Julian Ospald
+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
@@ -18,6 +18,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
+
 -- |Random and general IO utilities.
 module HSFM.Utils.IO where
 
@@ -39,17 +40,23 @@ import Control.Monad
   )
 
 
+-- |Atomically write a TVar.
 writeTVarIO :: TVar a -> a -> IO ()
 writeTVarIO tvar val = atomically $ writeTVar tvar val
 
 
+-- |Atomically modify a TVar.
 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)

src/HSFM/Utils/MyPrelude.hs

@@ -1,6 +1,6 @@
 {--
 HSFM, a filemanager written in Haskell.
-Copyright (C) 2015 Julian Ospald
+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
@@ -24,6 +24,9 @@ import Data.List
 
 
 
+-- |Turns any list into a list of the same length with the values
+-- being the indices.
+-- E.g.: "abdasd" -> [0,1,2,3,4,5]
 listIndices :: [a] -> [Int]
 listIndices = findIndices (const True)