Skip to content

Instantly share code, notes, and snippets.

@dino-
Last active April 1, 2019 18:48
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dino-/b239c10bc2256bcdf54c3731c7839dc8 to your computer and use it in GitHub Desktop.
Save dino-/b239c10bc2256bcdf54c3731c7839dc8 to your computer and use it in GitHub Desktop.
#! /usr/bin/env stack
-- stack --resolver lts-13.15 runghc --package mtl
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Except
main :: IO ()
main = do
print =<< runMySpecialTransformer example1Function
print =<< runMySpecialTransformer example2Function
print =<< example3Function
-- Our own transformer to combine Except and IO effects
type MySpecialTransformer a = (ExceptT String IO) a
-- It's customary to also make your own run* function using all of the relevant
-- run* functions involved
runMySpecialTransformer :: MySpecialTransformer a -> IO (Either String a)
runMySpecialTransformer = runExceptT
-- Not a great approach if example1Function needs to be re-usable as with a
-- library because of the concrete MySpecialTransformer type
example1Function :: MySpecialTransformer Double
example1Function = do
d <- liftIO $ return 0.5
unless (d >= 1.0) $ throwError "It's less than 1.0!"
return d
-- Better to code to the mtl type classes MonadError and MonadIO, making this
-- code portable
example2Function :: (MonadError String m, MonadIO m) => m Double
example2Function = do
d <- liftIO $ return 1.0
unless (d >= 1.0) $ throwError "It's less than 1.0!"
return d
-- It might also be desireable to use mtl only down inside a function and not
-- expose it to the caller at all. But we still benefit from being able to
-- throw errors locally inside this function combined with IO. In other words,
-- we're using effects locally and not exposing them to the caller at all.
example3Function :: IO (Either String Double)
example3Function = runExceptT $ do
d <- liftIO $ return 2.0
unless (d >= 1.0) $ throwError "It's less than 1.0!"
return d
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment