Lens, Prisms, and Errors.

Err.hs

{-# 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

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.