mtlex.hs

#! /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