Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.11.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, (.:), (.=))
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.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.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: " <> renderExpectedEventTypes collisionLedgerEventTypes)

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

renderExpectedEventTypes :: NonEmpty EventType -> String
renderExpectedEventTypes =
  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))