Haskell checked exceptions

gistfile1.hs

{-# LANGUAGE TypeFamilies, KindSignatures, DataKinds, TypeOperators, GADTs, MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving, OverlappingInstances, ScopedTypeVariables, FlexibleContexts #-}

import Control.Applicative
import Control.DeepSeq
import qualified Control.Exception as E

-- Closed type family, needs GHC HEAD.
type family Minus (e :: *) (es :: [*]) :: [*] where
  Minus e '[] = '[]
  Minus e (e ': es) = Minus e es
  Minus e (f ': es) = f ': Minus e es

newtype IOEx (es :: [*]) (a :: *) where
  IOEx :: { unsafeRunIOEx :: IO a } -> IOEx es a
    deriving ( Functor, Applicative, Monad )

class Elem (e :: *) (es :: [*])

instance Elem e (e ': es')
instance Elem e es => Elem e (x ': es)

class Subset (es :: [*]) (es' :: [*])
instance Subset '[] es
instance (Elem e es', Subset es es') => Subset (e ': es) es'

class NotNull (e :: [*])

instance NotNull (e ': es)

data PureExceptions

-- IO computations that can only throw pure exceptions
type IOSafe = IOEx '[ PureExceptions ]

-- IO computations that can't throw any exceptions
type IOSafest = IOEx '[]

-- Annotate IO computations with exceptions
ex :: IO a -> IOEx es a
ex = IOEx

-- Annotate an IO computation that won't throw any exceptions in the IO monad.
safe :: IO a -> IOSafe a
safe = IOEx

-- Annotate an IO computation that won't throw any exceptions in the IO monad, and will produce a value that evaluates.
safest :: IO a -> IOSafest a
safest = IOEx

-- De-annotate IOEx computations.
runIOSafe :: IOSafe a -> IO a
runIOSafe = unsafeRunIOEx

runIOSafest :: IOSafest a -> IO a
runIOSafest = unsafeRunIOEx

-- Exaggerate the danger of an IOEx computation (so we can bind).
exagg :: Subset es es' => IOEx es a -> IOEx es' a
exagg = ex . unsafeRunIOEx

-- Exaggerate both sides and bind.
(!>>=!) :: (Subset es esr, Subset es' esr) => IOEx es a -> (a -> IOEx es' b) -> IOEx esr b
m !>>=! f = exagg m >>= exagg . f

infixl 1 !>>=!

-- Return a pure value that might fail to evaluate.
returnSafe :: a -> IOSafe a
returnSafe = ex . return

-- Return a pure value that you know will evaluate.
returnSafest :: a -> IOSafest a
returnSafest = ex . return

-- Catch IO exceptions, removing them from the annotation.
catch :: (E.Exception e, Elem e es, es' ~ Minus e es, Subset esh esc, Subset es' esc) => IOEx es a -> (e -> IOEx esh a) -> IOEx esc a
catch m h = ex $ E.catch (unsafeRunIOEx m) (unsafeRunIOEx . h)

-- Catch all possible exceptions. This is the only safe way to make an IOSafest from another IOEx.
catchAll :: (NFData a, NotNull es) => IOEx es a -> (E.SomeException -> IOEx esh a) -> IOEx esh a
catchAll m h = ex $ E.catch (unsafeRunIOEx m >>= E.evaluate . force) (unsafeRunIOEx . h)

-- EXAMPLE

readLn' :: IOEx '[ E.IOException ] Int
readLn' = ex readLn

safer :: IOSafe Int
safer = catch (readLn') (\(e :: E.IOException) -> returnSafe $ error "Rethrowing an exception for fun and profit.")

theSafest :: IOSafest (Either String Int)
theSafest = catchAll (Right <$> safer) (\e -> returnSafest $ Left (show e))

main = runIOSafest theSafest