{-# LANGUAGE ExistentialQuantification #-}

module Dormouse.Client.Exception 
  ( SomeDormouseException(..)
  , DecodingException(..)
  , UnexpectedStatusCodeException(..)
  , MediaTypeException(..)
  , UriException(..)
  , UrlException(..)
  ) where

  
import Control.Exception.Safe (Exception(..))
import Dormouse.Uri.Exception (UriException(..))
import Dormouse.Url.Exception (UrlException(..))
import qualified Data.Text as T
import Data.Typeable (cast)

data SomeDormouseException = forall e . Exception e => SomeDormouseException e

instance Show SomeDormouseException where
    show :: SomeDormouseException -> String
show (SomeDormouseException e
e) = e -> String
forall a. Show a => a -> String
show e
e

instance Exception SomeDormouseException

-- | 'UnexpectedStatusCodeException' is used to indicate that the remote server returned an unexpected status code value, for instance an unsuccessful (non-2XX) status code.
newtype UnexpectedStatusCodeException = UnexpectedStatusCodeException { UnexpectedStatusCodeException -> Int
uscStatusCode :: Int }

instance Show UnexpectedStatusCodeException where
  show :: UnexpectedStatusCodeException -> String
show UnexpectedStatusCodeException { uscStatusCode :: UnexpectedStatusCodeException -> Int
uscStatusCode = Int
statusCode } = String
"Server returned unexpected status code: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
statusCode

instance Exception UnexpectedStatusCodeException where
  toException :: UnexpectedStatusCodeException -> SomeException
toException     = SomeDormouseException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeDormouseException -> SomeException)
-> (UnexpectedStatusCodeException -> SomeDormouseException)
-> UnexpectedStatusCodeException
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnexpectedStatusCodeException -> SomeDormouseException
forall e. Exception e => e -> SomeDormouseException
SomeDormouseException
  fromException :: SomeException -> Maybe UnexpectedStatusCodeException
fromException SomeException
x = do
    SomeDormouseException e
a <- SomeException -> Maybe SomeDormouseException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe UnexpectedStatusCodeException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a

-- | 'DecodingException' is used to when something has gone wrong decoding an http response into the expected representation, e.g. json was expected but the response json was invalid.
newtype DecodingException = DecodingException { DecodingException -> Text
decodingExceptionMessage :: T.Text }

instance Show DecodingException where
  show :: DecodingException -> String
show DecodingException { decodingExceptionMessage :: DecodingException -> Text
decodingExceptionMessage = Text
msg } = String
"Decoding payload failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
msg

instance Exception DecodingException

-- | 'MediaTypeException' is used to indicate an error parsing a MediaType header such as "Content-Type" into a valid 'MediaType'
newtype MediaTypeException = MediaTypeException  { MediaTypeException -> Text
mediaTypeExceptionMessage :: T.Text }

instance Show MediaTypeException where
  show :: MediaTypeException -> String
show MediaTypeException { mediaTypeExceptionMessage :: MediaTypeException -> Text
mediaTypeExceptionMessage = Text
msg } = String
"Failed to parse media type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
msg

instance Exception MediaTypeException where
  toException :: MediaTypeException -> SomeException
toException     = SomeDormouseException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeDormouseException -> SomeException)
-> (MediaTypeException -> SomeDormouseException)
-> MediaTypeException
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MediaTypeException -> SomeDormouseException
forall e. Exception e => e -> SomeDormouseException
SomeDormouseException
  fromException :: SomeException -> Maybe MediaTypeException
fromException SomeException
x = do
    SomeDormouseException e
a <- SomeException -> Maybe SomeDormouseException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    e -> Maybe MediaTypeException
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a