Codec.hs

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

import Generated.BehaviorComplete.Journey.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, parseEither)
import Data.List.NonEmpty (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
import BehaviorComplete.Domain qualified
import Generated.BehaviorComplete.Structural.Shape.StartPayload qualified



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

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

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

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

parseStartPayloadShape :: Value -> Parser Generated.BehaviorComplete.Structural.Shape.StartPayload.StartPayloadShape
parseStartPayloadShape = withObject "StartPayloadShape" $ \objectValue -> do
  rejectUnknownFields "StartPayload" ["display_label", "optional_note"] objectValue
  Generated.BehaviorComplete.Structural.Shape.StartPayload.StartPayload
    <$> ((objectValue .: "display_label" :: Parser Value) >>= (parseJSON))
    <*> (case KeyMap.lookup (Key.fromText "optional_note") objectValue of Nothing -> pure Nothing; Just presentValue -> (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) presentValue)

journeyCodec :: Codec JourneyEvent
journeyCodec =
  Codec
    { eventTypes = EventType "Started" :| [EventType "DecisionRecorded", EventType "Retired", EventType "RetirementAudited"]
    , 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 <$> (RequestId <$> o .: "requestId") <*> o .: "observedAt" <*> o .: "amount" <*> (o .: "details" >>= parseStartPayloadMapped))
        "DecisionRecorded" ->
          DecisionRecorded <$> (DecisionRecordedData <$> o .: "amount")
        "Retired" ->
          Retired <$> (RetiredData <$> o .: "amount")
        "RetirementAudited" ->
          RetirementAudited <$> (RetirementAuditedData <$> o .: "amount")
        _ -> fail "unknown event type"

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

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