{-# LANGUAGE ScopedTypeVariables #-}

module Witch.TryCastException where

import qualified Control.Exception as Exception
import qualified Data.Proxy as Proxy
import qualified Data.Typeable as Typeable

-- | This exception is thrown when a @TryCast@ conversion fails. It has the
-- original @source@ value that caused the failure and it knows the @target@
-- type it was trying to convert into.
newtype TryCastException source target
  = TryCastException source
  deriving TryCastException source target
-> TryCastException source target -> Bool
(TryCastException source target
 -> TryCastException source target -> Bool)
-> (TryCastException source target
    -> TryCastException source target -> Bool)
-> Eq (TryCastException source target)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall source target.
Eq source =>
TryCastException source target
-> TryCastException source target -> Bool
/= :: TryCastException source target
-> TryCastException source target -> Bool
$c/= :: forall source target.
Eq source =>
TryCastException source target
-> TryCastException source target -> Bool
== :: TryCastException source target
-> TryCastException source target -> Bool
$c== :: forall source target.
Eq source =>
TryCastException source target
-> TryCastException source target -> Bool
Eq

instance
  ( Show source
  , Typeable.Typeable source
  , Typeable.Typeable target
  ) => Show (TryCastException source target) where
  showsPrec :: Int -> TryCastException source target -> ShowS
showsPrec Int
d (TryCastException source
x) =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
      (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"TryCastException {- "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> ShowS
forall a. Show a => a -> ShowS
shows
          (Proxy (source -> target) -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
Typeable.typeRep (Proxy (source -> target)
forall k (t :: k). Proxy t
Proxy.Proxy :: Proxy.Proxy (source -> target)))
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" -} "
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> source -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 source
x

instance
  ( Show source
  , Typeable.Typeable source
  , Typeable.Typeable target
  ) => Exception.Exception (TryCastException source target)