Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.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 (RequestId, requestIdText)
import Generated.BehaviorComplete.Nominals.Internal (unsafeRequestIdFromLegacyText)
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.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"
    <*> (case KeyMap.lookup (Key.fromText "optional_note") objectValue of Nothing -> pure Nothing; Just _ -> explicitParseField (\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"]

journeyCodec :: Codec JourneyEvent
journeyCodec =
  Codec
    { eventTypes = journeyEventTypes
    , eventType = \case
        Started{} -> EventType "Started"
        DecisionRecorded{} -> EventType "DecisionRecorded"
        Retired{} -> EventType "Retired"
        RetirementAudited{} -> EventType "RetirementAudited"
    , 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
      ]

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"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> _renderEventTypes journeyEventTypes)

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