git.iko.soy/effectful
on f4a8def help sign in
effectful/examples/FileSystem.hs
62 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
18import Effectful.Error
19import Effectful.State.Local
21-- | An effect for reading and writing files.
22data FileSystem :: Effect where
23 ReadFile :: FilePath -> FileSystem m String
24 WriteFile :: FilePath -> String -> FileSystem m ()
26--- | File system error.
27newtype FsError = FsError String
29----------------------------------------
30-- Operations
32-- | Read contents of a file.
33readFile :: (HasCallStack, FileSystem :> es) => FilePath -> Eff es String
34readFile = send . ReadFile
36-- | Write contents to a file.
37writeFile :: (HasCallStack, FileSystem :> es) => FilePath -> String -> Eff es ()
38writeFile path = send . WriteFile path
40----------------------------------------
41-- Handlers
43runFileSystemIO
44 :: (IOE :> es, Error FsError :> es)
45 => Eff (FileSystem : es) a
46 -> Eff es a
47runFileSystemIO = interpret $ \case
48 ReadFile path -> adapt $ IO.readFile path
49 WriteFile path contents -> adapt $ IO.writeFile path contents
50 where
51 adapt m = liftIO m `catch` \(e::IOException) -> throwError . FsError $ show e
53runFileSystemPure
54 :: Error FsError :> es
55 => M.Map FilePath String
56 -> Eff (FileSystem : es) a
57 -> Eff es a
58runFileSystemPure fs0 = reinterpret (evalState fs0) $ \case
59 ReadFile path -> gets (M.lookup path) >>= \case
60 Just contents -> pure contents
61 Nothing -> throwError . FsError $ "File not found: " ++ show path
62 WriteFile path contents -> modify $ M.insert path contents