{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Cardano.Address.Internal
( orElse
, WithErrorMessage (..)
, DeserialiseFailure (..)
) where
import Prelude
import Codec.CBOR.Read
( DeserialiseFailure (..) )
import Control.Exception
( Exception (..) )
import Data.Aeson
( GToJSON
, Options (..)
, SumEncoding (..)
, ToJSON (..)
, Value (..)
, Zero
, defaultOptions
, genericToJSON
, object
, toJSON
, (.=)
)
import GHC.Generics
( Generic, Rep )
orElse :: Either e a -> Either e a -> Either e a
orElse :: Either e a -> Either e a -> Either e a
orElse (Right a
a) Either e a
_ = a -> Either e a
forall a b. b -> Either a b
Right a
a
orElse (Left e
_) Either e a
ea = Either e a
ea
errToJSON :: (Exception e, Generic e, GToJSON Zero (Rep e)) => e -> Value
errToJSON :: e -> Value
errToJSON e
err = [Pair] -> Value
object
[ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Options -> e -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
opts e
err
, Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String -> Value
forall a. ToJSON a => a -> Value
toJSON (e -> String
forall e. Exception e => e -> String
displayException e
err)
]
where
opts :: Options
opts = Options
defaultOptions { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
errorCodes }
errorCodes :: SumEncoding
errorCodes = String -> String -> SumEncoding
TaggedObject String
"code" String
"details"
newtype WithErrorMessage e = WithErrorMessage { WithErrorMessage e -> e
withErrorMessage :: e }
instance (Exception e, Generic e, GToJSON Zero (Rep e)) => ToJSON (WithErrorMessage e) where
toJSON :: WithErrorMessage e -> Value
toJSON = e -> Value
forall e.
(Exception e, Generic e, GToJSON Zero (Rep e)) =>
e -> Value
errToJSON (e -> Value)
-> (WithErrorMessage e -> e) -> WithErrorMessage e -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithErrorMessage e -> e
forall e. WithErrorMessage e -> e
withErrorMessage
instance ToJSON DeserialiseFailure where
toJSON :: DeserialiseFailure -> Value
toJSON (DeserialiseFailure ByteOffset
off String
msg) = [Pair] -> Value
object
[ Key
"code" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"Codec.CBOR.DeserialiseFailure"
, Key
"details" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"byteOffset" Key -> ByteOffset -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteOffset
off, Key
"message" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
msg ]
]