git.iko.soy/effectful
on fc8a196 help sign in
effectful/examples/FileSystem.hs
63 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
30----------------------------------------
31-- Operations
33-- | Read contents of a file.
34readFile :: FileSystem :> es => FilePath -> Eff es String
35readFile = send . ReadFile
37-- | Write contents to a file.
38writeFile :: FileSystem :> es => FilePath -> String -> Eff es ()
39writeFile path = send . WriteFile path
41----------------------------------------
42-- Handlers
44runFileSystemIO
45 :: (IOE :> es, Error FsError :> es)
46 => Eff (FileSystem : es) a
47 -> Eff es a
48runFileSystemIO = interpret $ \case
49 ReadFile path -> adapt $ IO.readFile path
50 WriteFile path contents -> adapt $ IO.writeFile path contents
51 where
52 adapt m = liftIO m `catch` \(e::IOException) -> throwError . FsError $ show e
54runFileSystemPure
55 :: Error FsError :> es
56 => M.Map FilePath String
57 -> Eff (FileSystem : es) a
58 -> Eff es a
59runFileSystemPure fs0 = reinterpret (evalState fs0) $ \case
60 ReadFile path -> gets (M.lookup path) >>= \case
61 Just contents -> pure contents
62 Nothing -> throwError . FsError $ "File not found: " ++ show path
63 WriteFile path contents -> modify $ M.insert path contents