-- | Passing through errors to external libraries that use @MonadFail@

module Cardano.Prelude.Error
  ( toAesonError
  , aesonError
  , toCborError
  , cborError
  , wrapError
  , orThrowError
  )
where

import Cardano.Prelude.Base

import qualified Codec.CBOR.Decoding as CBOR
import Control.Monad (fail)
import Control.Monad.Except (liftEither)
import qualified Data.Aeson.Types as A
import Formatting (build, formatToString)
import Formatting.Buildable (Buildable)


-- | Convert an 'Either'-encoded error to an 'aeson' parser error
toAesonError :: Buildable e => Either e a -> A.Parser a
toAesonError :: Either e a -> Parser a
toAesonError = (e -> Parser a) -> (a -> Parser a) -> Either e a -> Parser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Parser a
forall e a. Buildable e => e -> Parser a
aesonError a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Convert a @Buildable@ error into an 'aeson' parser error
aesonError :: Buildable e => e -> A.Parser a
aesonError :: e -> Parser a
aesonError = String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> (e -> String) -> e -> Parser a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format String (e -> String) -> e -> String
forall a. Format String a -> a
formatToString Format String (e -> String)
forall a r. Buildable a => Format r (a -> r)
build

-- | Convert an 'Either'-encoded failure to a 'cborg' decoder failure
toCborError :: Buildable e => Either e a -> CBOR.Decoder s a
toCborError :: Either e a -> Decoder s a
toCborError = (e -> Decoder s a)
-> (a -> Decoder s a) -> Either e a -> Decoder s a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> Decoder s a
forall e s a. Buildable e => e -> Decoder s a
cborError a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Convert a @Buildable@ error into a 'cborg' decoder error
cborError :: Buildable e => e -> CBOR.Decoder s a
cborError :: e -> Decoder s a
cborError = String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s a) -> (e -> String) -> e -> Decoder s a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format String (e -> String) -> e -> String
forall a. Format String a -> a
formatToString Format String (e -> String)
forall a r. Buildable a => Format r (a -> r)
build


-- | A helper for lifting an 'Either' to a 'MonadError'
--
--   By using this function infix we can move the error handling to the end of
--   an expression, hopefully improving readability.
wrapError :: MonadError e' m => Either e a -> (e -> e') -> m a
wrapError :: Either e a -> (e -> e') -> m a
wrapError Either e a
m e -> e'
wrapper = Either e' a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either e' a -> m a) -> Either e' a -> m a
forall a b. (a -> b) -> a -> b
$ (e -> e') -> Either e a -> Either e' a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first e -> e'
wrapper Either e a
m

infix 1 `wrapError`


-- | A helper for lifting 'unless' to 'MonadError'
--
--   By using this function infix we can move error handling to the end of a
--   'Bool' expression, hopefully improving readability.
orThrowError :: MonadError e m => Bool -> e -> m ()
orThrowError :: Bool -> e -> m ()
orThrowError Bool
condition = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
condition (m () -> m ()) -> (e -> m ()) -> e -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. e -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

infix 1 `orThrowError`