Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.11.0.0 (language keiro-dsl 4) from aggregate Journey; do not edit.
module Generated.BehaviorComplete.Journey.Codec (
    journeyCodec,
    parseJourneyEvent,
    encodeJourneyEvent,
    encodeStartPayloadMapped,
    decodeStartPayloadMapped,
) where

import Generated.BehaviorComplete.Journey.Domain
import Generated.BehaviorComplete.Nominals (requestIdText)
import Generated.BehaviorComplete.Nominals.Internal (unsafeRequestIdFromLegacyText)
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.Structural (bindingFromShape, bindingToShape)
import Keiro.Codec (Codec (..), EventType (..))


import BehaviorComplete.Bindings qualified as Bindings
import BehaviorComplete.Domain (StartPayload)
import Generated.BehaviorComplete.Structural.Shape.StartPayload qualified as ShapeStartPayload



encodeStartPayloadMapped :: StartPayload -> Value
encodeStartPayloadMapped = encodeStartPayloadShape . bindingToShape Bindings.startPayloadBinding

parseStartPayloadMapped :: Value -> Parser StartPayload
parseStartPayloadMapped value = bindingFromShape Bindings.startPayloadBinding <$> parseStartPayloadShape value

decodeStartPayloadMapped :: Value -> Either Text StartPayload
decodeStartPayloadMapped = mapLeftText . parseEither parseStartPayloadMapped

encodeStartPayloadShape :: ShapeStartPayload.StartPayloadShape -> Value
encodeStartPayloadShape shape =
  object
      [ "display_label" .= toJSON (ShapeStartPayload.label shape)
      , "optional_note" .= maybe Null (\item -> toJSON (item)) (ShapeStartPayload.note shape)
      ]

parseStartPayloadShape :: Value -> Parser ShapeStartPayload.StartPayloadShape
parseStartPayloadShape = withObject "StartPayloadShape" $ \objectValue -> do
  rejectUnknownFields "StartPayload" ["display_label", "optional_note"] objectValue
  ShapeStartPayload.StartPayload
    <$> explicitParseField (parseJSON) objectValue "display_label"
    <*> parseOptionalField (pure Nothing) (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) objectValue "optional_note"

journeyEventTypes :: NonEmpty EventType
journeyEventTypes = EventType "Started" :| [EventType "DecisionRecorded", EventType "Retired", EventType "RetirementAudited", EventType "LegacyStarted"]

journeyCodec :: Codec JourneyEvent
journeyCodec =
  Codec
    { eventTypes = journeyEventTypes
    , eventType = \case
        Started{} -> EventType "Started"
        DecisionRecorded{} -> EventType "DecisionRecorded"
        Retired{} -> EventType "Retired"
        RetirementAudited{} -> EventType "RetirementAudited"
        LegacyStarted{} -> EventType "LegacyStarted"
    , schemaVersion = 1
    , encode = encodeJourneyEvent
    , decode = parseJourneyEvent
    , upcasters = []
    }

encodeJourneyEvent :: JourneyEvent -> Value
encodeJourneyEvent = \case
  Started payload ->
    object
      [ "kind" .= ("Started" :: Text)
      , "requestId" .= requestIdText payload.requestId
      , "observedAt" .= payload.observedAt
      , "amount" .= payload.amount
      , "details" .= encodeStartPayloadMapped payload.details
      ]
  DecisionRecorded payload ->
    object
      [ "kind" .= ("DecisionRecorded" :: Text)
      , "amount" .= payload.amount
      ]
  Retired payload ->
    object
      [ "kind" .= ("Retired" :: Text)
      , "amount" .= payload.amount
      ]
  RetirementAudited payload ->
    object
      [ "kind" .= ("RetirementAudited" :: Text)
      , "amount" .= payload.amount
      ]
  LegacyStarted payload ->
    object
      [ "kind" .= ("LegacyStarted" :: Text)
      , "amount" .= payload.amount
      ]

parseJourneyEvent :: EventType -> Value -> Either Text JourneyEvent
parseJourneyEvent (EventType tag) = mapLeftText . parseEither (withObject "JourneyEvent" go)
  where
    go o = do
      case tag of
        "Started" ->
          Started
            <$> ( StartedData
                    <$> (unsafeRequestIdFromLegacyText <$> o .: "requestId")
                    <*> o .: "observedAt"
                    <*> o .: "amount"
                    <*> explicitParseField parseStartPayloadMapped o "details"
                )
        "DecisionRecorded" ->
          DecisionRecorded
            <$> ( DecisionRecordedData
                    <$> o .: "amount"
                )
        "Retired" ->
          Retired
            <$> ( RetiredData
                    <$> o .: "amount"
                )
        "RetirementAudited" ->
          RetirementAudited
            <$> ( RetirementAuditedData
                    <$> o .: "amount"
                )
        "LegacyStarted" ->
          LegacyStarted
            <$> ( LegacyStartedData
                    <$> o .: "amount"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes journeyEventTypes)

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

parseOptionalField :: Parser fieldValue -> (Value -> Parser fieldValue) -> KeyMap.KeyMap Value -> Key.Key -> Parser fieldValue
parseOptionalField onMissing parseItem objectValue key =
  case KeyMap.lookup key objectValue of
    Nothing -> onMissing
    Just _ -> explicitParseField parseItem objectValue key

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))