Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Save SergeyStretovich/da671c6fe3cdbbc54ecaa449cd432cdc to your computer and use it in GitHub Desktop.
Save SergeyStretovich/da671c6fe3cdbbc54ecaa449cd432cdc to your computer and use it in GitHub Desktop.
Exception handling example Freer monad (with freer-simple)
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import Data.String
import qualified Data.ByteString.Char8 as B
import Control.Exception
import Data.List
import Data.Text (Text, pack, unpack)
import Data.Text.IO
import Data.Text.Encoding (decodeUtf8)
import Control.Natural (type (~>))
import qualified Control.Monad.Freer.Error as ER
import Control.Monad.Freer
(
Eff
, LastMember
, Member
, Members
, interpret
, send
, sendM
, runM
)
readFileUTF8 :: String -> IO Text
readFileUTF8 path = decodeUtf8 <$> B.readFile path
ioToAppErr :: IOException -> AppError
ioToAppErr ioe = AppError (displayException ioe)
newtype AppError = AppError String deriving Show
data FileSystem r where
ReadFile :: FilePath -> FileSystem Text
readFile :: Members '[FileSystem, ER.Error AppError] effs => FilePath -> Eff effs Text
readFile fpath = if (elem 'x' fpath)
then (ER.throwError (AppError "No Xs allowed in file name"))
else(send $ ReadFile fpath)
runAppError :: Eff (ER.Error AppError ': r) a -> Eff r (Either AppError a)
runAppError = ER.runError
fileSystemIOInterpreter
:: (Members '[ER.Error AppError] effs, LastMember IO effs)
=> Eff (FileSystem ': effs) a -> Eff effs a
fileSystemIOInterpreter = interpret $ \case
ReadFile path -> do
r <- sendM (try (readFileUTF8 path))
case r of
Left (e :: IOException) -> ER.throwError (ioToAppErr e)
Right f -> pure f
application :: Members '[FileSystem, ER.Error AppError] effs => FilePath -> Eff effs Text
application = Main.readFile
ioApp :: FilePath -> IO (Either AppError Text)
ioApp path = runM
$ runAppError
$ fileSystemIOInterpreter
$ application path
main :: IO ()
main = do
let pathX = "C:\\text.info"
let pathNoX = "C:\\simple.t"
let pathNoSuchAFile = "C:\\habrahabr.bib"
result <- ioApp pathX
Data.Text.IO.putStrLn $ pack (show result)
{-
dependencies:
- base >= 4.7 && < 5
- text
- freer-simple
- natural-transformation
- bytestring
-}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment