diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 diff --git a/hpath.cabal b/hpath.cabal --- a/hpath.cabal +++ b/hpath.cabal @@ -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 diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -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 diff --git a/src/HPath/IO.hs-boot b/src/HPath/IO.hs-boot --- a/src/HPath/IO.hs-boot +++ b/src/HPath/IO.hs-boot @@ -3,5 +3,6 @@ import HPath -canonicalizePath :: Path Abs -> IO (Path Abs) +canonicalizePath :: Path b -> IO (Path Abs) +toAbs :: Path b -> IO (Path Abs) diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs --- a/src/HPath/IO/Errors.hs +++ b/src/HPath/IO/Errors.hs @@ -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 diff --git a/test/HPath/IO/AppendFileSpec.hs b/test/HPath/IO/AppendFileSpec.hs new file mode 100644 --- /dev/null +++ b/test/HPath/IO/AppendFileSpec.hs @@ -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) diff --git a/test/HPath/IO/ReadFileEOFSpec.hs b/test/HPath/IO/ReadFileEOFSpec.hs new file mode 100644 --- /dev/null +++ b/test/HPath/IO/ReadFileEOFSpec.hs @@ -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) diff --git a/test/HPath/IO/ReadFileSpec.hs b/test/HPath/IO/ReadFileSpec.hs new file mode 100644 --- /dev/null +++ b/test/HPath/IO/ReadFileSpec.hs @@ -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) diff --git a/test/HPath/IO/ToAbsSpec.hs b/test/HPath/IO/ToAbsSpec.hs new file mode 100644 --- /dev/null +++ b/test/HPath/IO/ToAbsSpec.hs @@ -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 + + diff --git a/test/HPath/IO/WriteFileSpec.hs b/test/HPath/IO/WriteFileSpec.hs new file mode 100644 --- /dev/null +++ b/test/HPath/IO/WriteFileSpec.hs @@ -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)