module Blanks.Sub
  ( SubError (..)
  , ThrowSub (..)
  , rethrowSub
  ) where

import Control.Exception (Exception, throwIO)

-- | Errors that happen in the course of instantiation, thrown by 'blankApply'
-- and related functions.
data SubError
  = ApplyError !Int !Int
  | UnboundError !Int
  | NonBinderError
  deriving (SubError -> SubError -> Bool
(SubError -> SubError -> Bool)
-> (SubError -> SubError -> Bool) -> Eq SubError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubError -> SubError -> Bool
$c/= :: SubError -> SubError -> Bool
== :: SubError -> SubError -> Bool
$c== :: SubError -> SubError -> Bool
Eq, Int -> SubError -> ShowS
[SubError] -> ShowS
SubError -> String
(Int -> SubError -> ShowS)
-> (SubError -> String) -> ([SubError] -> ShowS) -> Show SubError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SubError] -> ShowS
$cshowList :: [SubError] -> ShowS
show :: SubError -> String
$cshow :: SubError -> String
showsPrec :: Int -> SubError -> ShowS
$cshowsPrec :: Int -> SubError -> ShowS
Show)

instance Exception SubError

-- | Some monadic context that lets you throw a 'SubError'.
-- Exists to let you rethrow to a more convenient context rather than
-- pattern maching.
class ThrowSub m where
  throwSub :: SubError -> m a

rethrowSub :: (Applicative m, ThrowSub m) => Either SubError a -> m a
rethrowSub :: Either SubError a -> m a
rethrowSub = (SubError -> m a) -> (a -> m a) -> Either SubError a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SubError -> m a
forall (m :: * -> *) a. ThrowSub m => SubError -> m a
throwSub a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance ThrowSub (Either SubError) where
  throwSub :: SubError -> Either SubError a
throwSub = SubError -> Either SubError a
forall a b. a -> Either a b
Left

instance ThrowSub IO where
  throwSub :: SubError -> IO a
throwSub = SubError -> IO a
forall e a. Exception e => e -> IO a
throwIO