{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Test.FileSystem.Fake
( FileSystem
, FileSystemT (..)
, FileSystemM
, runFileSystemT
, evalFileSystemT
, execFileSystemT
, runFileSystemM
, evalFileSystemM
, execFileSystemM
, readPath
, writePath
, modifyPath
) where
import Control.Exception (IOException)
import Control.Monad.Except (ExceptT, runExceptT, throwError)
import Control.Monad.State.Strict (StateT, gets, modify', runStateT)
import Control.Monad.Trans (MonadTrans, lift)
import Data.Functor.Identity (Identity, runIdentity)
import qualified Data.Map.Strict as M
import qualified Data.Tuple as Tuple
import System.IO.Error (doesNotExistErrorType, mkIOError)
type FileSystem contents = M.Map String contents
newtype FileSystemT contents m a =
FileSystemT
(ExceptT IOException
(StateT (FileSystem contents) m) a)
deriving (Functor, Applicative, Monad)
instance MonadTrans (FileSystemT contents) where
lift = FileSystemT . lift . lift
type FileSystemM contents = FileSystemT contents Identity
runFileSystemT
:: Functor m
=> FileSystem contents
-> FileSystemT contents m a
-> m (FileSystem contents, Either IOException a)
runFileSystemT fs (FileSystemT action) =
Tuple.swap <$> runStateT (runExceptT action) fs
evalFileSystemT :: Functor f => FileSystem contents -> FileSystemT contents f a -> f (Either IOException a)
evalFileSystemT fs = fmap snd . runFileSystemT fs
execFileSystemT :: Functor f => FileSystem contents -> FileSystemT contents f a -> f (FileSystem contents)
execFileSystemT fs = fmap fst . runFileSystemT fs
runFileSystemM
:: FileSystem contents
-> FileSystemM contents a
-> (FileSystem contents, Either IOException a)
runFileSystemM fs =
runIdentity . runFileSystemT fs
evalFileSystemM :: FileSystem contents -> FileSystemM contents a -> Either IOException a
evalFileSystemM fs = snd . runFileSystemM fs
execFileSystemM :: FileSystem contents -> FileSystemM contents a -> FileSystem contents
execFileSystemM fs = fst . runFileSystemM fs
readPath :: Monad m => FilePath -> FileSystemT contents m contents
readPath path = do
mContent <- FileSystemT $ gets $ M.lookup path
case mContent of
Just content -> return content
_ ->
FileSystemT
$ throwError
$ mkIOError doesNotExistErrorType "openFile" Nothing
$ Just path
writePath :: Monad m => FilePath -> contents -> FileSystemT contents m ()
writePath path =
FileSystemT . modify' . M.insert path
modifyPath :: Monad m => FilePath -> (Maybe contents -> Maybe contents) -> FileSystemT contents m ()
modifyPath path f =
FileSystemT . modify' $ M.alter f path