{-# LANGUAGE ScopedTypeVariables #-}

module Witch.TryFromException 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 @TryFrom@ conversion fails. It has the
-- original @source@ value that caused the failure and it knows the @target@
-- type it was trying to convert into. It also has an optional
-- 'Exception.SomeException' for communicating what went wrong while
-- converting.
data TryFromException source target
  = TryFromException
      source
      (Maybe Exception.SomeException)

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

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