hpath 0.8.1 → 0.9.0

raw patch · 10 files changed

+592/−142 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +3/−0
• hpath.cabal +8/−3
• src/HPath/IO.hs +114/−94
• src/HPath/IO.hs-boot +2/−1
• src/HPath/IO/Errors.hs +48/−44
• test/HPath/IO/AppendFileSpec.hs +109/−0
• test/HPath/IO/ReadFileEOFSpec.hs +86/−0
• test/HPath/IO/ReadFileSpec.hs +86/−0
• test/HPath/IO/ToAbsSpec.hs +27/−0
• test/HPath/IO/WriteFileSpec.hs +109/−0

@@ -1,3 +1,6 @@+0.9.0+	* don't force "Path Abs" anymore in IO module, abstract more over Path types+	* add 'toAbs' 0.8.1 	* add 'readFile', 'readFileEOF', 'writeFile' and 'appendFile' 0.8.0

@@ -1,5 +1,5 @@ name:                hpath-version:             0.8.1+version:             0.9.0 synopsis:            Support for well-typed paths description:         Support for well-typed paths, utilizing ByteString under the hood. license:             BSD3@@ -9,7 +9,7 @@ copyright:           Julian Ospald 2016 category:            Filesystem build-type:          Simple-cabal-version:       >=1.14+cabal-version:       1.14 extra-source-files:  README.md                      CHANGELOG                      cbits/dirutils.h@@ -75,14 +75,15 @@   Hs-Source-Dirs:       test   Main-Is:              Main.hs   other-modules:+                        HPath.IO.AppendFileSpec                         HPath.IO.CanonicalizePathSpec                         HPath.IO.CopyDirRecursiveCollectFailuresSpec                         HPath.IO.CopyDirRecursiveOverwriteSpec                         HPath.IO.CopyDirRecursiveSpec                         HPath.IO.CopyFileOverwriteSpec                         HPath.IO.CopyFileSpec-                        HPath.IO.CreateDirSpec                         HPath.IO.CreateDirRecursiveSpec+                        HPath.IO.CreateDirSpec                         HPath.IO.CreateRegularFileSpec                         HPath.IO.CreateSymlinkSpec                         HPath.IO.DeleteDirRecursiveSpec@@ -92,9 +93,13 @@                         HPath.IO.GetFileTypeSpec                         HPath.IO.MoveFileOverwriteSpec                         HPath.IO.MoveFileSpec+                        HPath.IO.ReadFileEOFSpec+                        HPath.IO.ReadFileSpec                         HPath.IO.RecreateSymlinkOverwriteSpec                         HPath.IO.RecreateSymlinkSpec                         HPath.IO.RenameFileSpec+                        HPath.IO.ToAbsSpec+                        HPath.IO.WriteFileSpec                         Spec                         Utils   GHC-Options:          -Wall

@@ -8,8 +8,11 @@ -- Portability :  portable -- -- 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.+-- copy, delete, move and so on. It only operates on /Path x/ which+-- guarantees us well-typed paths. Passing in /Path Abs/ to any+-- of these functions generally increases safety. Passing /Path Rel/+-- may trigger looking up the current directory via `getcwd` in some+-- cases where it cannot be avoided. -- -- Some functions are just path-safe wrappers around -- unix functions, others have stricter exception handling@@ -75,6 +78,7 @@   , getFileType   -- * Others   , canonicalizePath+  , toAbs   )   where @@ -184,6 +188,7 @@ import System.Posix.Directory.ByteString   (     createDirectory+  , getWorkingDirectory   , removeDirectory   ) import System.Posix.Directory.Traversals@@ -326,9 +331,9 @@ -- Throws in `Strict` CopyMode only: -- --    - `AlreadyExists` if destination already exists-copyDirRecursive :: Path Abs  -- ^ source dir-                 -> Path Abs  -- ^ destination (parent dirs-                              --   are not automatically created)+copyDirRecursive :: Path b1  -- ^ source dir+                 -> Path b2  -- ^ destination (parent dirs+                             --   are not automatically created)                  -> CopyMode                  -> RecursiveErrorMode                  -> IO ()@@ -344,27 +349,27 @@            (throwIO . RecursiveFailure $ collectedExceptions)   where     go :: IORef [(RecursiveFailureHint, IOException)]-       -> Path Abs -> Path Abs -> IO ()-    go ce fromp' destdirp' = do+       -> Path b1 -> Path b2 -> IO ()+    go ce fromp'@(MkPath fromBS) destdirp'@(MkPath destdirpBS) = do        -- NOTE: order is important here, so we don't get empty directories       -- on failure        -- get the contents of the source dir-      contents <- handleIOE (ReadContentsFailed fromp' destdirp') ce [] $ do+      contents <- handleIOE (ReadContentsFailed fromBS destdirpBS) ce [] $ do         contents <- getDirsFiles fromp'          -- create the destination dir and         -- only return contents if we succeed-        handleIOE (CreateDirFailed fromp' destdirp') ce [] $ do-          fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')+        handleIOE (CreateDirFailed fromBS destdirpBS) ce [] $ do+          fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus fromBS           case cm of-            Strict    -> createDirectory (fromAbs destdirp') fmode'-            Overwrite -> catchIOError (createDirectory (fromAbs destdirp')+            Strict    -> createDirectory destdirpBS fmode'+            Overwrite -> catchIOError (createDirectory destdirpBS                                                        fmode')                            $ \e ->                              case ioeGetErrorType e of-                               AlreadyExists -> setFileMode (fromAbs destdirp')+                               AlreadyExists -> setFileMode destdirpBS                                                             fmode'                                _             -> ioError e           return contents@@ -378,10 +383,10 @@         ftype <- getFileType f         newdest <- (destdirp' </>) <$> basename f         case ftype of-          SymbolicLink -> handleIOE (RecreateSymlinkFailed f newdest) ce ()+          SymbolicLink -> handleIOE (RecreateSymlinkFailed (toFilePath f) (toFilePath newdest)) ce ()                             $ recreateSymlink f newdest cm           Directory    -> go ce f newdest-          RegularFile  -> handleIOE (CopyFileFailed f newdest) ce ()+          RegularFile  -> handleIOE (CopyFileFailed (toFilePath f) (toFilePath newdest)) ce ()                             $ copyFile f newdest cm           _            -> return () @@ -422,23 +427,23 @@ --    - `UnsatisfiedConstraints` if destination file is non-empty directory -- -- Note: calls `symlink`-recreateSymlink :: Path Abs  -- ^ the old symlink file-                -> Path Abs  -- ^ destination file+recreateSymlink :: Path b1   -- ^ the old symlink file+                -> Path b2   -- ^ destination file                 -> CopyMode                 -> IO ()-recreateSymlink symsource newsym cm+recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm   = do     throwSameFile symsource newsym-    sympoint <- readSymbolicLink (fromAbs symsource)+    sympoint <- readSymbolicLink symsourceBS     case cm of       Strict -> return ()       Overwrite -> do-        writable <- isWritable (dirname newsym)+        writable <- toAbs newsym >>= isWritable         isfile   <- doesFileExist newsym         isdir    <- doesDirectoryExist newsym         when (writable && isfile) (deleteFile newsym)         when (writable && isdir)  (deleteDir newsym)-    createSymbolicLink sympoint (fromAbs newsym)+    createSymbolicLink sympoint newsymBS   -- |Copies the given regular file to the given destination.@@ -476,8 +481,8 @@ --    - `AlreadyExists` if destination already exists -- -- Note: calls `sendfile` and possibly `read`/`write` as fallback-copyFile :: Path Abs  -- ^ source file-         -> Path Abs  -- ^ destination file+copyFile :: Path b1   -- ^ source file+         -> Path b2   -- ^ destination file          -> CopyMode          -> IO () copyFile from to cm = do@@ -496,8 +501,8 @@           -- figure out if we can still copy by deleting it first           PermissionDenied -> do             exists   <- doesFileExist to-            writable <- isWritable (dirname to)-            if exists && writable+            writable <- toAbs to >>= isWritable+            if (exists && writable)               then deleteFile to >> copyFile from to Strict               else ioError e           _ -> ioError e@@ -505,18 +510,17 @@  _copyFile :: [SPDF.Flags]           -> [SPDF.Flags]-          -> Path Abs  -- ^ source file-          -> Path Abs  -- ^ destination file+          -> Path b1  -- ^ source file+          -> Path b2  -- ^ destination file           -> IO ()-_copyFile sflags dflags from to+_copyFile sflags dflags (MkPath fromBS) to@(MkPath toBS)   =     -- 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.-    withAbsPath to $ \to' -> withAbsPath from $ \from' ->-      catchErrno [eINVAL, eNOSYS]-                 (sendFileCopy from' to')-                 (void $ readWriteCopy from' to')+    catchErrno [eINVAL, eNOSYS]+               (sendFileCopy fromBS toBS)+               (void $ readWriteCopy fromBS toBS)   where     copyWith copyAction source dest =       bracket (openFd source SPI.ReadOnly sflags Nothing)@@ -561,8 +565,8 @@ -- --    * examines filetypes explicitly --    * calls `copyDirRecursive` for directories-easyCopy :: Path Abs-         -> Path Abs+easyCopy :: Path b1+         -> Path b2          -> CopyMode          -> RecursiveErrorMode          -> IO ()@@ -591,8 +595,8 @@ --    - `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 = withAbsPath p removeLink+deleteFile :: Path b -> IO ()+deleteFile (MkPath p) = removeLink p   -- |Deletes the given directory, which must be empty, never symlinks.@@ -606,8 +610,8 @@ --    - `PermissionDenied` if we can't open or write to parent directory -- -- Notes: calls `rmdir`-deleteDir :: Path Abs -> IO ()-deleteDir p = withAbsPath p removeDirectory+deleteDir :: Path b -> IO ()+deleteDir (MkPath p) = removeDirectory p   -- |Deletes the given directory recursively. Does not follow symbolic@@ -629,7 +633,7 @@ --    - `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 :: Path b -> IO () deleteDirRecursive p =   catchErrno [eNOTEMPTY, eEXIST]              (deleteDir p)@@ -654,7 +658,7 @@ -- --    * examines filetypes explicitly --    * calls `deleteDirRecursive` for directories-easyDelete :: Path Abs -> IO ()+easyDelete :: Path b -> IO () easyDelete p = do   ftype <- getFileType p   case ftype of@@ -673,21 +677,18 @@  -- |Opens a file appropriately by invoking xdg-open. The file type -- is not checked. This forks a process.-openFile :: Path Abs+openFile :: Path b          -> IO ProcessID-openFile p =-  withAbsPath p $ \fp ->-    SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing+openFile (MkPath fp) =+  SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing   -- |Executes a program with the given arguments. This forks a process.-executeFile :: Path Abs        -- ^ program+executeFile :: Path b          -- ^ program             -> [ByteString]    -- ^ arguments             -> IO ProcessID-executeFile fp args-  = withAbsPath fp $ \fpb ->-      SPP.forkProcess-      $ SPP.executeFile fpb True args Nothing+executeFile (MkPath fp) args =+  SPP.forkProcess $ SPP.executeFile fp True args Nothing   @@ -706,9 +707,9 @@ --    - `AlreadyExists` if destination already exists --    - `NoSuchThing` if any of the parent components of the path --      do not exist-createRegularFile :: FileMode -> Path Abs -> IO ()-createRegularFile fm dest =-  bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just fm)+createRegularFile :: FileMode -> Path b -> IO ()+createRegularFile fm (MkPath destBS) =+  bracket (SPI.openFd destBS SPI.WriteOnly (Just fm)                       (SPI.defaultFileFlags { exclusive = True }))           SPI.closeFd           (\_ -> return ())@@ -722,8 +723,8 @@ --    - `AlreadyExists` if destination already exists --    - `NoSuchThing` if any of the parent components of the path --      do not exist-createDir :: FileMode -> Path Abs -> IO ()-createDir fm dest = createDirectory (fromAbs dest) fm+createDir :: FileMode -> Path b -> IO ()+createDir fm (MkPath destBS) = createDirectory destBS fm   -- |Create an empty directory at the given directory with the given filename.@@ -744,15 +745,19 @@ --      exist and cannot be written to --    - `AlreadyExists` if destination already exists and --      is not a directory-createDirRecursive :: FileMode -> Path Abs -> IO ()-createDirRecursive fm dest =-  catchIOError (createDirectory (fromAbs dest) fm) $ \e -> do-    errno <- getErrno-    case errno of-         en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e)-            | en == eNOENT -> createDirRecursive fm (dirname dest)-                              >> createDirectory (fromAbs dest) fm-            | otherwise    -> ioError e+createDirRecursive :: FileMode -> Path b -> IO ()+createDirRecursive fm p =+  toAbs p >>= go+  where+    go :: Path Abs -> IO ()+    go dest@(MkPath destBS) = do+      catchIOError (createDirectory destBS fm) $ \e -> do+        errno <- getErrno+        case errno of+             en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e)+                | en == eNOENT -> createDirRecursive fm (dirname dest)+                                  >> createDirectory destBS fm+                | otherwise    -> ioError e   -- |Create a symlink.@@ -765,11 +770,11 @@ --      do not exist -- -- Note: calls `symlink`-createSymlink :: Path Abs   -- ^ destination file+createSymlink :: Path b     -- ^ destination file               -> ByteString -- ^ path the symlink points to               -> IO ()-createSymlink dest sympoint-  = createSymbolicLink sympoint (fromAbs dest)+createSymlink (MkPath destBS) sympoint+  = createSymbolicLink sympoint destBS   @@ -799,12 +804,12 @@ --       (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files)-renameFile :: Path Abs -> Path Abs -> IO ()-renameFile fromf tof = do+renameFile :: Path b1 -> Path b2 -> IO ()+renameFile fromf@(MkPath fromfBS) tof@(MkPath tofBS) = do   throwSameFile fromf tof   throwFileDoesExist tof   throwDirDoesExist tof-  rename (fromAbs fromf) (fromAbs tof)+  rename fromfBS tofBS   -- |Move a file. This also works across devices by copy-delete fallback.@@ -836,8 +841,8 @@ --    - `AlreadyExists` if destination already exists -- -- Note: calls `rename` (but does not allow to rename over existing files)-moveFile :: Path Abs  -- ^ file to move-         -> Path Abs  -- ^ destination+moveFile :: Path b1   -- ^ file to move+         -> Path b2   -- ^ destination          -> CopyMode          -> IO () moveFile from to cm = do@@ -848,7 +853,7 @@                 easyDelete from     Overwrite -> do       ft <- getFileType from-      writable <- isWritable $ dirname to+      writable <- toAbs to >>= isWritable       case ft of         RegularFile -> do           exists <- doesFileExist to@@ -891,8 +896,8 @@ --     - `PermissionDenied` if we cannot read the file or the directory --        containting it --     - `NoSuchThing` if the file does not exist-readFile :: Path Abs -> IO ByteString-readFile p = withAbsPath p $ \fp ->+readFile :: Path b -> IO ByteString+readFile (MkPath fp) =   bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> do     stat <- PF.getFdStatus fd     let fsize = PF.fileSize stat@@ -913,8 +918,8 @@ --     - `PermissionDenied` if we cannot read the file or the directory --        containting it --     - `NoSuchThing` if the file does not exist-readFileEOF :: Path Abs -> IO L.ByteString-readFileEOF p = withAbsPath p $ \fp ->+readFileEOF :: Path b -> IO L.ByteString+readFileEOF (MkPath fp) =   bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd ->     allocaBytes (fromIntegral bufSize) $ \buf -> read' fd buf mempty   where@@ -948,8 +953,8 @@ --     - `PermissionDenied` if we cannot read the file or the directory --        containting it --     - `NoSuchThing` if the file does not exist-writeFile :: Path Abs -> ByteString -> IO ()-writeFile p bs = withAbsPath p $ \fp ->+writeFile :: Path b -> ByteString -> IO ()+writeFile (MkPath fp) bs =   bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] Nothing) (SPI.closeFd) $ \fd ->      void $ SPB.fdWrite fd bs @@ -963,8 +968,8 @@ --     - `PermissionDenied` if we cannot read the file or the directory --        containting it --     - `NoSuchThing` if the file does not exist-appendFile :: Path Abs -> ByteString -> IO ()-appendFile p bs = withAbsPath p $ \fp ->+appendFile :: Path b -> ByteString -> IO ()+appendFile (MkPath fp) bs =   bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing)           (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs @@ -1015,15 +1020,14 @@ --     - `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 =-  withAbsPath p $ \fp -> do-    fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing-    return-      . catMaybes-      .   fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))-      =<< getDirectoryContents' fd+getDirsFiles :: Path b        -- ^ dir to read+             -> IO [Path b]+getDirsFiles p@(MkPath fp) = do+  fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing+  return+    . catMaybes+    .   fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))+    =<< getDirectoryContents' fd   where     parseMaybe :: ByteString -> Maybe (Path Fn)     parseMaybe = parseFn@@ -1043,9 +1047,9 @@ -- --    - `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 (fromAbs p)+getFileType :: Path b -> IO FileType+getFileType (MkPath fp) = do+  fs <- PF.getSymbolicLinkStatus fp   decide fs   where     decide fs@@ -1066,13 +1070,29 @@   --- |Applies `realpath` on the given absolute path.+-- |Applies `realpath` on the given path. -- -- Throws: -- --    - `NoSuchThing` if the file at the given path does not exist --    - `NoSuchThing` if the symlink is broken-canonicalizePath :: Path Abs -> IO (Path Abs)+canonicalizePath :: Path b -> IO (Path Abs) canonicalizePath (MkPath l) = do   nl <- SPDT.realpath l   return $ MkPath nl+++-- |Converts any path to an absolute path.+-- This is done in the following way:+--+--    - if the path is already an absolute one, just return it+--    - if it's a relative path, prepend the current directory to it+toAbs :: Path b -> IO (Path Abs)+toAbs (MkPath bs) = do+  let mabs = parseAbs bs :: Maybe (Path Abs)+  case mabs of+    Just a -> return a+    Nothing  -> do+      cwd <- getWorkingDirectory >>= parseAbs+      rel <- parseRel bs -- we know it must be relative now+      return $ cwd </> rel

@@ -3,5 +3,6 @@  import HPath -canonicalizePath :: Path Abs -> IO (Path Abs)+canonicalizePath :: Path b -> IO (Path Abs) +toAbs :: Path b -> IO (Path Abs)

@@ -84,9 +84,14 @@     IOErrorType   ) import HPath+import HPath.Internal+  (+    Path(..)+  ) import {-# SOURCE #-} HPath.IO   (     canonicalizePath+  , toAbs   ) import System.IO.Error   (@@ -119,10 +124,10 @@ -- -- The first argument to the data constructor is always the -- source and the second the destination.-data RecursiveFailureHint = ReadContentsFailed    (Path Abs) (Path Abs)-                          | CreateDirFailed       (Path Abs) (Path Abs)-                          | CopyFileFailed        (Path Abs) (Path Abs)-                          | RecreateSymlinkFailed (Path Abs) (Path Abs)+data RecursiveFailureHint = ReadContentsFailed    ByteString ByteString+                          | CreateDirFailed       ByteString ByteString+                          | CopyFileFailed        ByteString ByteString+                          | RecreateSymlinkFailed ByteString ByteString   deriving (Eq, Show)  @@ -169,51 +174,50 @@   -- |Throws `AlreadyExists` `IOError` if file exists.-throwFileDoesExist :: Path Abs -> IO ()-throwFileDoesExist fp =+throwFileDoesExist :: Path b -> IO ()+throwFileDoesExist fp@(MkPath bs) =   whenM (doesFileExist fp)         (ioError . mkIOError                      alreadyExistsErrorType                      "File already exists"                      Nothing-                   $ (Just (toString $ fromAbs fp))+                   $ (Just (toString $ bs))         )   -- |Throws `AlreadyExists` `IOError` if directory exists.-throwDirDoesExist :: Path Abs -> IO ()-throwDirDoesExist fp =+throwDirDoesExist :: Path b -> IO ()+throwDirDoesExist fp@(MkPath bs) =   whenM (doesDirectoryExist fp)         (ioError . mkIOError                      alreadyExistsErrorType                      "Directory already exists"                      Nothing-                   $ (Just (toString $ fromAbs fp))+                   $ (Just (toString $ bs))         )   -- |Uses `isSameFile` and throws `SameFile` if it returns True.-throwSameFile :: Path Abs-              -> Path Abs+throwSameFile :: Path b1+              -> Path b2               -> IO ()-throwSameFile fp1 fp2 =+throwSameFile fp1@(MkPath bs1) fp2@(MkPath bs2) =   whenM (sameFile fp1 fp2)-        (throwIO $ SameFile (fromAbs fp1) (fromAbs fp2))+        (throwIO $ SameFile bs1 bs2)   -- |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 =-  withAbsPath fp1 $ \fp1' -> withAbsPath fp2 $ \fp2' ->-    handleIOError (\_ -> return False) $ do-      fs1 <- getFileStatus fp1'-      fs2 <- getFileStatus fp2'+sameFile :: Path b1 -> Path b2 -> IO Bool+sameFile (MkPath fp1) (MkPath 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+    if ((PF.deviceID fs1, PF.fileID fs1) ==+        (PF.deviceID fs2, PF.fileID fs2))+      then return True+      else return False   -- TODO: make this more robust when destination does not exist@@ -221,54 +225,54 @@ -- 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+throwDestinationInSource :: Path b1 -- ^ source dir+                         -> Path b2 -- ^ full destination, @dirname dest@+                                    --   must exist                          -> IO ()-throwDestinationInSource source dest = do+throwDestinationInSource (MkPath sbs) dest@(MkPath dbs) = do+  destAbs <- toAbs dest   dest'   <- (\x -> maybe x (\y -> x </> y) $ basename dest)-             <$> (canonicalizePath $ dirname dest)+             <$> (canonicalizePath $ dirname destAbs)   dids <- forM (getAllParents dest') $ \p -> do           fs <- PF.getSymbolicLinkStatus (fromAbs p)           return (PF.deviceID fs, PF.fileID fs)   sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))-              $ PF.getFileStatus (fromAbs source)+              $ PF.getFileStatus sbs   when (elem sid dids)-       (throwIO $ DestinationInSource (fromAbs dest)-                                      (fromAbs source))+       (throwIO $ DestinationInSource dbs sbs)   -- |Checks if the given file exists and is not a directory. -- Does not follow symlinks.-doesFileExist :: Path Abs -> IO Bool-doesFileExist fp =+doesFileExist :: Path b -> IO Bool+doesFileExist (MkPath bs) =   handleIOError (\_ -> return False) $ do-    fs  <- PF.getSymbolicLinkStatus (fromAbs fp)+    fs  <- PF.getSymbolicLinkStatus bs     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 =+doesDirectoryExist :: Path b -> IO Bool+doesDirectoryExist (MkPath bs) =   handleIOError (\_ -> return False) $ do-    fs  <- PF.getSymbolicLinkStatus (fromAbs fp)+    fs  <- PF.getSymbolicLinkStatus bs     return $ PF.isDirectory fs   -- |Checks whether a file or folder is writable.-isWritable :: Path Abs -> IO Bool-isWritable fp =+isWritable :: Path b -> IO Bool+isWritable (MkPath bs) =   handleIOError (\_ -> return False) $-    fileAccess (fromAbs fp) False True False+    fileAccess bs 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 =+canOpenDirectory :: Path b -> IO Bool+canOpenDirectory (MkPath bs) =   handleIOError (\_ -> return False) $ do-    bracket (PFD.openDirStream . fromAbs $ fp)+    bracket (PFD.openDirStream bs)             PFD.closeDirStream             (\_ -> return ())     return True

@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.AppendFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Process+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "AppendFileSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "fileWithContent"+  createRegularFile' "fileWithoutContent"+  createSymlink' "inputFileSymL" "fileWithContent"+  createDir' "alreadyExistsD"+  createRegularFile' "noPerms"+  noPerms "noPerms"+  createDir' "noPermsD"+  createRegularFile' "noPermsD/inputFile"+  noPerms "noPermsD"+  writeFile' "fileWithContent" "BLKASL"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "fileWithContent"+  deleteFile' "fileWithoutContent"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  normalFilePerms "noPerms"+  deleteFile' "noPerms"+  normalDirPerms "noPermsD"+  deleteFile' "noPermsD/inputFile"+  deleteDir' "noPermsD"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.appendFile" $ do++    -- successes --+    it "appendFile file with content, everything clear" $ do+      appendFile' "fileWithContent" "blahfaselllll"+      out <- readFile' "fileWithContent"+      out `shouldBe` "BLKASLblahfaselllll"++    it "appendFile file with content, everything clear" $ do+      appendFile' "fileWithContent" "gagagaga"+      out <- readFile' "fileWithContent"+      out `shouldBe` "BLKASLblahfaselllllgagagaga"++    it "appendFile file with content, everything clear" $ do+      appendFile' "fileWithContent" ""+      out <- readFile' "fileWithContent"+      out `shouldBe` "BLKASLblahfaselllllgagagaga"++    it "appendFile file without content, everything clear" $ do+      appendFile' "fileWithoutContent" "blahfaselllll"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "blahfaselllll"++    it "appendFile, everything clear" $ do+      appendFile' "fileWithoutContent" "gagagaga"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "blahfaselllllgagagaga"++    it "appendFile symlink, everything clear" $ do+      appendFile' "inputFileSymL" "blahfaselllll"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll"++    it "appendFile symlink, everything clear" $ do+      appendFile' "inputFileSymL" "gagagaga"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga"+++    -- posix failures --+    it "appendFile to dir, inappropriate type" $ do+      appendFile' "alreadyExistsD" ""+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "appendFile, no permissions to file" $ do+      appendFile' "noPerms" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "appendFile, no permissions to file" $ do+      appendFile' "noPermsD/inputFile" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "appendFile, file does not exist" $ do+      appendFile' "gaga" ""+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.ReadFileEOFSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Process+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "ReadFileEOFSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "fileWithContent"+  createRegularFile' "fileWithoutContent"+  createSymlink' "inputFileSymL" "fileWithContent"+  createDir' "alreadyExistsD"+  createRegularFile' "noPerms"+  noPerms "noPerms"+  createDir' "noPermsD"+  createRegularFile' "noPermsD/inputFile"+  noPerms "noPermsD"+  writeFile' "fileWithContent" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "fileWithContent"+  deleteFile' "fileWithoutContent"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  normalFilePerms "noPerms"+  deleteFile' "noPerms"+  normalDirPerms "noPermsD"+  deleteFile' "noPermsD/inputFile"+  deleteDir' "noPermsD"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.readFileEOF" $ do++    -- successes --+    it "readFileEOF (Strict) file with content, everything clear" $ do+      out <- readFileEOF' "fileWithContent"+      out `shouldBe` "Blahfaselgagaga"++    it "readFileEOF (Strict) symlink, everything clear" $ do+      out <- readFileEOF' "inputFileSymL"+      out `shouldBe` "Blahfaselgagaga"++    it "readFileEOF (Strict) empty file, everything clear" $ do+      out <- readFileEOF' "fileWithoutContent"+      out `shouldBe` ""+++    -- posix failures --+    it "readFileEOF (Strict) directory, wrong file type" $ do+      readFileEOF' "alreadyExistsD"+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "readFileEOF (Strict) file, no permissions" $ do+      readFileEOF' "noPerms"+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "readFileEOF (Strict) file, no permissions on dir" $ do+      readFileEOF' "noPermsD/inputFile"+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "readFileEOF (Strict) file, no such file" $ do+      readFileEOF' "lalala"+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.ReadFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Process+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "ReadFileSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "fileWithContent"+  createRegularFile' "fileWithoutContent"+  createSymlink' "inputFileSymL" "fileWithContent"+  createDir' "alreadyExistsD"+  createRegularFile' "noPerms"+  noPerms "noPerms"+  createDir' "noPermsD"+  createRegularFile' "noPermsD/inputFile"+  noPerms "noPermsD"+  writeFile' "fileWithContent" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "fileWithContent"+  deleteFile' "fileWithoutContent"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  normalFilePerms "noPerms"+  deleteFile' "noPerms"+  normalDirPerms "noPermsD"+  deleteFile' "noPermsD/inputFile"+  deleteDir' "noPermsD"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.readFile" $ do++    -- successes --+    it "readFile (Strict) file with content, everything clear" $ do+      out <- readFile' "fileWithContent"+      out `shouldBe` "Blahfaselgagaga"++    it "readFile (Strict) symlink, everything clear" $ do+      out <- readFile' "inputFileSymL"+      out `shouldBe` "Blahfaselgagaga"++    it "readFile (Strict) empty file, everything clear" $ do+      out <- readFile' "fileWithoutContent"+      out `shouldBe` ""+++    -- posix failures --+    it "readFile (Strict) directory, wrong file type" $ do+      readFile' "alreadyExistsD"+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "readFile (Strict) file, no permissions" $ do+      readFile' "noPerms"+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "readFile (Strict) file, no permissions on dir" $ do+      readFile' "noPermsD/inputFile"+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "readFile (Strict) file, no such file" $ do+      readFile' "lalala"+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.ToAbsSpec where+++import Test.Hspec+import HPath+import HPath.IO++++spec :: Spec+spec = describe "HPath.IO.toAbs" $ do++    -- successes --+    it "toAbs returns absolute paths unchanged" $ do+      p1 <- parseAbs "/a/b/c/d"+      to <- toAbs p1+      p1 `shouldBe` to++    it "toAbs returns even existing absolute paths unchanged" $ do+      p1 <- parseAbs "/home"+      to <- toAbs p1+      p1 `shouldBe` to++

@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.WriteFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Process+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "WriteFileSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "fileWithContent"+  createRegularFile' "fileWithoutContent"+  createSymlink' "inputFileSymL" "fileWithContent"+  createDir' "alreadyExistsD"+  createRegularFile' "noPerms"+  noPerms "noPerms"+  createDir' "noPermsD"+  createRegularFile' "noPermsD/inputFile"+  noPerms "noPermsD"+  writeFile' "fileWithContent" "BLKASL"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "fileWithContent"+  deleteFile' "fileWithoutContent"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  normalFilePerms "noPerms"+  deleteFile' "noPerms"+  normalDirPerms "noPermsD"+  deleteFile' "noPermsD/inputFile"+  deleteDir' "noPermsD"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.writeFile" $ do++    -- successes --+    it "writeFile file with content, everything clear" $ do+      writeFile' "fileWithContent" "blahfaselllll"+      out <- readFile' "fileWithContent"+      out `shouldBe` "blahfaselllll"++    it "writeFile file with content, everything clear" $ do+      writeFile' "fileWithContent" "gagagaga"+      out <- readFile' "fileWithContent"+      out `shouldBe` "gagagaga"++    it "writeFile file with content, everything clear" $ do+      writeFile' "fileWithContent" ""+      out <- readFile' "fileWithContent"+      out `shouldBe` ""++    it "writeFile file without content, everything clear" $ do+      writeFile' "fileWithoutContent" "blahfaselllll"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "blahfaselllll"++    it "writeFile, everything clear" $ do+      writeFile' "fileWithoutContent" "gagagaga"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "gagagaga"++    it "writeFile symlink, everything clear" $ do+      writeFile' "inputFileSymL" "blahfaselllll"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "blahfaselllll"++    it "writeFile symlink, everything clear" $ do+      writeFile' "inputFileSymL" "gagagaga"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "gagagaga"+++    -- posix failures --+    it "writeFile to dir, inappropriate type" $ do+      writeFile' "alreadyExistsD" ""+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "writeFile, no permissions to file" $ do+      writeFile' "noPerms" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "writeFile, no permissions to file" $ do+      writeFile' "noPermsD/inputFile" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "writeFile, file does not exist" $ do+      writeFile' "gaga" ""+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)