{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- that's what this module is all about
module Plutus.PAB.Instances() where

import Cardano.BM.Data.Tracer (ToObject (..), TracingVerbosity (..))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Servant.Client (ClientError)

import Cardano.BM.Data.Tracer.Extras (StructuredLog, Tagged (..), mkObjectStr)
import Control.Monad.Logger (Loc, LogSource)
import Data.OpenApi.Internal.ParamSchema qualified as OpenApi
import Servant.API (FromHttpApiData, ToHttpApiData)
import Wallet.Emulator.Wallet (WalletEvent (..))
import Wallet.Types (ContractInstanceId (..))

deriving via (Tagged "location" Loc) instance StructuredLog Loc
deriving via (Tagged "source" LogSource) instance StructuredLog LogSource

instance ToObject WalletEvent where
    toObject :: TracingVerbosity -> WalletEvent -> KeyMap Value
toObject TracingVerbosity
v = \case
        GenericLog LogSource
t ->
            LogSource -> Tagged "message" LogSource -> KeyMap Value
forall k. StructuredLog k => LogSource -> k -> KeyMap Value
mkObjectStr LogSource
"generic log" (LogSource -> Tagged "message" LogSource
forall k (s :: k) b. b -> Tagged s b
Tagged @"message" LogSource
t)
        CheckpointLog CheckpointLogMsg
msg ->
            LogSource -> CheckpointLogMsg -> KeyMap Value
forall k. StructuredLog k => LogSource -> k -> KeyMap Value
mkObjectStr LogSource
"checkpoint log" CheckpointLogMsg
msg
        RequestHandlerLog RequestHandlerLogMsg
msg ->
            LogSource -> RequestHandlerLogMsg -> KeyMap Value
forall k. StructuredLog k => LogSource -> k -> KeyMap Value
mkObjectStr LogSource
"request handler log" RequestHandlerLogMsg
msg
        TxBalanceLog TxBalanceMsg
msg ->
            LogSource -> Either TxBalanceMsg () -> KeyMap Value
forall k. StructuredLog k => LogSource -> k -> KeyMap Value
mkObjectStr LogSource
"tx balance log" (Either TxBalanceMsg () -> KeyMap Value)
-> Either TxBalanceMsg () -> KeyMap Value
forall a b. (a -> b) -> a -> b
$
                case TracingVerbosity
v of
                    TracingVerbosity
MaximalVerbosity -> TxBalanceMsg -> Either TxBalanceMsg ()
forall a b. a -> Either a b
Left TxBalanceMsg
msg
                    TracingVerbosity
_                -> () -> Either TxBalanceMsg ()
forall a b. b -> Either a b
Right ()

deriving instance ToJSON Loc
deriving instance FromJSON Loc

-- 'ClientError' is not a simple type. Adding orphan 'ToJSON'/'FromJSON'
-- instances for it would require about 10 standalone deriving clauses,
-- plus a number of libraries added to 'build-depends'.
--
-- I also believe that the chances of the instances actually being needed
-- are low. Therefore I went with the two incorrect instances below.

instance FromJSON ClientError where
    parseJSON :: Value -> Parser ClientError
parseJSON Value
_ = String -> Parser ClientError
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"FromJSON ClientError: Not Implemented"

instance ToJSON ClientError where
    toJSON :: ClientError -> Value
toJSON = String -> Value
forall a. ToJSON a => a -> Value
toJSON (String -> Value)
-> (ClientError -> String) -> ClientError -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientError -> String
forall a. Show a => a -> String
show

deriving newtype instance ToHttpApiData ContractInstanceId
deriving newtype instance FromHttpApiData ContractInstanceId

deriving newtype instance OpenApi.ToParamSchema ContractInstanceId