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