{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StrictData #-}

module Web.Exhentai.Errors where

import Control.Exception
import Data.Text (Text)

data ExhentaiError
  = JSONParseFailure String
  | XMLParseFailure
      { ExhentaiError -> Text
reason :: Text,
        ExhentaiError -> Text
url :: Text
      }
  | ExtractionFailure
  deriving (Int -> ExhentaiError -> ShowS
[ExhentaiError] -> ShowS
ExhentaiError -> String
(Int -> ExhentaiError -> ShowS)
-> (ExhentaiError -> String)
-> ([ExhentaiError] -> ShowS)
-> Show ExhentaiError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExhentaiError] -> ShowS
$cshowList :: [ExhentaiError] -> ShowS
show :: ExhentaiError -> String
$cshow :: ExhentaiError -> String
showsPrec :: Int -> ExhentaiError -> ShowS
$cshowsPrec :: Int -> ExhentaiError -> ShowS
Show, ExhentaiError -> ExhentaiError -> Bool
(ExhentaiError -> ExhentaiError -> Bool)
-> (ExhentaiError -> ExhentaiError -> Bool) -> Eq ExhentaiError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExhentaiError -> ExhentaiError -> Bool
$c/= :: ExhentaiError -> ExhentaiError -> Bool
== :: ExhentaiError -> ExhentaiError -> Bool
$c== :: ExhentaiError -> ExhentaiError -> Bool
Eq)
  deriving (Show ExhentaiError
Typeable ExhentaiError
Typeable ExhentaiError
-> Show ExhentaiError
-> (ExhentaiError -> SomeException)
-> (SomeException -> Maybe ExhentaiError)
-> (ExhentaiError -> String)
-> Exception ExhentaiError
SomeException -> Maybe ExhentaiError
ExhentaiError -> String
ExhentaiError -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: ExhentaiError -> String
$cdisplayException :: ExhentaiError -> String
fromException :: SomeException -> Maybe ExhentaiError
$cfromException :: SomeException -> Maybe ExhentaiError
toException :: ExhentaiError -> SomeException
$ctoException :: ExhentaiError -> SomeException
$cp2Exception :: Show ExhentaiError
$cp1Exception :: Typeable ExhentaiError
Exception)