Skip to content

Instantly share code, notes, and snippets.

@parsonsmatt
Created June 5, 2018 20:49
Show Gist options
  • Star 17 You must be signed in to star a gist
  • Fork 5 You must be signed in to fork a gist
  • Save parsonsmatt/880fbf79eaad6ed863786c6c02f8ddc9 to your computer and use it in GitHub Desktop.
Save parsonsmatt/880fbf79eaad6ed863786c6c02f8ddc9 to your computer and use it in GitHub Desktop.
I figured out a nice way to pluck exceptions out of a constraint!
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
-- | Polymorphic pluckable exceptions with generic-lens and prisms!
--
-- I haven't ever seen an example of someone *shrinking* the constraints in
-- an Either. We can do this with the AsType generic prism class.
module Main where
import Control.Lens
import Data.Generics.Sum
import Data.Generics.Sum.Typed
import Data.Typeable
import GHC.Generics (Generic)
-- | This is our first exception type.
data FooErr = FooErr Int
deriving (Show, Generic)
-- | And here's our second.
data BarErr = BarErr String
deriving (Generic, Show)
-- | We "throw an exception" and project it into some larger sum, using
-- @'AsType' 'FooErr' e@. This uses generics under the hood.
foo :: AsType FooErr e => Either e Int
foo = Left (review (_Typed @FooErr) (FooErr 3))
-- | 'bar' has the same deal as 'foo' -- we're just throwing an error.
bar :: AsType BarErr e => Either e Int
bar = Left (review (_Typed @BarErr) (BarErr "hello"))
-- | Here, we're collecting both of those constraints. GHC will infer this
-- signature just fine, but it needs @NoMonomorphismRestriction@ of course.
foobar :: (AsType BarErr e, AsType FooErr e) => Either e Int
foobar = bar *> foo *> bar
-- | And here's the magic. There are instances of relevant type classes for
-- 'Either', and we can "pluck" the FooErr constraint off. So 'e' there
-- only has a constraint for @'AsType' 'BarErr' e@. There's also, uh, a lot
-- of nasty constraints that are hidden in the generic-lens library, but
-- they're mostly about guaranteeing that 'FooErr' does not occur in @e@.
plucked :: _ => Either (Either FooErr e) Int
plucked = foobar
-- | And this works!
main :: IO ()
main = do
print (plucked :: Either (Either FooErr BarErr) Int)
-- We can also just use case and pluck a single exception off. Note
-- that we're casing on foobar, which has the AsType. And Either just
-- works. We pattern match on the type and it *just works*!
case foobar of
Left err ->
case err of
Left (FooErr i) -> do
putStrLn "Got FooErr"
print i
Right other -> do
putStrLn "Got something else"
print (typeOf other)
Right i -> do
putStrLn "Got right"
print i
@srghma
Copy link

srghma commented Jun 9, 2019

@parsonsmatt
Copy link
Author

it's very good!

@prednaz
Copy link

prednaz commented Mar 27, 2020

@parsonsmatt, have you ever got this working for more than just two exception types?

@parsonsmatt
Copy link
Author

I did better with plucky

@AleXoundOS
Copy link

I did better with plucky

Wow!

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