More freer and exceptions

errors.hs

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

import           Control.Monad.Eff

data Throw e a where
  Throw :: e -> Throw e a

data Log a where
  Log :: String -> Log ()

throw :: (Member (Throw e) r) => e -> Eff r a
throw = send . Throw

logError :: forall e r a . (Show e, Member Log r) => Eff (Throw e ': r) a -> Eff r (Maybe a)
logError (Val v) = return (Just v)
logError (Eff u k) =
    case decomp u of
      Left  u'        -> Eff u' (singleton (logError . kApp k))
      Right (Throw e) -> send (Log ("Exception: " ++ show e)) >> return Nothing

runLog :: Member IO r => Eff (Log ': r) a -> Eff r a
runLog (Val v) = return v
runLog (Eff u k) =
    case decomp u of
      Left u'         -> Eff u' (singleton (runLog . kApp k))
      Right (Log str) -> send (putStrLn str) >>= runLog . kApp k

f1 :: (Member (Throw Int) r, Member (Throw Bool) r) => Eff r ()
f1 = throw (123 :: Int)

f2 :: (Member (Throw Bool) r, Member Log r, Member IO r) => Eff r (Maybe ())
f2 = logError @ Int f1

main :: IO ()
main = runM (runLog (logError @ Bool (logError @ Int f1))) >>= print