{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE UndecidableInstances #-}
module Axel.Monad.FileSystem where
import Prelude hiding (readFile, writeFile)
import qualified Prelude (readFile, writeFile)
import Control.Monad (forM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Identity (IdentityT)
import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad.Trans.Cont (ContT)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Maybe (MaybeT)
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS (RWST)
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS (RWST)
import Control.Monad.Trans.Reader (ReaderT)
import qualified Control.Monad.Trans.State.Lazy as LazyState (StateT)
import qualified Control.Monad.Trans.State.Strict as StrictState (StateT)
import qualified Control.Monad.Trans.Writer.Lazy as LazyWriter (WriterT)
import qualified Control.Monad.Trans.Writer.Strict as StrictWriter (WriterT)
import qualified System.Directory
( copyFile
, createDirectoryIfMissing
, doesDirectoryExist
, getCurrentDirectory
, getDirectoryContents
, getTemporaryDirectory
, removeFile
, setCurrentDirectory
)
import System.FilePath ((</>))
import qualified System.IO.Strict as S (readFile)
class (Monad m) =>
MonadFileSystem m
where
copyFile :: FilePath -> FilePath -> m ()
default copyFile :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
FilePath -> FilePath -> m ()
copyFile src dest = lift $ copyFile src dest
createDirectoryIfMissing :: Bool -> FilePath -> m ()
default createDirectoryIfMissing :: ( MonadTrans t
, MonadFileSystem m'
, m ~ t m'
) =>
Bool -> FilePath -> m ()
createDirectoryIfMissing createParents path =
lift $ createDirectoryIfMissing createParents path
doesDirectoryExist :: FilePath -> m Bool
default doesDirectoryExist :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
FilePath -> m Bool
doesDirectoryExist = lift . doesDirectoryExist
getCurrentDirectory :: m FilePath
default getCurrentDirectory :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
m FilePath
getCurrentDirectory = lift getCurrentDirectory
getDirectoryContents :: FilePath -> m [FilePath]
default getDirectoryContents :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
FilePath -> m [FilePath]
getDirectoryContents = lift . getDirectoryContents
getTemporaryDirectory :: m FilePath
default getTemporaryDirectory :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
m FilePath
getTemporaryDirectory = lift getTemporaryDirectory
readFile :: FilePath -> m String
default readFile :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
FilePath -> m String
readFile = lift . readFile
removeFile :: FilePath -> m ()
default removeFile :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
FilePath -> m ()
removeFile = lift . removeFile
setCurrentDirectory :: FilePath -> m ()
default setCurrentDirectory :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
FilePath -> m ()
setCurrentDirectory = lift . setCurrentDirectory
writeFile :: FilePath -> String -> m ()
default writeFile :: (MonadTrans t, MonadFileSystem m', m ~ t m') =>
String -> FilePath -> m ()
writeFile path contents = lift $ writeFile path contents
instance (MonadFileSystem m) => MonadFileSystem (ContT r m)
instance (MonadFileSystem m) => MonadFileSystem (ExceptT e m)
instance (MonadFileSystem m) => MonadFileSystem (IdentityT m)
instance (MonadFileSystem m) => MonadFileSystem (MaybeT m)
instance (MonadFileSystem m) => MonadFileSystem (ReaderT r m)
instance (Monoid w, MonadFileSystem m) =>
MonadFileSystem (LazyRWS.RWST r w s m)
instance (Monoid w, MonadFileSystem m) =>
MonadFileSystem (StrictRWS.RWST r w s m)
instance (MonadFileSystem m) => MonadFileSystem (LazyState.StateT s m)
instance (MonadFileSystem m) => MonadFileSystem (StrictState.StateT s m)
instance (Monoid w, MonadFileSystem m) =>
MonadFileSystem (LazyWriter.WriterT w m)
instance (Monoid w, MonadFileSystem m) =>
MonadFileSystem (StrictWriter.WriterT w m)
instance {-# OVERLAPPABLE #-} (Monad m, MonadIO m) => MonadFileSystem m where
copyFile :: FilePath -> FilePath -> m ()
copyFile src dest = liftIO $ System.Directory.copyFile src dest
createDirectoryIfMissing :: Bool -> FilePath -> m ()
createDirectoryIfMissing createParentDirs path =
liftIO $ System.Directory.createDirectoryIfMissing createParentDirs path
doesDirectoryExist :: FilePath -> m Bool
doesDirectoryExist = liftIO . System.Directory.doesDirectoryExist
getCurrentDirectory :: m FilePath
getCurrentDirectory = liftIO System.Directory.getCurrentDirectory
getDirectoryContents :: FilePath -> m [FilePath]
getDirectoryContents = liftIO . System.Directory.getDirectoryContents
getTemporaryDirectory :: m FilePath
getTemporaryDirectory = liftIO System.Directory.getTemporaryDirectory
readFile :: FilePath -> m String
readFile = liftIO . S.readFile
removeFile :: FilePath -> m ()
removeFile = liftIO . System.Directory.removeFile
setCurrentDirectory :: FilePath -> m ()
setCurrentDirectory = liftIO . System.Directory.setCurrentDirectory
writeFile :: FilePath -> String -> m ()
writeFile filePath contents = liftIO $ Prelude.writeFile filePath contents
getDirectoryContentsRec ::
(Monad m, MonadFileSystem m) => FilePath -> m [FilePath]
getDirectoryContentsRec dir = do
names <- getDirectoryContents dir
let properNames = filter (`notElem` [".", ".."]) names
paths <-
forM properNames $ \name -> do
let path = dir </> name
isDirectory <- doesDirectoryExist path
if isDirectory
then getDirectoryContentsRec path
else pure [path]
pure $ concat paths
withCurrentDirectory :: (MonadFileSystem m) => FilePath -> m a -> m a
withCurrentDirectory directory f = do
originalDirectory <- getCurrentDirectory
setCurrentDirectory directory
result <- f
setCurrentDirectory originalDirectory
pure result
withTemporaryDirectory :: (MonadFileSystem m) => (FilePath -> m a) -> m a
withTemporaryDirectory action = getTemporaryDirectory >>= action