{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Pinboard.Error
-- Copyright   : (c) Jon Schoning, 2015
-- Maintainer  : jonschoning@gmail.com
-- Stability   : experimental
-- Portability : POSIX
module Pinboard.Error
  ( defaultPinboardError
  , PinboardErrorHTTPCode(..)
  , PinboardErrorType(..)
  , PinboardErrorCode(..)
  , PinboardError(..)
  ) where

import Data.Text (Text)

import Data.Monoid
import Prelude

import UnliftIO

------------------------------------------------------------------------------
data PinboardErrorHTTPCode
  = BadRequest -- ^ 400
  | UnAuthorized -- ^ 401
  | RequestFailed -- ^ 402
  | Forbidden -- ^ 403
  | NotFound -- ^ 404
  | TooManyRequests -- ^ 429
  | PinboardServerError -- ^ (>=500)
  | UnknownHTTPCode -- ^ All other codes
  deriving (Int -> PinboardErrorHTTPCode -> ShowS
[PinboardErrorHTTPCode] -> ShowS
PinboardErrorHTTPCode -> String
(Int -> PinboardErrorHTTPCode -> ShowS)
-> (PinboardErrorHTTPCode -> String)
-> ([PinboardErrorHTTPCode] -> ShowS)
-> Show PinboardErrorHTTPCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinboardErrorHTTPCode] -> ShowS
$cshowList :: [PinboardErrorHTTPCode] -> ShowS
show :: PinboardErrorHTTPCode -> String
$cshow :: PinboardErrorHTTPCode -> String
showsPrec :: Int -> PinboardErrorHTTPCode -> ShowS
$cshowsPrec :: Int -> PinboardErrorHTTPCode -> ShowS
Show)

------------------------------------------------------------------------------
data PinboardErrorType
  = ConnectionFailure
  | HttpStatusFailure
  | ParseFailure
  | UnknownErrorType
  deriving (PinboardErrorType -> PinboardErrorType -> Bool
(PinboardErrorType -> PinboardErrorType -> Bool)
-> (PinboardErrorType -> PinboardErrorType -> Bool)
-> Eq PinboardErrorType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PinboardErrorType -> PinboardErrorType -> Bool
$c/= :: PinboardErrorType -> PinboardErrorType -> Bool
== :: PinboardErrorType -> PinboardErrorType -> Bool
$c== :: PinboardErrorType -> PinboardErrorType -> Bool
Eq, Int -> PinboardErrorType -> ShowS
[PinboardErrorType] -> ShowS
PinboardErrorType -> String
(Int -> PinboardErrorType -> ShowS)
-> (PinboardErrorType -> String)
-> ([PinboardErrorType] -> ShowS)
-> Show PinboardErrorType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinboardErrorType] -> ShowS
$cshowList :: [PinboardErrorType] -> ShowS
show :: PinboardErrorType -> String
$cshow :: PinboardErrorType -> String
showsPrec :: Int -> PinboardErrorType -> ShowS
$cshowsPrec :: Int -> PinboardErrorType -> ShowS
Show)

------------------------------------------------------------------------------
data PinboardErrorCode =
  UnknownError
  deriving (Int -> PinboardErrorCode -> ShowS
[PinboardErrorCode] -> ShowS
PinboardErrorCode -> String
(Int -> PinboardErrorCode -> ShowS)
-> (PinboardErrorCode -> String)
-> ([PinboardErrorCode] -> ShowS)
-> Show PinboardErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinboardErrorCode] -> ShowS
$cshowList :: [PinboardErrorCode] -> ShowS
show :: PinboardErrorCode -> String
$cshow :: PinboardErrorCode -> String
showsPrec :: Int -> PinboardErrorCode -> ShowS
$cshowsPrec :: Int -> PinboardErrorCode -> ShowS
Show)

------------------------------------------------------------------------------
data PinboardError = PinboardError
  { PinboardError -> PinboardErrorType
errorType :: PinboardErrorType
  , PinboardError -> Text
errorMsg :: !Text
  , PinboardError -> Maybe PinboardErrorCode
errorCode :: Maybe PinboardErrorCode
  , PinboardError -> Maybe Text
errorParam :: Maybe Text
  , PinboardError -> Maybe PinboardErrorHTTPCode
errorHTTP :: Maybe PinboardErrorHTTPCode
  } deriving (Int -> PinboardError -> ShowS
[PinboardError] -> ShowS
PinboardError -> String
(Int -> PinboardError -> ShowS)
-> (PinboardError -> String)
-> ([PinboardError] -> ShowS)
-> Show PinboardError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PinboardError] -> ShowS
$cshowList :: [PinboardError] -> ShowS
show :: PinboardError -> String
$cshow :: PinboardError -> String
showsPrec :: Int -> PinboardError -> ShowS
$cshowsPrec :: Int -> PinboardError -> ShowS
Show)

instance Exception PinboardError

defaultPinboardError :: PinboardError
defaultPinboardError :: PinboardError
defaultPinboardError = PinboardErrorType
-> Text
-> Maybe PinboardErrorCode
-> Maybe Text
-> Maybe PinboardErrorHTTPCode
-> PinboardError
PinboardError PinboardErrorType
UnknownErrorType Text
forall a. Monoid a => a
mempty Maybe PinboardErrorCode
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe PinboardErrorHTTPCode
forall a. Maybe a
Nothing