hasufell
/
hpath
1
1
Fork 0
Code Issues 8 Pull Requests Releases Wiki Activity

Fix HPath.IO after API changes

This commit is contained in:
Julian Ospald 2020-01-20 19:50:44 +01:00
parent d0beba227a
commit 9d8b7d5bfc
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
2 changed files with 41 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
hpath-io/src/HPath/IO.hs
View File

@ -197,7 +197,6 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import HPath import HPath
import HPath.Internal
import HPath.IO.Errors import HPath.IO.Errors
import Prelude hiding (appendFile, readFile, writeFile) import Prelude hiding (appendFile, readFile, writeFile)
import Streamly import Streamly
@ -393,7 +392,7 @@ copyDirRecursive fromp destdirp cm rm
where where
go :: IORef [(RecursiveFailureHint, IOException)] go :: IORef [(RecursiveFailureHint, IOException)]
-> Path b1 -> Path b2 -> IO () -> Path b1 -> Path b2 -> IO ()
go ce fromp'@(MkPath fromBS) destdirp'@(MkPath destdirpBS) = do go ce fromp'@(Path fromBS) destdirp'@(Path destdirpBS) = do
-- NOTE: order is important here, so we don't get empty directories -- NOTE: order is important here, so we don't get empty directories
-- on failure -- on failure
@ -477,7 +476,7 @@ recreateSymlink :: Path b1 -- ^ the old symlink file
-> Path b2 -- ^ destination file -> Path b2 -- ^ destination file
-> CopyMode -> CopyMode
-> IO () -> IO ()
recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm recreateSymlink symsource@(Path symsourceBS) newsym@(Path newsymBS) cm
= do = do
throwSameFile symsource newsym throwSameFile symsource newsym
sympoint <- readSymbolicLink symsourceBS sympoint <- readSymbolicLink symsourceBS
@ -536,7 +535,7 @@ copyFile :: Path b1 -- ^ source file
-> Path b2 -- ^ destination file -> Path b2 -- ^ destination file
-> CopyMode -> CopyMode
-> IO () -> IO ()
copyFile fp@(MkPath from) tp@(MkPath to) cm = do copyFile fp@(Path from) tp@(Path to) cm = do
throwSameFile fp tp throwSameFile fp tp
bracket (do bracket (do
fd <- openFd from SPI.ReadOnly [SPDF.oNofollow] Nothing fd <- openFd from SPI.ReadOnly [SPDF.oNofollow] Nothing
@ -608,7 +607,7 @@ easyCopy from to cm rm = do
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
-- - `PermissionDenied` if the directory cannot be read -- - `PermissionDenied` if the directory cannot be read
deleteFile :: Path b -> IO () deleteFile :: Path b -> IO ()
deleteFile (MkPath p) = removeLink p deleteFile (Path p) = removeLink p
-- |Deletes the given directory, which must be empty, never symlinks. -- |Deletes the given directory, which must be empty, never symlinks.
@ -623,7 +622,7 @@ deleteFile (MkPath p) = removeLink p
-- --
-- Notes: calls `rmdir` -- Notes: calls `rmdir`
deleteDir :: Path b -> IO () deleteDir :: Path b -> IO ()
deleteDir (MkPath p) = removeDirectory p deleteDir (Path p) = removeDirectory p
-- |Deletes the given directory recursively. Does not follow symbolic -- |Deletes the given directory recursively. Does not follow symbolic
@ -691,7 +690,7 @@ easyDelete p = do
-- is not checked. This forks a process. -- is not checked. This forks a process.
openFile :: Path b openFile :: Path b
-> IO ProcessID -> IO ProcessID
openFile (MkPath fp) = openFile (Path fp) =
SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing
@ -699,7 +698,7 @@ openFile (MkPath fp) =
executeFile :: Path b -- ^ program executeFile :: Path b -- ^ program
-> [ByteString] -- ^ arguments -> [ByteString] -- ^ arguments
-> IO ProcessID -> IO ProcessID
executeFile (MkPath fp) args = executeFile (Path fp) args =
SPP.forkProcess $ SPP.executeFile fp True args Nothing SPP.forkProcess $ SPP.executeFile fp True args Nothing
@ -720,7 +719,7 @@ executeFile (MkPath fp) args =
-- - `NoSuchThing` if any of the parent components of the path -- - `NoSuchThing` if any of the parent components of the path
-- do not exist -- do not exist
createRegularFile :: FileMode -> Path b -> IO () createRegularFile :: FileMode -> Path b -> IO ()
createRegularFile fm (MkPath destBS) = createRegularFile fm (Path destBS) =
bracket (SPI.openFd destBS SPI.WriteOnly (Just fm) bracket (SPI.openFd destBS SPI.WriteOnly (Just fm)
(SPI.defaultFileFlags { exclusive = True })) (SPI.defaultFileFlags { exclusive = True }))
SPI.closeFd SPI.closeFd
@ -736,7 +735,7 @@ createRegularFile fm (MkPath destBS) =
-- - `NoSuchThing` if any of the parent components of the path -- - `NoSuchThing` if any of the parent components of the path
-- do not exist -- do not exist
createDir :: FileMode -> Path b -> IO () createDir :: FileMode -> Path b -> IO ()
createDir fm (MkPath destBS) = createDirectory destBS fm createDir fm (Path destBS) = createDirectory destBS fm
-- |Create an empty directory at the given directory with the given filename. -- |Create an empty directory at the given directory with the given filename.
-- --
@ -746,7 +745,7 @@ createDir fm (MkPath destBS) = createDirectory destBS fm
-- - `NoSuchThing` if any of the parent components of the path -- - `NoSuchThing` if any of the parent components of the path
-- do not exist -- do not exist
createDirIfMissing :: FileMode -> Path b -> IO () createDirIfMissing :: FileMode -> Path b -> IO ()
createDirIfMissing fm (MkPath destBS) = createDirIfMissing fm (Path destBS) =
hideError AlreadyExists $ createDirectory destBS fm hideError AlreadyExists $ createDirectory destBS fm
@ -775,7 +774,7 @@ createDirRecursive fm p =
toAbs p >>= go toAbs p >>= go
where where
go :: Path Abs -> IO () go :: Path Abs -> IO ()
go dest@(MkPath destBS) = do go dest@(Path destBS) = do
catchIOError (createDirectory destBS fm) $ \e -> do catchIOError (createDirectory destBS fm) $ \e -> do
errno <- getErrno errno <- getErrno
case errno of case errno of
@ -798,7 +797,7 @@ createDirRecursive fm p =
createSymlink :: Path b -- ^ destination file createSymlink :: Path b -- ^ destination file
-> ByteString -- ^ path the symlink points to -> ByteString -- ^ path the symlink points to
-> IO () -> IO ()
createSymlink (MkPath destBS) sympoint createSymlink (Path destBS) sympoint
= createSymbolicLink sympoint destBS = createSymbolicLink sympoint destBS
@ -830,7 +829,7 @@ createSymlink (MkPath destBS) sympoint
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Note: calls `rename` (but does not allow to rename over existing files)
renameFile :: Path b1 -> Path b2 -> IO () renameFile :: Path b1 -> Path b2 -> IO ()
renameFile fromf@(MkPath fromfBS) tof@(MkPath tofBS) = do renameFile fromf@(Path fromfBS) tof@(Path tofBS) = do
throwSameFile fromf tof throwSameFile fromf tof
throwFileDoesExist tof throwFileDoesExist tof
throwDirDoesExist tof throwDirDoesExist tof
@ -940,7 +939,7 @@ readFile path = do
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
readFileStream :: Path b readFileStream :: Path b
-> IO (SerialT IO ByteString) -> IO (SerialT IO ByteString)
readFileStream (MkPath fp) = do readFileStream (Path fp) = do
fd <- openFd fp SPI.ReadOnly [] Nothing fd <- openFd fp SPI.ReadOnly [] Nothing
handle <- SPI.fdToHandle fd handle <- SPI.fdToHandle fd
let stream = (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) >>= arrayToByteString let stream = (S.unfold (SU.finally SIO.hClose FH.readChunks) handle) >>= arrayToByteString
@ -967,7 +966,7 @@ writeFile :: Path b
-> Maybe FileMode -- ^ if Nothing, file must exist -> Maybe FileMode -- ^ if Nothing, file must exist
-> ByteString -> ByteString
-> IO () -> IO ()
writeFile (MkPath fp) fmode bs = writeFile (Path fp) fmode bs =
bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs
@ -986,7 +985,7 @@ writeFileL :: Path b
-> Maybe FileMode -- ^ if Nothing, file must exist -> Maybe FileMode -- ^ if Nothing, file must exist
-> L.ByteString -> L.ByteString
-> IO () -> IO ()
writeFileL (MkPath fp) fmode lbs = do writeFileL (Path fp) fmode lbs = do
handle <- bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ SPI.fdToHandle handle <- bracketOnError (openFd fp SPI.WriteOnly [SPDF.oTrunc] fmode) (SPI.closeFd) $ SPI.fdToHandle
finally (streamlyCopy handle) (SIO.hClose handle) finally (streamlyCopy handle) (SIO.hClose handle)
where where
@ -1003,7 +1002,7 @@ writeFileL (MkPath fp) fmode lbs = do
-- containting it -- containting it
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
appendFile :: Path b -> ByteString -> IO () appendFile :: Path b -> ByteString -> IO ()
appendFile (MkPath fp) bs = appendFile (Path fp) bs =
bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing) bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing)
(SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs
@ -1048,7 +1047,7 @@ newDirPerms
-- --
-- Only eNOENT is catched (and returns False). -- Only eNOENT is catched (and returns False).
doesExist :: Path b -> IO Bool doesExist :: Path b -> IO Bool
doesExist (MkPath bs) = doesExist (Path bs) =
catchErrno [eNOENT] (do catchErrno [eNOENT] (do
_ <- PF.getSymbolicLinkStatus bs _ <- PF.getSymbolicLinkStatus bs
return $ True) return $ True)
@ -1060,7 +1059,7 @@ doesExist (MkPath bs) =
-- --
-- Only eNOENT is catched (and returns False). -- Only eNOENT is catched (and returns False).
doesFileExist :: Path b -> IO Bool doesFileExist :: Path b -> IO Bool
doesFileExist (MkPath bs) = doesFileExist (Path bs) =
catchErrno [eNOENT] (do catchErrno [eNOENT] (do
fs <- PF.getSymbolicLinkStatus bs fs <- PF.getSymbolicLinkStatus bs
return $ not . PF.isDirectory $ fs) return $ not . PF.isDirectory $ fs)
@ -1072,7 +1071,7 @@ doesFileExist (MkPath bs) =
-- --
-- Only eNOENT is catched (and returns False). -- Only eNOENT is catched (and returns False).
doesDirectoryExist :: Path b -> IO Bool doesDirectoryExist :: Path b -> IO Bool
doesDirectoryExist (MkPath bs) = doesDirectoryExist (Path bs) =
catchErrno [eNOENT] (do catchErrno [eNOENT] (do
fs <- PF.getSymbolicLinkStatus bs fs <- PF.getSymbolicLinkStatus bs
return $ PF.isDirectory fs) return $ PF.isDirectory fs)
@ -1087,7 +1086,7 @@ doesDirectoryExist (MkPath bs) =
-- --
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
isReadable :: Path b -> IO Bool isReadable :: Path b -> IO Bool
isReadable (MkPath bs) = fileAccess bs True False False isReadable (Path bs) = fileAccess bs True False False
-- |Checks whether a file or folder is writable. -- |Checks whether a file or folder is writable.
-- --
@ -1097,7 +1096,7 @@ isReadable (MkPath bs) = fileAccess bs True False False
-- --
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
isWritable :: Path b -> IO Bool isWritable :: Path b -> IO Bool
isWritable (MkPath bs) = fileAccess bs False True False isWritable (Path bs) = fileAccess bs False True False
-- |Checks whether a file or folder is executable. -- |Checks whether a file or folder is executable.
@ -1108,14 +1107,14 @@ isWritable (MkPath bs) = fileAccess bs False True False
-- --
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
isExecutable :: Path b -> IO Bool isExecutable :: Path b -> IO Bool
isExecutable (MkPath bs) = fileAccess bs False False True isExecutable (Path bs) = fileAccess bs False False True
-- |Checks whether the directory at the given path exists and can be -- |Checks whether the directory at the given path exists and can be
-- opened. This invokes `openDirStream` which follows symlinks. -- opened. This invokes `openDirStream` which follows symlinks.
canOpenDirectory :: Path b -> IO Bool canOpenDirectory :: Path b -> IO Bool
canOpenDirectory (MkPath bs) = canOpenDirectory (Path bs) =
handleIOError (\_ -> return False) $ do handleIOError (\_ -> return False) $ do
bracket (openDirStream bs) bracket (openDirStream bs)
closeDirStream closeDirStream
@ -1131,18 +1130,18 @@ canOpenDirectory (MkPath bs) =
getModificationTime :: Path b -> IO UTCTime getModificationTime :: Path b -> IO UTCTime
getModificationTime (MkPath bs) = do getModificationTime (Path bs) = do
fs <- PF.getFileStatus bs fs <- PF.getFileStatus bs
pure $ posixSecondsToUTCTime $ PF.modificationTimeHiRes fs pure $ posixSecondsToUTCTime $ PF.modificationTimeHiRes fs
setModificationTime :: Path b -> EpochTime -> IO () setModificationTime :: Path b -> EpochTime -> IO ()
setModificationTime (MkPath bs) t = do setModificationTime (Path bs) t = do
-- TODO: setFileTimes doesn't allow to pass NULL to utime -- TODO: setFileTimes doesn't allow to pass NULL to utime
ctime <- epochTime ctime <- epochTime
PF.setFileTimes bs ctime t PF.setFileTimes bs ctime t
setModificationTimeHiRes :: Path b -> POSIXTime -> IO () setModificationTimeHiRes :: Path b -> POSIXTime -> IO ()
setModificationTimeHiRes (MkPath bs) t = do setModificationTimeHiRes (Path bs) t = do
-- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes -- TODO: setFileTimesHiRes doesn't allow to pass NULL to utimes
ctime <- getPOSIXTime ctime <- getPOSIXTime
PF.setFileTimesHiRes bs ctime t PF.setFileTimesHiRes bs ctime t
@ -1169,7 +1168,7 @@ setModificationTimeHiRes (MkPath bs) t = do
-- - `PathParseException` if a filename could not be parsed (should never happen) -- - `PathParseException` if a filename could not be parsed (should never happen)
getDirsFiles :: Path b -- ^ dir to read getDirsFiles :: Path b -- ^ dir to read
-> IO [Path b] -> IO [Path b]
getDirsFiles p@(MkPath fp) = do getDirsFiles p@(Path fp) = do
contents <- getDirsFiles' p contents <- getDirsFiles' p
pure $ fmap (p </>) contents pure $ fmap (p </>) contents
@ -1178,7 +1177,7 @@ getDirsFiles p@(MkPath fp) = do
-- of prepending the base path. -- of prepending the base path.
getDirsFiles' :: Path b -- ^ dir to read getDirsFiles' :: Path b -- ^ dir to read
-> IO [Path Rel] -> IO [Path Rel]
getDirsFiles' p@(MkPath fp) = do getDirsFiles' p@(Path fp) = do
fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
rawContents <- getDirectoryContents' fd rawContents <- getDirectoryContents' fd
fmap catMaybes $ for rawContents $ \(_, f) -> fmap catMaybes $ for rawContents $ \(_, f) ->
@ -1202,7 +1201,7 @@ getDirsFiles' p@(MkPath fp) = do
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
-- - `PermissionDenied` if any part of the path is not accessible -- - `PermissionDenied` if any part of the path is not accessible
getFileType :: Path b -> IO FileType getFileType :: Path b -> IO FileType
getFileType (MkPath fp) = do getFileType (Path fp) = do
fs <- PF.getSymbolicLinkStatus fp fs <- PF.getSymbolicLinkStatus fp
decide fs decide fs
where where
@ -1230,10 +1229,11 @@ getFileType (MkPath fp) = do
-- --
-- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the file at the given path does not exist
-- - `NoSuchThing` if the symlink is broken -- - `NoSuchThing` if the symlink is broken
-- - `PathParseException` if realpath does not return an absolute path
canonicalizePath :: Path b -> IO (Path Abs) canonicalizePath :: Path b -> IO (Path Abs)
canonicalizePath (MkPath l) = do canonicalizePath (Path l) = do
nl <- SPDT.realpath l nl <- SPDT.realpath l
return $ MkPath nl parseAbs nl
-- |Converts any path to an absolute path. -- |Converts any path to an absolute path.
@ -1242,7 +1242,7 @@ canonicalizePath (MkPath l) = do
-- - if the path is already an absolute one, just return it -- - if the path is already an absolute one, just return it
-- - if it's a relative path, prepend the current directory to it -- - if it's a relative path, prepend the current directory to it
toAbs :: Path b -> IO (Path Abs) toAbs :: Path b -> IO (Path Abs)
toAbs (MkPath bs) = do toAbs (Path bs) = do
let mabs = parseAbs bs :: Maybe (Path Abs) let mabs = parseAbs bs :: Maybe (Path Abs)
case mabs of case mabs of
Just a -> return a Just a -> return a
@ -1260,7 +1260,7 @@ toAbs (MkPath bs) = do
-- --
-- - `PathParseException` if the bytestring could neither be parsed as -- - `PathParseException` if the bytestring could neither be parsed as
-- relative or absolute Path -- relative or absolute Path
withRawFilePath :: MonadThrow m => ByteString -> (Path a -> m b) -> m b withRawFilePath :: MonadThrow m => ByteString -> (Either (Path Abs) (Path Rel) -> m b) -> m b
withRawFilePath bs action = do withRawFilePath bs action = do
path <- parseAny bs path <- parseAny bs
action path action path
@ -1276,7 +1276,7 @@ withRawFilePath bs action = do
-- relative or absolute Path -- relative or absolute Path
withHandle :: ByteString withHandle :: ByteString
-> SPI.OpenMode -> SPI.OpenMode
-> ((SIO.Handle, Path a) -> IO a) -> ((SIO.Handle, Either (Path Abs) (Path Rel)) -> IO a)
-> IO a -> IO a
withHandle bs mode action = do withHandle bs mode action = do
path <- parseAny bs path <- parseAny bs

14
hpath-io/src/HPath/IO/Errors.hs
View File

@ -81,10 +81,6 @@ import GHC.IO.Exception
IOErrorType IOErrorType
) )
import HPath import HPath
import HPath.Internal
(
Path(..)
)
import {-# SOURCE #-} HPath.IO import {-# SOURCE #-} HPath.IO
( (
canonicalizePath canonicalizePath
@ -175,7 +171,7 @@ isRecreateSymlinkFailed _ = False
-- |Throws `AlreadyExists` `IOError` if file exists. -- |Throws `AlreadyExists` `IOError` if file exists.
throwFileDoesExist :: Path b -> IO () throwFileDoesExist :: Path b -> IO ()
throwFileDoesExist fp@(MkPath bs) = throwFileDoesExist fp@(Path bs) =
whenM (doesFileExist fp) whenM (doesFileExist fp)
(ioError . mkIOError (ioError . mkIOError
alreadyExistsErrorType alreadyExistsErrorType
@ -187,7 +183,7 @@ throwFileDoesExist fp@(MkPath bs) =
-- |Throws `AlreadyExists` `IOError` if directory exists. -- |Throws `AlreadyExists` `IOError` if directory exists.
throwDirDoesExist :: Path b -> IO () throwDirDoesExist :: Path b -> IO ()
throwDirDoesExist fp@(MkPath bs) = throwDirDoesExist fp@(Path bs) =
whenM (doesDirectoryExist fp) whenM (doesDirectoryExist fp)
(ioError . mkIOError (ioError . mkIOError
alreadyExistsErrorType alreadyExistsErrorType
@ -201,7 +197,7 @@ throwDirDoesExist fp@(MkPath bs) =
throwSameFile :: Path b1 throwSameFile :: Path b1
-> Path b2 -> Path b2
-> IO () -> IO ()
throwSameFile fp1@(MkPath bs1) fp2@(MkPath bs2) = throwSameFile fp1@(Path bs1) fp2@(Path bs2) =
whenM (sameFile fp1 fp2) whenM (sameFile fp1 fp2)
(throwIO $ SameFile bs1 bs2) (throwIO $ SameFile bs1 bs2)
@ -209,7 +205,7 @@ throwSameFile fp1@(MkPath bs1) fp2@(MkPath bs2) =
-- |Check if the files are the same by examining device and file id. -- |Check if the files are the same by examining device and file id.
-- This follows symbolic links. -- This follows symbolic links.
sameFile :: Path b1 -> Path b2 -> IO Bool sameFile :: Path b1 -> Path b2 -> IO Bool
sameFile (MkPath fp1) (MkPath fp2) = sameFile (Path fp1) (Path fp2) =
handleIOError (\_ -> return False) $ do handleIOError (\_ -> return False) $ do
fs1 <- getFileStatus fp1 fs1 <- getFileStatus fp1
fs2 <- getFileStatus fp2 fs2 <- getFileStatus fp2
@ -229,7 +225,7 @@ throwDestinationInSource :: Path b1 -- ^ source dir
-> Path b2 -- ^ full destination, @dirname dest@ -> Path b2 -- ^ full destination, @dirname dest@
-- must exist -- must exist
-> IO () -> IO ()
throwDestinationInSource (MkPath sbs) dest@(MkPath dbs) = do throwDestinationInSource (Path sbs) dest@(Path dbs) = do
destAbs <- toAbs dest destAbs <- toAbs dest
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest) dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest)
<$> (canonicalizePath $ dirname destAbs) <$> (canonicalizePath $ dirname destAbs)