module System.Directory.Internal.Common where
import Prelude ()
import System.Directory.Internal.Prelude
import System.FilePath ((</>), isPathSeparator, isRelative,
pathSeparator, splitDrive, takeDrive)
newtype ListT m a = ListT { unListT :: m (Maybe (a, ListT m a)) }
emptyListT :: Applicative m => ListT m a
emptyListT = ListT (pure Nothing)
maybeToListT :: Applicative m => m (Maybe a) -> ListT m a
maybeToListT m = ListT (((\ x -> (x, emptyListT)) <$>) <$> m)
listToListT :: Applicative m => [a] -> ListT m a
listToListT [] = emptyListT
listToListT (x : xs) = ListT (pure (Just (x, listToListT xs)))
liftJoinListT :: Monad m => m (ListT m a) -> ListT m a
liftJoinListT m = ListT (m >>= unListT)
listTHead :: Functor m => ListT m a -> m (Maybe a)
listTHead (ListT m) = (fst <$>) <$> m
listTToList :: Monad m => ListT m a -> m [a]
listTToList (ListT m) = do
mx <- m
case mx of
Nothing -> return []
Just (x, m') -> do
xs <- listTToList m'
return (x : xs)
andM :: Monad m => m Bool -> m Bool -> m Bool
andM mx my = do
x <- mx
if x
then my
else return x
sequenceWithIOErrors_ :: [IO ()] -> IO ()
sequenceWithIOErrors_ actions = go (Right ()) actions
where
go :: Either IOError () -> [IO ()] -> IO ()
go (Left e) [] = ioError e
go (Right ()) [] = pure ()
go s (m : ms) = s `seq` do
r <- tryIOError m
go (thenEither s r) ms
thenEither :: Either b a -> Either b a -> Either b a
thenEither x@(Left _) _ = x
thenEither _ y = y
tryIOErrorType :: (IOError -> Bool) -> IO a -> IO (Either IOError a)
tryIOErrorType check action = do
result <- tryIOError action
case result of
Left err -> if check err then pure (Left err) else throwIO err
Right val -> pure (Right val)
ignoreIOExceptions :: IO () -> IO ()
ignoreIOExceptions io = io `catchIOError` (\_ -> pure ())
specializeErrorString :: String -> (IOError -> Bool) -> IO a -> IO a
specializeErrorString str errType action = do
mx <- tryIOErrorType errType action
case mx of
Left e -> throwIO (ioeSetErrorString e str)
Right x -> pure x
ioeAddLocation :: IOError -> String -> IOError
ioeAddLocation e loc = do
ioeSetLocation e newLoc
where
newLoc = loc <> if null oldLoc then "" else ":" <> oldLoc
oldLoc = ioeGetLocation e
data FileType = File
| SymbolicLink
| Directory
| DirectoryLink
deriving (Bounded, Enum, Eq, Ord, Read, Show)
fileTypeIsDirectory :: FileType -> Bool
fileTypeIsDirectory Directory = True
fileTypeIsDirectory DirectoryLink = True
fileTypeIsDirectory _ = False
fileTypeIsLink :: FileType -> Bool
fileTypeIsLink SymbolicLink = True
fileTypeIsLink DirectoryLink = True
fileTypeIsLink _ = False
data Permissions
= Permissions
{ readable :: Bool
, writable :: Bool
, executable :: Bool
, searchable :: Bool
} deriving (Eq, Ord, Read, Show)
prependCurrentDirectoryWith :: IO FilePath -> FilePath -> IO FilePath
prependCurrentDirectoryWith getCurrentDirectory path =
((`ioeAddLocation` "prependCurrentDirectory") .
(`ioeSetFileName` path)) `modifyIOError` do
if isRelative path
then do
cwd <- getCurrentDirectory
let curDrive = takeWhile (not . isPathSeparator) (takeDrive cwd)
let (drive, subpath) = splitDrive path
pure . (</> subpath) $
case drive of
_ : _ | (toUpper <$> drive) /= (toUpper <$> curDrive) ->
drive <> [pathSeparator]
_ -> cwd
else pure path
copyFileContents :: FilePath
-> FilePath
-> IO ()
copyFileContents fromFPath toFPath =
(`ioeAddLocation` "copyFileContents") `modifyIOError` do
withBinaryFile toFPath WriteMode $ \ hTo ->
copyFileToHandle fromFPath hTo
copyFileToHandle :: FilePath
-> Handle
-> IO ()
copyFileToHandle fromFPath hTo =
(`ioeAddLocation` "copyFileToHandle") `modifyIOError` do
withBinaryFile fromFPath ReadMode $ \ hFrom ->
copyHandleData hFrom hTo
copyHandleData :: Handle
-> Handle
-> IO ()
copyHandleData hFrom hTo =
(`ioeAddLocation` "copyData") `modifyIOError` do
allocaBytes bufferSize go
where
bufferSize = 131072
go buffer = do
count <- hGetBuf hFrom buffer bufferSize
when (count > 0) $ do
hPutBuf hTo buffer count
go buffer
data XdgDirectory
= XdgData
| XdgConfig
| XdgCache
deriving (Bounded, Enum, Eq, Ord, Read, Show)
data XdgDirectoryList
= XdgDataDirs
| XdgConfigDirs
deriving (Bounded, Enum, Eq, Ord, Read, Show)