Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate NominalLedger; do not edit.
module Generated.NominalScalars.NominalLedger.Codec (
    nominalLedgerCodec,
    parseNominalLedgerEvent,
    encodeNominalLedgerEvent,
) where

import Generated.NominalScalars.NominalLedger.Domain
import Data.Aeson (Value, object, withObject, withText, (.:), (.=))
import Data.Aeson.Types (Parser, explicitParseField, parseEither)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text (Text)
import qualified Data.Text as T
import Data.KindID qualified as KindID
import Keiro.Codec.IdDomain (typeIdV7Domain, validateIdDomainText)
import Keiro.Codec.Nominal (nominalFromRepresentation, nominalToRepresentation)
import Keiro.Codec (Codec (..), EventType (..))


import Generated.NominalScalars.Nominal.Shape.OrderStatus qualified as ShapeOrderStatus
import NominalConformance.Bindings qualified as Bindings
import NominalConformance.Domain (AccountNumber, FeatureFlag, ObservedAt, OrderId, OrderStatus, RiskScore, SequenceNumber)








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

parseOrderStatusNominal :: Text -> Parser OrderStatus
parseOrderStatusNominal = \case
  "draft" -> pure (nominalFromRepresentation Bindings.orderStatusBinding ShapeOrderStatus.Draft)
  "submitted" -> pure (nominalFromRepresentation Bindings.orderStatusBinding ShapeOrderStatus.Submitted)
  tag -> fail ("unknown OrderStatus wire value " <> show tag <> "; expected one of: draft, submitted")





nominalLedgerEventTypes :: NonEmpty EventType
nominalLedgerEventTypes = EventType "NominalsRecorded" :| []

nominalLedgerCodec :: Codec NominalLedgerEvent
nominalLedgerCodec =
  Codec
    { eventTypes = nominalLedgerEventTypes
    , 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" .= ShapeOrderStatus.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 o = do
      case tag of
        "NominalsRecorded" ->
          NominalsRecorded
            <$> ( NominalsRecordedData
                    <$> explicitParseField (withText "OrderId" parseOrderIdNominal) o "orderId"
                    <*> explicitParseField (withText "OrderStatus" parseOrderStatusNominal) o "status"
                    <*> (nominalFromRepresentation Bindings.accountNumberBinding <$> o .: "accountNumber")
                    <*> (nominalFromRepresentation Bindings.riskScoreBinding <$> o .: "riskScore")
                    <*> (nominalFromRepresentation Bindings.sequenceNumberBinding <$> o .: "sequenceNumber")
                    <*> (nominalFromRepresentation Bindings.featureFlagBinding <$> o .: "featureFlag")
                    <*> (nominalFromRepresentation Bindings.observedAtBinding <$> o .: "observedAt")
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> _renderEventTypes nominalLedgerEventTypes)

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

_renderEventTypes :: NonEmpty EventType -> String
_renderEventTypes =
  T.unpack
    . T.intercalate ", "
    . map (\(EventType eventTypeName) -> eventTypeName)
    . NonEmpty.toList