LIB: minor cleanup
This commit is contained in:
parent
b7ee2ccd3d
commit
3f303b4cd4
@ -215,5 +215,5 @@ rethrowErrnoAs en fmex action = catchErrno en action (throw fmex)
|
|||||||
|
|
||||||
-- |Like `catchIOError`, with arguments swapped.
|
-- |Like `catchIOError`, with arguments swapped.
|
||||||
handleIOError :: (IOError -> IO a) -> IO a -> IO a
|
handleIOError :: (IOError -> IO a) -> IO a -> IO a
|
||||||
handleIOError a1 a2 = catchIOError a2 a1
|
handleIOError = flip catchIOError
|
||||||
|
|
||||||
|
@ -38,8 +38,8 @@ import Control.Exception
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
(
|
(
|
||||||
unless
|
unless
|
||||||
, when
|
|
||||||
, void
|
, void
|
||||||
|
, when
|
||||||
)
|
)
|
||||||
import Data.ByteString
|
import Data.ByteString
|
||||||
(
|
(
|
||||||
@ -95,7 +95,6 @@ import System.Posix.Directory.ByteString
|
|||||||
import System.Posix.Files.ByteString
|
import System.Posix.Files.ByteString
|
||||||
(
|
(
|
||||||
createSymbolicLink
|
createSymbolicLink
|
||||||
, readSymbolicLink
|
|
||||||
, fileMode
|
, fileMode
|
||||||
, getFdStatus
|
, getFdStatus
|
||||||
, groupExecuteMode
|
, groupExecuteMode
|
||||||
@ -107,9 +106,10 @@ import System.Posix.Files.ByteString
|
|||||||
, ownerModes
|
, ownerModes
|
||||||
, ownerReadMode
|
, ownerReadMode
|
||||||
, ownerWriteMode
|
, ownerWriteMode
|
||||||
|
, readSymbolicLink
|
||||||
|
, removeLink
|
||||||
, rename
|
, rename
|
||||||
, unionFileModes
|
, unionFileModes
|
||||||
, removeLink
|
|
||||||
)
|
)
|
||||||
import qualified System.Posix.Files.ByteString as PF
|
import qualified System.Posix.Files.ByteString as PF
|
||||||
import qualified "unix" System.Posix.IO.ByteString as SPI
|
import qualified "unix" System.Posix.IO.ByteString as SPI
|
||||||
@ -294,7 +294,7 @@ recreateSymlink (Rename pn) symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) _
|
|||||||
recreateSymlink cm symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) fn
|
recreateSymlink cm symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) fn
|
||||||
= do
|
= do
|
||||||
throwCantOpenDirectory $ fullPath symdest
|
throwCantOpenDirectory $ fullPath symdest
|
||||||
sympoint <- readSymbolicLink (fullPathS $ symf)
|
sympoint <- readSymbolicLink (fullPathS symf)
|
||||||
let symname = fullPath symdest P.</> fn
|
let symname = fullPath symdest P.</> fn
|
||||||
case cm of
|
case cm of
|
||||||
Merge -> delOld symname
|
Merge -> delOld symname
|
||||||
@ -391,7 +391,7 @@ unsafeCopyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
|
|||||||
write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int
|
write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int
|
||||||
write' sfd dfd buf totalsize = do
|
write' sfd dfd buf totalsize = do
|
||||||
size <- SPB.fdReadBuf sfd buf bufSize
|
size <- SPB.fdReadBuf sfd buf bufSize
|
||||||
if (size == 0)
|
if size == 0
|
||||||
then return $ fromIntegral totalsize
|
then return $ fromIntegral totalsize
|
||||||
else do rsize <- SPB.fdWriteBuf dfd buf size
|
else do rsize <- SPB.fdWriteBuf dfd buf size
|
||||||
when (rsize /= size) (throw . CopyFailed $ "wrong size!")
|
when (rsize /= size) (throw . CopyFailed $ "wrong size!")
|
||||||
|
@ -32,10 +32,6 @@ import Control.Exception
|
|||||||
(
|
(
|
||||||
bracket
|
bracket
|
||||||
)
|
)
|
||||||
import Control.Monad.State.Lazy
|
|
||||||
(
|
|
||||||
|
|
||||||
)
|
|
||||||
import Data.ByteString(ByteString)
|
import Data.ByteString(ByteString)
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import Data.Default
|
import Data.Default
|
||||||
@ -50,12 +46,12 @@ import Foreign.C.Error
|
|||||||
eACCES
|
eACCES
|
||||||
)
|
)
|
||||||
import HPath
|
import HPath
|
||||||
(
|
(
|
||||||
Abs
|
Abs
|
||||||
, Path
|
, Path
|
||||||
, Fn
|
, Fn
|
||||||
, pattern Path
|
, pattern Path
|
||||||
)
|
)
|
||||||
import qualified HPath as P
|
import qualified HPath as P
|
||||||
import HSFM.FileSystem.Errors
|
import HSFM.FileSystem.Errors
|
||||||
import HSFM.Utils.MyPrelude
|
import HSFM.Utils.MyPrelude
|
||||||
@ -64,7 +60,6 @@ import System.IO.Error
|
|||||||
(
|
(
|
||||||
ioeGetErrorType
|
ioeGetErrorType
|
||||||
, isDoesNotExistErrorType
|
, isDoesNotExistErrorType
|
||||||
, catchIOError
|
|
||||||
)
|
)
|
||||||
import qualified System.Posix.Directory.ByteString as PFD
|
import qualified System.Posix.Directory.ByteString as PFD
|
||||||
import qualified System.Posix.Files.ByteString as PF
|
import qualified System.Posix.Files.ByteString as PF
|
||||||
@ -215,7 +210,7 @@ sdir f@SymLink{ sdest = (_ :/ s@SymLink{} )}
|
|||||||
-- we have to follow a chain of symlinks here, but
|
-- we have to follow a chain of symlinks here, but
|
||||||
-- return only the very first level
|
-- return only the very first level
|
||||||
-- TODO: this is probably obsolete now
|
-- TODO: this is probably obsolete now
|
||||||
= case (sdir s) of
|
= case sdir s of
|
||||||
(True, _) -> (True, f)
|
(True, _) -> (True, f)
|
||||||
_ -> (False, f)
|
_ -> (False, f)
|
||||||
sdir f@SymLink{ sdest = (_ :/ Dir {} )}
|
sdir f@SymLink{ sdest = (_ :/ Dir {} )}
|
||||||
@ -277,7 +272,7 @@ afileLikeSym f = convertViewP fileLikeSym f
|
|||||||
|
|
||||||
fileLikeSym :: File FileInfo -> (Bool, File FileInfo)
|
fileLikeSym :: File FileInfo -> (Bool, File FileInfo)
|
||||||
fileLikeSym f@SymLink{ sdest = (_ :/ s@SymLink{} )}
|
fileLikeSym f@SymLink{ sdest = (_ :/ s@SymLink{} )}
|
||||||
= case (fileLikeSym s) of
|
= case fileLikeSym s of
|
||||||
(True, _) -> (True, f)
|
(True, _) -> (True, f)
|
||||||
_ -> (False, f)
|
_ -> (False, f)
|
||||||
fileLikeSym f@SymLink{ sdest = (_ :/ RegFile {} )} = (True, f)
|
fileLikeSym f@SymLink{ sdest = (_ :/ RegFile {} )} = (True, f)
|
||||||
@ -294,7 +289,7 @@ adirSym f = convertViewP dirSym f
|
|||||||
|
|
||||||
dirSym :: File FileInfo -> (Bool, File FileInfo)
|
dirSym :: File FileInfo -> (Bool, File FileInfo)
|
||||||
dirSym f@SymLink{ sdest = (_ :/ s@SymLink{} )}
|
dirSym f@SymLink{ sdest = (_ :/ s@SymLink{} )}
|
||||||
= case (dirSym s) of
|
= case dirSym s of
|
||||||
(True, _) -> (True, f)
|
(True, _) -> (True, f)
|
||||||
_ -> (False, f)
|
_ -> (False, f)
|
||||||
dirSym f@SymLink{ sdest = (_ :/ Dir {} )} = (True, f)
|
dirSym f@SymLink{ sdest = (_ :/ Dir {} )} = (True, f)
|
||||||
@ -415,7 +410,7 @@ readFileUnsafe ff p = do
|
|||||||
-- watch out, we call </> from 'filepath' here, but it is safe
|
-- watch out, we call </> from 'filepath' here, but it is safe
|
||||||
-- TODO: could it happen that too many '..' lead
|
-- TODO: could it happen that too many '..' lead
|
||||||
-- to something like '/' after normalization?
|
-- to something like '/' after normalization?
|
||||||
let sfp = (P.fromAbs bd') `P.combine` x
|
let sfp = P.fromAbs bd' `P.combine` x
|
||||||
rsfp <- P.realPath sfp
|
rsfp <- P.realPath sfp
|
||||||
readFile ff =<< P.parseAbs rsfp
|
readFile ff =<< P.parseAbs rsfp
|
||||||
return $ SymLink fn' fv resolvedSyml x
|
return $ SymLink fn' fv resolvedSyml x
|
||||||
@ -560,38 +555,38 @@ comparingConstr t t' = compare (name t) (name t')
|
|||||||
---- CONSTRUCTOR IDENTIFIERS ----
|
---- CONSTRUCTOR IDENTIFIERS ----
|
||||||
|
|
||||||
isFileC :: File a -> Bool
|
isFileC :: File a -> Bool
|
||||||
isFileC (RegFile _ _) = True
|
isFileC RegFile{} = True
|
||||||
isFileC _ = False
|
isFileC _ = False
|
||||||
|
|
||||||
|
|
||||||
isDirC :: File a -> Bool
|
isDirC :: File a -> Bool
|
||||||
isDirC (Dir _ _) = True
|
isDirC Dir{} = True
|
||||||
isDirC _ = False
|
isDirC _ = False
|
||||||
|
|
||||||
|
|
||||||
isSymC :: File a -> Bool
|
isSymC :: File a -> Bool
|
||||||
isSymC (SymLink _ _ _ _) = True
|
isSymC SymLink{} = True
|
||||||
isSymC _ = False
|
isSymC _ = False
|
||||||
|
|
||||||
|
|
||||||
isBlockC :: File a -> Bool
|
isBlockC :: File a -> Bool
|
||||||
isBlockC (BlockDev _ _) = True
|
isBlockC BlockDev{} = True
|
||||||
isBlockC _ = False
|
isBlockC _ = False
|
||||||
|
|
||||||
|
|
||||||
isCharC :: File a -> Bool
|
isCharC :: File a -> Bool
|
||||||
isCharC (CharDev _ _) = True
|
isCharC CharDev{} = True
|
||||||
isCharC _ = False
|
isCharC _ = False
|
||||||
|
|
||||||
|
|
||||||
isNamedC :: File a -> Bool
|
isNamedC :: File a -> Bool
|
||||||
isNamedC (NamedPipe _ _) = True
|
isNamedC NamedPipe{} = True
|
||||||
isNamedC _ = False
|
isNamedC _ = False
|
||||||
|
|
||||||
|
|
||||||
isSocketC :: File a -> Bool
|
isSocketC :: File a -> Bool
|
||||||
isSocketC (Socket _ _) = True
|
isSocketC Socket{} = True
|
||||||
isSocketC _ = False
|
isSocketC _ = False
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -673,7 +668,7 @@ handleDT :: Path Abs
|
|||||||
-> IO (AnchoredFile a)
|
-> IO (AnchoredFile a)
|
||||||
-> IO (AnchoredFile a)
|
-> IO (AnchoredFile a)
|
||||||
handleDT bp n
|
handleDT bp n
|
||||||
= flip catchIOError $ (\e -> return $ bp :/ Failed n e)
|
= handleIOError $ \e -> return $ bp :/ Failed n e
|
||||||
|
|
||||||
|
|
||||||
-- DoesNotExist errors not present at the topmost level could happen if a
|
-- DoesNotExist errors not present at the topmost level could happen if a
|
||||||
|
Loading…
Reference in New Issue
Block a user