Instantly share code, notes, and snippets.

@nkpart /Err.hs
Last active Nov 8, 2018

What would you like to do?
Lens, Prisms, and Errors.
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fwarn-missing-methods #-}
module Err where
import Control.Lens
import Control.Monad.Error
import Control.Monad.Error.Lens
-- Here is a fairly typical situation, where we have low level errors in certain
-- systems, a top level application error type that unifies them
data TopLevel = TopLevelN NetworkBad | TopLevelD DiskBad deriving Show
data NetworkBad = SocketBad FilePath | TimeoutBad Int deriving Show
data DiskBad = FileBad FilePath deriving Show
-- Make classy prisms gives us a type class encapsulating whether data can
-- be made into any of the error types
makeClassyPrisms ''NetworkBad
makeClassyPrisms ''DiskBad
makeClassyPrisms ''TopLevel
-- The generated code, for NetworkBad, looks something like this:
-- class AsNetworkBad a where
-- -- A prism into NetworkBad from some type `a`
-- _NetworkBad :: Prism' a NetworkBad
-- -- Prisms into the constructors from some type `a`, these have default implementations.
-- _SocketBad :: Prism' a FilePath
-- _TimeoutBad :: Prism' a Int
-- _SocketBad = _NetworkBad . _SocketBad
-- _TimeoutBad = _NetworkBad . _TimeoutBad
-- To be `AsNetworkBad`, we need a prism from our type into a network bad. The default implementations for SocketBad and TimeoutBad
-- will then be enough to define the instance.
-- instance AsNetworkBad NetworkBad where
-- _NetworkBad = id -- A NetworkBad is a NetworkBad
-- _SocketBad -- And now we have the normal prisms for a sum type
-- = prism
-- (\ a -> SocketBad a)
-- (\ a
-- -> case a of {
-- SocketBad fp -> Right fp
-- _ -> Left a })
-- _TimeoutBad
-- = prism
-- (\ n -> TimeoutBad n)
-- (\ a
-- -> case a of {
-- TimeoutBad n -> Right n
-- _ -> Left a })
-- We then provide an instance of a specific subsystem error type's class
-- for our top level data type.
-- We only need to define the prisms for the types (_NetworkBad and _DiskBad), as
-- the default implementations for the constructors will then be fine.
instance AsDiskBad TopLevel where
_DiskBad = _TopLevelD . _DiskBad
instance AsNetworkBad TopLevel where
_NetworkBad = _TopLevelN . _NetworkBad
-- Now, we can create a top level error using the low level subsystem
-- prism.
throwFileBad :: TopLevel
throwFileBad = _FileBad # "foo"
-- To make it fancy, we pull in `Control.Monad.Error.Lens`, and `throwing`, which
-- lets us create an error at whatever level in our application we happen to be.
foo :: (AsDiskBad e, MonadError e m) => m x
foo = throwing _FileBad "foo"
-- Some examples of how `foo` specialises:
a :: Either DiskBad x
a = foo
b :: Either TopLevel x
b = foo
-- We can also catch errors at both levels:
catchingExample :: (AsDiskBad r1, MonadError r1 m, Num r) => m r
catchingExample = catching _FileBad (throwing _FileBad "/tmp/wat") (\fp -> return (-1))
asDisk :: Either DiskBad Int
asDisk = catchingExample
asTotal :: Either TopLevel Int
asTotal = catchingExample

This comment has been minimized.

etorreborre commented Oct 30, 2017

Is there a way to define:

a :: (MonadError e m, AsTopLevel e)
a = foo

In your example the AsDiskBad e constraint "bubbles-up" to the top and I don't know how to subsume it into a more general AsTopLevel constraint.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment