Codec.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.8.0.0 (language keiro-dsl 4) from aggregate ScalarAccount; do not edit.
module Generated.AggregateScalarExpressions.ScalarAccount.Codec (
    scalarAccountCodec,
    parseScalarAccountEvent,
    encodeScalarAccountEvent,
    encodeLimitsMapped,
    decodeLimitsMapped,
) where

import Generated.AggregateScalarExpressions.ScalarAccount.Domain
import Generated.AggregateScalarExpressions.Nominals (AccountMode (..), accountModeText, RequestId, requestIdText)
import Generated.AggregateScalarExpressions.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.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 Generated.AggregateScalarExpressions.Structural.Shape.Limits qualified
import ScalarExpressions.Bindings qualified
import ScalarExpressions.Domain qualified

parseAccountMode :: Text -> Parser AccountMode
parseAccountMode = \case
  "normal" -> pure Normal
  "restricted" -> pure Restricted
  tag -> fail ("unknown AccountMode " <> show tag <> "; expected one of: normal, restricted")

encodeLimitsMapped :: ScalarExpressions.Domain.Limits -> Value
encodeLimitsMapped = encodeLimitsShape . bindingToShape ScalarExpressions.Bindings.limitsBinding

parseLimitsMapped :: Value -> Parser ScalarExpressions.Domain.Limits
parseLimitsMapped value = bindingFromShape ScalarExpressions.Bindings.limitsBinding <$> parseLimitsShape value

decodeLimitsMapped :: Value -> Either Text ScalarExpressions.Domain.Limits
decodeLimitsMapped = mapLeftText . parseEither parseLimitsMapped

encodeLimitsShape :: Generated.AggregateScalarExpressions.Structural.Shape.Limits.LimitsShape -> Value
encodeLimitsShape shape =
  object
      [ "minimum" .= toJSON (Generated.AggregateScalarExpressions.Structural.Shape.Limits.minimum shape)
      , "ceiling" .= toJSON (Generated.AggregateScalarExpressions.Structural.Shape.Limits.ceiling shape)
      ]

parseLimitsShape :: Value -> Parser Generated.AggregateScalarExpressions.Structural.Shape.Limits.LimitsShape
parseLimitsShape = withObject "LimitsShape" $ \objectValue -> do
  rejectUnknownFields "Limits" ["minimum", "ceiling"] objectValue
  Generated.AggregateScalarExpressions.Structural.Shape.Limits.Limits
    <$> explicitParseField (parseJSON) objectValue "minimum"
    <*> explicitParseField (parseJSON) objectValue "ceiling"

scalarAccountCodec :: Codec ScalarAccountEvent
scalarAccountCodec =
  Codec
    { eventTypes = EventType "Adjusted" :| [EventType "ClosedEvent"]
    , eventType = \case
        Adjusted{} -> EventType "Adjusted"
        ClosedEvent{} -> EventType "ClosedEvent"
    , schemaVersion = 1
    , encode = encodeScalarAccountEvent
    , decode = parseScalarAccountEvent
    , upcasters = []
    }

encodeScalarAccountEvent :: ScalarAccountEvent -> Value
encodeScalarAccountEvent = \case
  Adjusted payload ->
    object
      [ "kind" .= ("Adjusted" :: Text)
      , "balance" .= payload.balance
      , "requested" .= payload.requested
      , "machine" .= payload.machine
      , "label" .= payload.label
      , "active" .= payload.active
      , "mode" .= accountModeText payload.mode
      , "requestId" .= requestIdText payload.requestId
      , "observedAt" .= payload.observedAt
      , "limits" .= encodeLimitsMapped payload.limits
      ]
  ClosedEvent payload ->
    object
      [ "kind" .= ("ClosedEvent" :: Text)
      , "balance" .= payload.balance
      ]

parseScalarAccountEvent :: EventType -> Value -> Either Text ScalarAccountEvent
parseScalarAccountEvent (EventType tag) = mapLeftText . parseEither (withObject "ScalarAccountEvent" go)
  where
    go o = do
      case tag of
        "Adjusted" ->
          Adjusted
            <$> ( AdjustedData
                    <$> o .: "balance"
                    <*> o .: "requested"
                    <*> o .: "machine"
                    <*> o .: "label"
                    <*> o .: "active"
                    <*> explicitParseField (withText "AccountMode" parseAccountMode) o "mode"
                    <*> (unsafeRequestIdFromLegacyText <$> o .: "requestId")
                    <*> o .: "observedAt"
                    <*> explicitParseField parseLimitsMapped o "limits"
                )
        "ClosedEvent" ->
          ClosedEvent
            <$> ( ClosedEventData
                    <$> o .: "balance"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: Adjusted, ClosedEvent")

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