Codec.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE TypeApplications #-}

-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.NominalScalars.NominalLedger.Codec (
    nominalLedgerCodec,
    parseNominalLedgerEvent,
    encodeNominalLedgerEvent,
) where

import Data.Aeson (Value, object, withObject, (.:), (.=))
import Data.Aeson.Types (Parser, parseEither)
import qualified Data.KindID as KindID
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Generated.NominalScalars.Nominal.Shape.OrderStatus as Representation
import Generated.NominalScalars.NominalLedger.Domain
import Keiro.Codec (Codec (..), EventType (..))
import Keiro.Codec.Nominal (nominalFromRepresentation, nominalToRepresentation)
import qualified NominalConformance.Bindings as Bindings
import qualified NominalConformance.Domain

parseOrderIdNominal :: Text -> Parser NominalConformance.Domain.OrderId
parseOrderIdNominal input = case KindID.parseText @"ord" input of
    Left reason -> fail (show reason)
    Right representation -> pure (nominalFromRepresentation Bindings.orderIdBinding representation)

parseOrderStatusNominal :: Text -> Parser NominalConformance.Domain.OrderStatus
parseOrderStatusNominal = \case
    "draft" -> pure (nominalFromRepresentation Bindings.orderStatusBinding Representation.Draft)
    "submitted" -> pure (nominalFromRepresentation Bindings.orderStatusBinding Representation.Submitted)
    _ -> fail "unknown OrderStatus wire value"

nominalLedgerCodec :: Codec NominalLedgerEvent
nominalLedgerCodec =
    Codec
        { eventTypes = EventType "NominalsRecorded" :| []
        , eventType = \case NominalsRecorded{} -> EventType "NominalsRecorded"
        , schemaVersion = 1
        , encode = encodeNominalLedgerEvent
        , decode = parseNominalLedgerEvent
        , upcasters = []
        }

encodeNominalLedgerEvent :: NominalLedgerEvent -> Value
encodeNominalLedgerEvent = \case
    NominalsRecorded payload ->
        object
            [ "kind" .= ("NominalsRecorded" :: Text)
            , "orderId" .= KindID.toText (nominalToRepresentation Bindings.orderIdBinding payload.orderId)
            , "status" .= Representation.orderStatusRepresentationText (nominalToRepresentation Bindings.orderStatusBinding payload.status)
            , "accountNumber" .= nominalToRepresentation Bindings.accountNumberBinding payload.accountNumber
            , "riskScore" .= nominalToRepresentation Bindings.riskScoreBinding payload.riskScore
            , "sequenceNumber" .= nominalToRepresentation Bindings.sequenceNumberBinding payload.sequenceNumber
            , "featureFlag" .= nominalToRepresentation Bindings.featureFlagBinding payload.featureFlag
            , "observedAt" .= nominalToRepresentation Bindings.observedAtBinding payload.observedAt
            ]

parseNominalLedgerEvent :: EventType -> Value -> Either Text NominalLedgerEvent
parseNominalLedgerEvent (EventType tag) = mapLeftText . parseEither (withObject "NominalLedgerEvent" go)
  where
    go objectValue = case tag of
        "NominalsRecorded" ->
            NominalsRecorded
                <$> ( NominalsRecordedData
                        <$> (objectValue .: "orderId" >>= parseOrderIdNominal)
                        <*> (objectValue .: "status" >>= parseOrderStatusNominal)
                        <*> (nominalFromRepresentation Bindings.accountNumberBinding <$> objectValue .: "accountNumber")
                        <*> (nominalFromRepresentation Bindings.riskScoreBinding <$> objectValue .: "riskScore")
                        <*> (nominalFromRepresentation Bindings.sequenceNumberBinding <$> objectValue .: "sequenceNumber")
                        <*> (nominalFromRepresentation Bindings.featureFlagBinding <$> objectValue .: "featureFlag")
                        <*> (nominalFromRepresentation Bindings.observedAtBinding <$> objectValue .: "observedAt")
                    )
        _ -> fail "unknown event type"

mapLeftText :: Either String value -> Either Text value
mapLeftText = either (Left . T.pack) Right