Skip to content

Instantly share code, notes, and snippets.

@shajra
Last active October 8, 2018 23:51
Show Gist options
  • Save shajra/745c9aa762f37fb4cdf1d6d4f700c201 to your computer and use it in GitHub Desktop.
Save shajra/745c9aa762f37fb4cdf1d6d4f700c201 to your computer and use it in GitHub Desktop.
A snapshot of thoughts on error handling
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Checker
( Checked(..)
, CheckedIO
, Throws
, S.MonadCatch
, S.MonadThrow
, S.MonadMask(..)
, runChecked
, throw
, try
, catch
, handle
, handler
, catches
, handles
, finally
, onException
, withException
, bracket
, bracketOnError
, withHandler
) where
import qualified Control.Exception.Safe as S
newtype Checked (l :: [*]) m a
= Checked { unChecked :: m a }
deriving (Functor, Applicative, Monad)
type CheckedIO l a = Checked l IO a
newtype Handler m a e = Handler [S.Handler m a]
class Throws e l
type family Append as bs where
Append (h : t) l = h : Append t l
Append '[] l = l
instance {-# OVERLAPS #-} Throws e (e : l)
instance {-# OVERLAPPABLE #-} Throws e l => Throws e (e' : l)
instance {-# OVERLAPPING #-} Throws e (S.SomeException : l)
runChecked
:: Checked '[] m a
-> m a
runChecked = unChecked
throw
:: (Throws e l, S.Exception e, S.MonadThrow m)
=> e
-> Checked l m a
throw = Checked . S.throw
try
:: (S.Exception e, S.MonadCatch m)
=> Checked (e : l) m a
-> Checked l m (Either e a)
try = Checked . S.try . unChecked
catch
:: (S.Exception e, S.MonadCatch m)
=> Checked (e : l) m a
-> (e -> Checked l m a)
-> Checked l m a
catch f g =
Checked $ S.catch (unChecked f) (unChecked . g)
handle
:: (S.Exception e, S.MonadCatch m)
=> (e -> Checked l m a)
-> Checked (e : l) m a
-> Checked l m a
handle = flip catch
catches
:: (S.MonadCatch m, S.MonadThrow m)
=> Checked (Append es l) m a
-> Handler m a es
-> Checked l m a
catches f (Handler handlers) =
Checked $ S.catches (unChecked f) handlers
handler
:: S.Exception e
=> (e -> Checked l m a)
-> Handler m a '[e]
handler h = Handler [S.Handler $ unChecked . h]
withHandler
:: S.Exception e
=> Handler m a es
-> (e -> Checked l m a)
-> Handler m a (e:es)
withHandler (Handler hs) h = Handler $ (S.Handler $ unChecked . h) : hs
handles
:: (S.MonadCatch m, S.MonadThrow m)
=> Handler m a es
-> Checked (Append es l) m a
-> Checked l m a
handles = flip catches
finally
:: S.MonadMask m
=> Checked l m a
-> Checked l m b
-> Checked l m a
finally thing after =
Checked $ S.finally (unChecked thing) (unChecked after)
onException
:: S.MonadMask m
=> Checked l m a
-> Checked l m b
-> Checked l m a
onException thing after =
Checked $ S.onException (unChecked thing) (unChecked after)
withException
:: (S.Exception e, S.MonadMask m)
=> Checked l m a
-> (e -> Checked l m b)
-> Checked l m a
withException thing after =
Checked $ S.withException (unChecked thing) (unChecked . after)
bracket
:: S.MonadMask m
=> Checked l m a
-> (a -> Checked l m b)
-> (a -> Checked l m c)
-> Checked l m c
bracket before after thing =
Checked $ S.bracket (unChecked before) (unChecked . after) (unChecked . thing)
bracketOnError
:: S.MonadMask m
=> Checked l m a
-> (a -> Checked l m b)
-> (a -> Checked l m c)
-> Checked l m c
bracketOnError before after thing =
Checked $ S.bracketOnError (unChecked before) (unChecked . after) (unChecked . thing)
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Play where
import Protolude
import qualified Checker as C
data FooE = FooE deriving (Show, Typeable)
data BarE = BarE deriving (Show, Typeable)
data BazE = BazE deriving (Show, Typeable)
instance Exception FooE
instance Exception BarE
instance Exception BazE
throwsFoo :: C.Throws FooE e => C.CheckedIO e ()
throwsFoo = C.throw FooE
throwsBar :: C.Throws BarE e => C.CheckedIO e ()
throwsBar = C.throw BarE
throwsBaz :: C.Throws BazE e => C.CheckedIO e ()
throwsBaz = C.throw BazE
throwsFooBaz :: (C.Throws FooE e, C.Throws BazE e) => C.CheckedIO e ()
throwsFooBaz = throwsFoo *> throwsBaz
test1 :: IO ()
test1 =
C.runChecked $ throwsFooBaz
`C.catches` (C.handler handleFoo `C.withHandler` handleBaz)
where
handleFoo (_::FooE) = pure ()
handleBaz (_::BazE) = pure ()
test2 :: IO ()
test2 = C.runChecked $ throwsFooBaz `C.catch` handleBaz `C.catch` handleFoo
where
handleFoo (_::FooE) = pure ()
handleBaz (_::BazE) = pure ()
test3 :: IO ()
test3 = C.runChecked $ throwsFooBaz `C.catch` handleFoo `C.catch` handleBaz
where
handleFoo (_::FooE) = pure ()
handleBaz (_::BazE) = pure ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment