{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Pinboard.Error
( MonadErrorPinboard
, defaultPinboardError
, pinboardExceptionToEither
, pinboardExceptionToMonadError
, exceptionToMonadErrorPinboard
, tryMonadError
, eitherToMonadError
, eitherToMonadThrow
, PinboardErrorHTTPCode(..)
, PinboardErrorType(..)
, PinboardErrorCode(..)
, PinboardError(..)
) where
import Data.Text (Text, pack)
import Data.Monoid
import Prelude
import Control.Exception.Safe
import Control.Monad.Error.Class (MonadError, throwError)
data PinboardErrorHTTPCode
= BadRequest
| UnAuthorized
| RequestFailed
| Forbidden
| NotFound
| TooManyRequests
| PinboardServerError
| UnknownHTTPCode
deriving (Show)
data PinboardErrorType
= ConnectionFailure
| HttpStatusFailure
| ParseFailure
| UnknownErrorType
deriving (Eq, Show)
data PinboardErrorCode =
UnknownError
deriving (Show)
data PinboardError = PinboardError
{ errorType :: PinboardErrorType
, errorMsg :: !Text
, errorCode :: Maybe PinboardErrorCode
, errorParam :: Maybe Text
, errorHTTP :: Maybe PinboardErrorHTTPCode
} deriving (Show)
instance Exception PinboardError
type MonadErrorPinboard m = MonadError PinboardError m
defaultPinboardError :: PinboardError
defaultPinboardError = PinboardError UnknownErrorType mempty Nothing Nothing Nothing
pinboardExceptionToEither
:: MonadCatch m
=> m (Either PinboardError a) -> m (Either PinboardError a)
pinboardExceptionToEither = handle (\(e :: PinboardError) -> return (Left e))
tryMonadError
:: (Exception e, MonadCatch m, MonadError e r)
=> m a -> m (r a)
tryMonadError a = eitherToMonadError <$> try a
pinboardExceptionToMonadError
:: (MonadCatch m, MonadErrorPinboard e)
=> m (e a) -> m (e a)
pinboardExceptionToMonadError =
handle (\(e :: PinboardError) -> return (throwError e))
exceptionToMonadErrorPinboard
:: (MonadCatch m, MonadErrorPinboard e)
=> m (e a) -> m (e a)
exceptionToMonadErrorPinboard =
handle
(\(e :: SomeException) ->
return $
throwError $
defaultPinboardError
{ errorMsg = (pack . show) e
})
eitherToMonadError
:: MonadError e m
=> Either e a -> m a
eitherToMonadError = either throwError return
eitherToMonadThrow
:: (Exception e, MonadThrow m)
=> Either e a -> m a
eitherToMonadThrow = either throw return