Codec.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from aggregate BareStore; do not edit.
module Generated.BareContainers.BareStore.Codec (
    bareStoreCodec,
    parseBareStoreEvent,
    encodeBareStoreEvent,
    encodeBareEnvelopeMapped,
    decodeBareEnvelopeMapped,
    encodeMaybeTextMapped,
    decodeMaybeTextMapped,
    encodeNestedIdsMapped,
    decodeNestedIdsMapped,
    encodeTextListMapped,
    decodeTextListMapped,
    encodeTextMapMapped,
    decodeTextMapMapped,
) where

import Generated.BareContainers.BareStore.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, JSONPathElement (..), (<?>), 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 Generated.BareContainers.Structural.NominalLeaves (encodeItemIdLeaf, parseItemIdLeaf)
import Conformance.BareContainers.Bindings qualified as Bindings
import Conformance.BareContainers.Domain (BareEnvelope, MaybeText, NestedIds, TextList, TextMap)
import Generated.BareContainers.Structural.Shape.BareEnvelope qualified as ShapeBareEnvelope
import Generated.BareContainers.Structural.Shape.MaybeText qualified as ShapeMaybeText
import Generated.BareContainers.Structural.Shape.NestedIds qualified as ShapeNestedIds
import Generated.BareContainers.Structural.Shape.TextList qualified as ShapeTextList
import Generated.BareContainers.Structural.Shape.TextMap qualified as ShapeTextMap



encodeBareEnvelopeMapped :: BareEnvelope -> Value
encodeBareEnvelopeMapped = encodeBareEnvelopeShape . bindingToShape Bindings.bareEnvelopeBinding

parseBareEnvelopeMapped :: Value -> Parser BareEnvelope
parseBareEnvelopeMapped value = bindingFromShape Bindings.bareEnvelopeBinding <$> parseBareEnvelopeShape value

decodeBareEnvelopeMapped :: Value -> Either Text BareEnvelope
decodeBareEnvelopeMapped = mapLeftText . parseEither parseBareEnvelopeMapped

encodeBareEnvelopeShape :: ShapeBareEnvelope.BareEnvelopeShape -> Value
encodeBareEnvelopeShape shape =
  object
      [ "optionalLabel" .= encodeMaybeTextShape (shape.optionalLabel)
      , "labels" .= encodeTextListShape (shape.labels)
      , "attributes" .= encodeTextMapShape (shape.attributes)
      , "nestedIds" .= encodeNestedIdsShape (shape.nestedIds)
      ]

parseBareEnvelopeShape :: Value -> Parser ShapeBareEnvelope.BareEnvelopeShape
parseBareEnvelopeShape = withObject "BareEnvelopeShape" $ \objectValue -> do
  rejectUnknownFields "BareEnvelope" ["optionalLabel", "labels", "attributes", "nestedIds"] objectValue
  ShapeBareEnvelope.BareEnvelope
    <$> parseOptionalField (pure Nothing) (parseMaybeTextShape) objectValue "optionalLabel"
    <*> parseOptionalField (pure []) (parseTextListShape) objectValue "labels"
    <*> parseOptionalField (pure Map.empty) (parseTextMapShape) objectValue "attributes"
    <*> explicitParseField (parseNestedIdsShape) objectValue "nestedIds"

encodeMaybeTextMapped :: MaybeText -> Value
encodeMaybeTextMapped = encodeMaybeTextShape . bindingToShape Bindings.maybeTextBinding

parseMaybeTextMapped :: Value -> Parser MaybeText
parseMaybeTextMapped value = bindingFromShape Bindings.maybeTextBinding <$> parseMaybeTextShape value

decodeMaybeTextMapped :: Value -> Either Text MaybeText
decodeMaybeTextMapped = mapLeftText . parseEither parseMaybeTextMapped

encodeMaybeTextShape :: ShapeMaybeText.MaybeTextShape -> Value
encodeMaybeTextShape value = maybe Null (\item0 -> toJSON (item0)) (value)

parseMaybeTextShape :: Value -> Parser ShapeMaybeText.MaybeTextShape
parseMaybeTextShape = \value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseJSON) other0

encodeNestedIdsMapped :: NestedIds -> Value
encodeNestedIdsMapped = encodeNestedIdsShape . bindingToShape Bindings.nestedIdsBinding

parseNestedIdsMapped :: Value -> Parser NestedIds
parseNestedIdsMapped value = bindingFromShape Bindings.nestedIdsBinding <$> parseNestedIdsShape value

decodeNestedIdsMapped :: Value -> Either Text NestedIds
decodeNestedIdsMapped = mapLeftText . parseEither parseNestedIdsMapped

encodeNestedIdsShape :: ShapeNestedIds.NestedIdsShape -> Value
encodeNestedIdsShape value = toJSON (map (\item0 -> maybe Null (\item1 -> encodeItemIdLeaf item1) (item0)) (value))

parseNestedIdsShape :: Value -> Parser ShapeNestedIds.NestedIdsShape
parseNestedIdsShape = \value0 -> do items0 <- (parseJSON value0 :: Parser [Value]); traverse (\(index0, item0) -> (\value1 -> case value1 of Null -> pure Nothing; other1 -> Just <$> (parseItemIdLeaf) other1) item0 <?> Index index0) (zip [0..] items0)

encodeTextListMapped :: TextList -> Value
encodeTextListMapped = encodeTextListShape . bindingToShape Bindings.textListBinding

parseTextListMapped :: Value -> Parser TextList
parseTextListMapped value = bindingFromShape Bindings.textListBinding <$> parseTextListShape value

decodeTextListMapped :: Value -> Either Text TextList
decodeTextListMapped = mapLeftText . parseEither parseTextListMapped

encodeTextListShape :: ShapeTextList.TextListShape -> Value
encodeTextListShape value = toJSON (map (\item0 -> toJSON (item0)) (value))

parseTextListShape :: Value -> Parser ShapeTextList.TextListShape
parseTextListShape = \value0 -> do items0 <- (parseJSON value0 :: Parser [Value]); traverse (\(index0, item0) -> (parseJSON) item0 <?> Index index0) (zip [0..] items0)

encodeTextMapMapped :: TextMap -> Value
encodeTextMapMapped = encodeTextMapShape . bindingToShape Bindings.textMapBinding

parseTextMapMapped :: Value -> Parser TextMap
parseTextMapMapped value = bindingFromShape Bindings.textMapBinding <$> parseTextMapShape value

decodeTextMapMapped :: Value -> Either Text TextMap
decodeTextMapMapped = mapLeftText . parseEither parseTextMapMapped

encodeTextMapShape :: ShapeTextMap.TextMapShape -> Value
encodeTextMapShape value = toJSON (Map.map (\item0 -> toJSON (item0)) (value))

parseTextMapShape :: Value -> Parser ShapeTextMap.TextMapShape
parseTextMapShape = \value0 -> do items0 <- (parseJSON value0 :: Parser (Map Text Value)); Map.traverseWithKey (\key0 item0 -> (parseJSON) item0 <?> Key (Key.fromText key0)) items0

bareStoreEventTypes :: NonEmpty EventType
bareStoreEventTypes = EventType "StoredValue" :| []

bareStoreCodec :: Codec BareStoreEvent
bareStoreCodec =
  Codec
    { eventTypes = bareStoreEventTypes
    , eventType = \case
        StoredValue{} -> EventType "StoredValue"
    , schemaVersion = 1
    , encode = encodeBareStoreEvent
    , decode = parseBareStoreEvent
    , upcasters = []
    }

encodeBareStoreEvent :: BareStoreEvent -> Value
encodeBareStoreEvent = \case
  StoredValue payload ->
    object
      [ "kind" .= ("StoredValue" :: Text)
      , "optionalLabel" .= encodeMaybeTextMapped payload.optionalLabel
      , "labels" .= encodeTextListMapped payload.labels
      , "attributes" .= encodeTextMapMapped payload.attributes
      , "envelope" .= encodeBareEnvelopeMapped payload.envelope
      ]

parseBareStoreEvent :: EventType -> Value -> Either Text BareStoreEvent
parseBareStoreEvent (EventType tag) = mapLeftText . parseEither (withObject "BareStoreEvent" go)
  where
    go o = do
      case tag of
        "StoredValue" ->
          StoredValue
            <$> ( StoredValueData
                    <$> parseOptionalField (parseMaybeTextMapped Null) parseMaybeTextMapped o "optionalLabel"
                    <*> explicitParseField parseTextListMapped o "labels"
                    <*> explicitParseField parseTextMapMapped o "attributes"
                    <*> explicitParseField parseBareEnvelopeMapped o "envelope"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes bareStoreEventTypes)

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