git.iko.soy/effectful
on 650ea35 help sign in
effectful/examples/FileSystem.hs
65 lines 1.8 kB history raw
1module FileSystem
2 ( FileSystem(..)
3 , FsError(..)
4 , readFile
5 , writeFile
6 , runFileSystemIO
7 , runFileSystemPure
8 ) where
10import Control.Exception (IOException)
11import Control.Monad.Catch
12import Control.Monad.IO.Class
13import Prelude hiding (readFile, writeFile)
14import qualified Data.Map.Strict as M
15import qualified System.IO as IO
17import Effectful.Error
18import Effectful.Interpreter
19import Effectful.Monad
20import Effectful.State
22-- | An effect for reading and writing files.
23data FileSystem :: Effect where
24 ReadFile :: FilePath -> FileSystem m String
25 WriteFile :: FilePath -> String -> FileSystem m ()
27--- | File system error.
28newtype FsError = FsError String
29 deriving Show
30instance Exception FsError
32----------------------------------------
33-- Operations
35-- | Read contents of a file.
36readFile :: FileSystem :> es => FilePath -> Eff es String
37readFile = send . ReadFile
39-- | Write contents to a file.
40writeFile :: FileSystem :> es => FilePath -> String -> Eff es ()
41writeFile path = send . WriteFile path
43----------------------------------------
44-- Handlers
46runFileSystemIO
47 :: (IOE :> es, Error FsError :> es)
48 => Eff (FileSystem : es) a
49 -> Eff es a
50runFileSystemIO = interpret $ \case
51 ReadFile path -> adapt $ IO.readFile path
52 WriteFile path contents -> adapt $ IO.writeFile path contents
53 where
54 adapt m = liftIO m `catch` \(e::IOException) -> throwError . FsError $ show e
56runFileSystemPure
57 :: Error FsError :> es
58 => M.Map FilePath String
59 -> Eff (FileSystem : es) a
60 -> Eff es a
61runFileSystemPure fs0 = reinterpret (evalState fs0) $ \case
62 ReadFile path -> gets (M.lookup path) >>= \case
63 Just contents -> pure contents
64 Nothing -> throwError . FsError $ "File not found: " ++ show path
65 WriteFile path contents -> modify $ M.insert path contents