Codec.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from aggregate LabelStore; do not edit.
module Generated.StructuralTextSets.LabelStore.Codec (
    labelStoreCodec,
    parseLabelStoreEvent,
    encodeLabelStoreEvent,
    encodeLabelEnvelopeMapped,
    decodeLabelEnvelopeMapped,
    encodeMaybeTextLabelsMapped,
    decodeMaybeTextLabelsMapped,
    encodeTextLabelsMapped,
    decodeTextLabelsMapped,
) where

import Generated.StructuralTextSets.LabelStore.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.TextSet (encodeTextSet, parseTextSet)
import Keiro.Codec.Structural (bindingFromShape, bindingToShape)
import Keiro.Codec (Codec (..), EventType (..))


import Conformance.StructuralTextSets.Bindings qualified as Bindings
import Conformance.StructuralTextSets.Domain (LabelEnvelope, MaybeTextLabels, TextLabels)
import Generated.StructuralTextSets.Structural.Shape.LabelEnvelope qualified as ShapeLabelEnvelope
import Generated.StructuralTextSets.Structural.Shape.MaybeTextLabels qualified as ShapeMaybeTextLabels
import Generated.StructuralTextSets.Structural.Shape.TextLabels qualified as ShapeTextLabels



encodeLabelEnvelopeMapped :: LabelEnvelope -> Value
encodeLabelEnvelopeMapped = encodeLabelEnvelopeShape . bindingToShape Bindings.labelEnvelopeBinding

parseLabelEnvelopeMapped :: Value -> Parser LabelEnvelope
parseLabelEnvelopeMapped value = bindingFromShape Bindings.labelEnvelopeBinding <$> parseLabelEnvelopeShape value

decodeLabelEnvelopeMapped :: Value -> Either Text LabelEnvelope
decodeLabelEnvelopeMapped = mapLeftText . parseEither parseLabelEnvelopeMapped

encodeLabelEnvelopeShape :: ShapeLabelEnvelope.LabelEnvelopeShape -> Value
encodeLabelEnvelopeShape shape =
  object
      [ "primary" .= encodeTextSet (shape.primary)
      , "optionalLabels" .= maybe Null (\item0 -> encodeTextSet (item0)) (shape.optionalLabels)
      , "namedOptional" .= encodeMaybeTextLabelsShape (shape.namedOptional)
      , "sequence" .= toJSON (map (\item0 -> encodeTextSet (item0)) (shape.sequence))
      , "labelled" .= toJSON (Map.map (\item0 -> encodeTextSet (item0)) (shape.labelled))
      ]

parseLabelEnvelopeShape :: Value -> Parser ShapeLabelEnvelope.LabelEnvelopeShape
parseLabelEnvelopeShape = withObject "LabelEnvelopeShape" $ \objectValue -> do
  rejectUnknownFields "LabelEnvelope" ["primary", "optionalLabels", "namedOptional", "sequence", "labelled"] objectValue
  ShapeLabelEnvelope.LabelEnvelope
    <$> explicitParseField (parseTextSet) objectValue "primary"
    <*> parseOptionalField (pure Nothing) (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseTextSet) other0) objectValue "optionalLabels"
    <*> explicitParseField (parseMaybeTextLabelsShape) objectValue "namedOptional"
    <*> explicitParseField (\value0 -> do items0 <- (parseJSON value0 :: Parser [Value]); traverse (\(index0, item0) -> (parseTextSet) item0 <?> Index index0) (zip [0..] items0)) objectValue "sequence"
    <*> explicitParseField (\value0 -> do items0 <- (parseJSON value0 :: Parser (Map Text Value)); Map.traverseWithKey (\key0 item0 -> (parseTextSet) item0 <?> Key (Key.fromText key0)) items0) objectValue "labelled"

encodeMaybeTextLabelsMapped :: MaybeTextLabels -> Value
encodeMaybeTextLabelsMapped = encodeMaybeTextLabelsShape . bindingToShape Bindings.maybeTextLabelsBinding

parseMaybeTextLabelsMapped :: Value -> Parser MaybeTextLabels
parseMaybeTextLabelsMapped value = bindingFromShape Bindings.maybeTextLabelsBinding <$> parseMaybeTextLabelsShape value

decodeMaybeTextLabelsMapped :: Value -> Either Text MaybeTextLabels
decodeMaybeTextLabelsMapped = mapLeftText . parseEither parseMaybeTextLabelsMapped

encodeMaybeTextLabelsShape :: ShapeMaybeTextLabels.MaybeTextLabelsShape -> Value
encodeMaybeTextLabelsShape value = maybe Null (\item0 -> encodeTextSet (item0)) (value)

parseMaybeTextLabelsShape :: Value -> Parser ShapeMaybeTextLabels.MaybeTextLabelsShape
parseMaybeTextLabelsShape = \value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseTextSet) other0

encodeTextLabelsMapped :: TextLabels -> Value
encodeTextLabelsMapped = encodeTextLabelsShape . bindingToShape Bindings.textLabelsBinding

parseTextLabelsMapped :: Value -> Parser TextLabels
parseTextLabelsMapped value = bindingFromShape Bindings.textLabelsBinding <$> parseTextLabelsShape value

decodeTextLabelsMapped :: Value -> Either Text TextLabels
decodeTextLabelsMapped = mapLeftText . parseEither parseTextLabelsMapped

encodeTextLabelsShape :: ShapeTextLabels.TextLabelsShape -> Value
encodeTextLabelsShape value = encodeTextSet (value)

parseTextLabelsShape :: Value -> Parser ShapeTextLabels.TextLabelsShape
parseTextLabelsShape = parseTextSet

labelStoreEventTypes :: NonEmpty EventType
labelStoreEventTypes = EventType "LabelsStored" :| [EventType "LabelsAudited", EventType "LegacyLabelsImported"]

labelStoreCodec :: Codec LabelStoreEvent
labelStoreCodec =
  Codec
    { eventTypes = labelStoreEventTypes
    , eventType = \case
        LabelsStored{} -> EventType "LabelsStored"
        LabelsAudited{} -> EventType "LabelsAudited"
        LegacyLabelsImported{} -> EventType "LegacyLabelsImported"
    , schemaVersion = 1
    , encode = encodeLabelStoreEvent
    , decode = parseLabelStoreEvent
    , upcasters = []
    }

encodeLabelStoreEvent :: LabelStoreEvent -> Value
encodeLabelStoreEvent = \case
  LabelsStored payload ->
    object
      [ "kind" .= ("LabelsStored" :: Text)
      , "labels" .= encodeTextLabelsMapped payload.labels
      , "optionalLabels" .= encodeMaybeTextLabelsMapped payload.optionalLabels
      , "envelope" .= encodeLabelEnvelopeMapped payload.envelope
      ]
  LabelsAudited payload ->
    object
      [ "kind" .= ("LabelsAudited" :: Text)
      , "labels" .= encodeTextLabelsMapped payload.labels
      , "optionalLabels" .= encodeMaybeTextLabelsMapped payload.optionalLabels
      , "envelope" .= encodeLabelEnvelopeMapped payload.envelope
      ]
  LegacyLabelsImported payload ->
    object
      [ "kind" .= ("LegacyLabelsImported" :: Text)
      , "labels" .= encodeTextLabelsMapped payload.labels
      , "optionalLabels" .= encodeMaybeTextLabelsMapped payload.optionalLabels
      , "envelope" .= encodeLabelEnvelopeMapped payload.envelope
      ]

parseLabelStoreEvent :: EventType -> Value -> Either Text LabelStoreEvent
parseLabelStoreEvent (EventType tag) = mapLeftText . parseEither (withObject "LabelStoreEvent" go)
  where
    go o = do
      case tag of
        "LabelsStored" ->
          LabelsStored
            <$> ( LabelsStoredData
                    <$> explicitParseField parseTextLabelsMapped o "labels"
                    <*> parseOptionalField (parseMaybeTextLabelsMapped Null) parseMaybeTextLabelsMapped o "optionalLabels"
                    <*> explicitParseField parseLabelEnvelopeMapped o "envelope"
                )
        "LabelsAudited" ->
          LabelsAudited
            <$> ( LabelsAuditedData
                    <$> explicitParseField parseTextLabelsMapped o "labels"
                    <*> parseOptionalField (parseMaybeTextLabelsMapped Null) parseMaybeTextLabelsMapped o "optionalLabels"
                    <*> explicitParseField parseLabelEnvelopeMapped o "envelope"
                )
        "LegacyLabelsImported" ->
          LegacyLabelsImported
            <$> ( LegacyLabelsImportedData
                    <$> explicitParseField parseTextLabelsMapped o "labels"
                    <*> parseOptionalField (parseMaybeTextLabelsMapped Null) parseMaybeTextLabelsMapped o "optionalLabels"
                    <*> explicitParseField parseLabelEnvelopeMapped o "envelope"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes labelStoreEventTypes)

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