Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate CollisionLedger; do not edit.
module Generated.ImportPlanningCollisions.CollisionLedger.Codec (
    collisionLedgerCodec,
    parseCollisionLedgerEvent,
    encodeCollisionLedgerEvent,
    encodeDetailsMapped,
    decodeDetailsMapped,
) where

import Generated.ImportPlanningCollisions.CollisionLedger.Domain
import Control.Monad (unless)
import Data.Aeson (Value (..), object, parseJSON, toJSON, withObject, withText, (.:), (.=))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.Types (Parser, explicitParseField, parseEither)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec.Nominal (nominalFromRepresentation, nominalToRepresentation)
import Keiro.Codec.Structural (bindingFromShape, bindingToShape)
import Keiro.Codec (Codec (..), EventType (..))



import Generated.ImportPlanningCollisions.Structural.Shape.Details qualified as ShapeDetails
import ImportPlanning.Bindings qualified as Bindings
import ImportPlanning.Consumer.Domain (CollisionLedgerCommand)
import ImportPlanning.Consumer.Invoice.Types qualified as InvoiceTypes
import ImportPlanning.Consumer.Order.Types qualified as OrderTypes
import ImportPlanning.Consumer.Shared.Types (Details)







encodeDetailsMapped :: Details -> Value
encodeDetailsMapped = encodeDetailsShape . bindingToShape Bindings.detailsBinding

parseDetailsMapped :: Value -> Parser Details
parseDetailsMapped value = bindingFromShape Bindings.detailsBinding <$> parseDetailsShape value

decodeDetailsMapped :: Value -> Either Text Details
decodeDetailsMapped = mapLeftText . parseEither parseDetailsMapped

encodeDetailsShape :: ShapeDetails.DetailsShape -> Value
encodeDetailsShape shape =
  object
      [ "label" .= toJSON (ShapeDetails.label shape)
      ]

parseDetailsShape :: Value -> Parser ShapeDetails.DetailsShape
parseDetailsShape = withObject "DetailsShape" $ \objectValue -> do
  rejectUnknownFields "Details" ["label"] objectValue
  ShapeDetails.Details
    <$> explicitParseField (parseJSON) objectValue "label"

collisionLedgerEventTypes :: NonEmpty EventType
collisionLedgerEventTypes = EventType "RecordedValues" :| []

collisionLedgerCodec :: Codec CollisionLedgerEvent
collisionLedgerCodec =
  Codec
    { eventTypes = collisionLedgerEventTypes
    , eventType = \case
        RecordedValues{} -> EventType "RecordedValues"
    , schemaVersion = 1
    , encode = encodeCollisionLedgerEvent
    , decode = parseCollisionLedgerEvent
    , upcasters = []
    }

encodeCollisionLedgerEvent :: CollisionLedgerEvent -> Value
encodeCollisionLedgerEvent = \case
  RecordedValues payload ->
    object
      [ "kind" .= ("RecordedValues" :: Text)
      , "orderStatus" .= nominalToRepresentation Bindings.orderStatusBinding payload.orderStatus
      , "invoiceStatus" .= nominalToRepresentation Bindings.invoiceStatusBinding payload.invoiceStatus
      , "localCollision" .= nominalToRepresentation Bindings.localCollisionBinding payload.localCollision
      , "details" .= encodeDetailsMapped payload.details
      ]

parseCollisionLedgerEvent :: EventType -> Value -> Either Text CollisionLedgerEvent
parseCollisionLedgerEvent (EventType tag) = mapLeftText . parseEither (withObject "CollisionLedgerEvent" go)
  where
    go o = do
      case tag of
        "RecordedValues" ->
          RecordedValues
            <$> ( RecordedValuesData
                    <$> (nominalFromRepresentation Bindings.orderStatusBinding <$> o .: "orderStatus")
                    <*> (nominalFromRepresentation Bindings.invoiceStatusBinding <$> o .: "invoiceStatus")
                    <*> (nominalFromRepresentation Bindings.localCollisionBinding <$> o .: "localCollision")
                    <*> explicitParseField parseDetailsMapped o "details"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> _renderEventTypes collisionLedgerEventTypes)

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

rejectUnknownFields :: String -> [Text] -> KeyMap.KeyMap Value -> Parser ()
rejectUnknownFields label allowed objectValue =
  unless (null extras) (fail (label <> " contains unknown fields: " <> show extras))
  where
    extras = filter (`notElem` allowed) (map Key.toText (KeyMap.keys objectValue))