LIB: remove more occurences of FilePath

This commit is contained in:
Julian Ospald 2016-04-03 03:57:11 +02:00
parent 4da3c92e5e
commit 4e75a84439
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
2 changed files with 23 additions and 20 deletions

View File

@ -48,6 +48,7 @@ import Foreign.C.Error
import HPath import HPath
( (
Path Path
, Abs
, Fn , Fn
) )
import qualified HPath as P import qualified HPath as P
@ -234,14 +235,16 @@ recreateSymlink _ _ _ = throw $ InvalidOperation "wrong input type"
-- |TODO: handle EAGAIN exception for non-blocking IO -- |TODO: handle EAGAIN exception for non-blocking IO
-- |Low-level function to copy a given file to the given path. The fileMode -- |Low-level function to copy a given file to the given path. The fileMode
-- is preserved. The file is always overwritten if accessible. -- is preserved. The file is always overwritten if accessible.
copyFile' :: FilePath -> FilePath -> IO () copyFile' :: Path Abs -> Path Abs -> IO ()
copyFile' from to = do copyFile' from to = do
fromFstatus <- getSymbolicLinkStatus from let from' = P.fromAbs from
fromContent <- BS.readFile from to' = P.fromAbs to
fd <- System.Posix.IO.createFile to fromFstatus <- getSymbolicLinkStatus from'
fromContent <- BS.readFile from'
fd <- System.Posix.IO.createFile to'
(System.Posix.Files.fileMode fromFstatus) (System.Posix.Files.fileMode fromFstatus)
closeFd fd closeFd fd
BS.writeFile to fromContent BS.writeFile to' fromContent
-- |Copies the given file to the given file destination, overwriting it. -- |Copies the given file to the given file destination, overwriting it.
@ -257,7 +260,7 @@ overwriteFile from@(_ :/ RegFile {})
let from' = fullPath from let from' = fullPath from
to' = fullPath to to' = fullPath to
throwSameFile from' to' throwSameFile from' to'
copyFile' (P.fromAbs from') (P.fromAbs to') copyFile' from' to'
overwriteFile _ _ = throw $ InvalidOperation "wrong input type" overwriteFile _ _ = throw $ InvalidOperation "wrong input type"
@ -277,7 +280,7 @@ copyFileToDir cm from@(_ :/ RegFile fn _)
case cm of case cm of
Strict -> throwFileDoesExist to' Strict -> throwFileDoesExist to'
_ -> return () _ -> return ()
copyFile' (P.fromAbs from') (P.fromAbs to') copyFile' from' to'
copyFileToDir _ _ _ = throw $ InvalidOperation "wrong input type" copyFileToDir _ _ _ = throw $ InvalidOperation "wrong input type"

View File

@ -45,10 +45,6 @@ import Data.List
( (
isPrefixOf isPrefixOf
) )
import Data.Maybe
(
catMaybes
)
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
( (
POSIXTime POSIXTime
@ -581,22 +577,26 @@ getContents (ADirOrSym af) = readDirectoryContents (fullPath af)
getContents _ = return [] getContents _ = return []
getDirsFiles' :: (FilePath -> [FilePath] -> [FilePath]) getDirsFiles' :: (Path Fn -> [Path Fn] -> [Path Fn])
-> Path Abs -> Path Abs
-> IO [Path Fn] -> IO [Path Fn]
getDirsFiles' filterf fp = do getDirsFiles' filterf fp = do
dirstream <- PFD.openDirStream . P.toFilePath $ fp dirstream <- PFD.openDirStream . P.toFilePath $ fp
let mdirs :: [FilePath] -> IO [FilePath] let mdirs :: [Path Fn] -> IO [Path Fn]
mdirs dirs = do mdirs dirs = do
-- make sure we close the directory stream in case of errors -- make sure we close the directory stream in case of errors
-- TODO: more explicit error handling?
-- both the parsing and readin the stream can fail!
dir <- onException (PFD.readDirStream dirstream) dir <- onException (PFD.readDirStream dirstream)
(PFD.closeDirStream dirstream) (PFD.closeDirStream dirstream)
if dir == "" case dir of
then return dirs "" -> return dirs
else mdirs (dir `filterf` dirs) _ -> do
pdir <- P.parseFn dir
mdirs $ pdir `filterf` dirs
dirs <- mdirs [] dirs <- mdirs []
PFD.closeDirStream dirstream PFD.closeDirStream dirstream
return $ catMaybes (fmap P.parseFn dirs) return dirs
-- |Get all files of a given directory and return them as a List. -- |Get all files of a given directory and return them as a List.
@ -611,8 +611,8 @@ getDirsFiles :: Path Abs -> IO [Path Fn]
getDirsFiles = getDirsFiles' insert getDirsFiles = getDirsFiles' insert
where where
insert dir dirs = case dir of insert dir dirs = case dir of
"." -> dirs (Path ".") -> dirs
".." -> dirs (Path "..") -> dirs
_ -> dir : dirs _ -> dir : dirs