never executed always true always false

    1 {-# LANGUAGE FlexibleContexts #-}
    2 {-# LANGUAGE OverloadedStrings #-}
    3 {-# LANGUAGE UndecidableInstances #-}
    4 
    5 {-# OPTIONS_GHC -fno-warn-orphans #-}
    6 
    7 -- |
    8 -- Copyright: © 2018-2021 IOHK
    9 -- License: Apache-2.0
   10 --
   11 -- Utility functions for internal use of the library.
   12 
   13 module Cardano.Address.Internal
   14     ( orElse
   15     , WithErrorMessage (..)
   16     , DeserialiseFailure (..)
   17     ) where
   18 
   19 import Prelude
   20 
   21 import Codec.CBOR.Read
   22     ( DeserialiseFailure (..) )
   23 import Control.Exception
   24     ( Exception (..) )
   25 import Data.Aeson
   26     ( GToJSON
   27     , Options (..)
   28     , SumEncoding (..)
   29     , ToJSON (..)
   30     , Value (..)
   31     , Zero
   32     , defaultOptions
   33     , genericToJSON
   34     , object
   35     , toJSON
   36     , (.=)
   37     )
   38 import GHC.Generics
   39     ( Generic, Rep )
   40 
   41 orElse :: Either e a -> Either e a -> Either e a
   42 orElse (Right a) _ = Right a
   43 orElse (Left _) ea = ea
   44 
   45 errToJSON :: (Exception e, Generic e, GToJSON Zero (Rep e)) => e -> Value
   46 errToJSON err = object
   47     [ "error" .= genericToJSON opts err
   48     , "message" .= toJSON (displayException err)
   49     ]
   50   where
   51     opts = defaultOptions { sumEncoding = errorCodes }
   52     errorCodes = TaggedObject "code" "details"
   53 
   54 newtype WithErrorMessage e = WithErrorMessage { withErrorMessage :: e }
   55 
   56 instance (Exception e, Generic e, GToJSON Zero (Rep e)) => ToJSON (WithErrorMessage e) where
   57     toJSON = errToJSON . withErrorMessage
   58 
   59 instance ToJSON DeserialiseFailure where
   60     toJSON (DeserialiseFailure off msg) = object
   61         [ "code" .= String "Codec.CBOR.DeserialiseFailure"
   62         , "details" .= object [ "byteOffset" .= off, "message" .= msg ]
   63         ]