Queue.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from workqueue identity_work; do not edit.
module Generated.IdAdmissionDomains.IdentityWork.Queue
  ( IdentityWork (..)
  , encodeIdentityWork
  , parseIdentityWork
  , encodeIdentityEnvelopeMapped
  , decodeIdentityEnvelopeMapped
  , queuePhysical, queueDlq, queueTable

  ) where

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.Map.Strict qualified as Map
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec.Structural (bindingFromShape, bindingToShape)
import Generated.IdAdmissionDomains.Structural.NominalLeaves (encodeLegacyIdLeaf, parseLegacyIdLeaf)
import Generated.IdAdmissionDomains.Structural.NominalLeaves (parseLegacyIdLeafKey, renderLegacyIdLeafKey)
import Conformance.IdAdmissionDomains.Bindings qualified as Bindings
import Conformance.IdAdmissionDomains.Domain (IdentityEnvelope)
import Generated.IdAdmissionDomains.Nominals (LegacyId)
import Generated.IdAdmissionDomains.Structural.Shape.IdentityEnvelope qualified as ShapeIdentityEnvelope

queuePhysical, queueDlq, queueTable :: Text
queuePhysical = "identity_work"
queueDlq = "identity_work_dlq"
queueTable = "pgmq.q_identity_work"

data IdentityWork = IdentityWork
  { legacyId :: !LegacyId
  , envelope :: !IdentityEnvelope
  }
  deriving stock (Eq, Show)

encodeIdentityEnvelopeMapped :: IdentityEnvelope -> Value
encodeIdentityEnvelopeMapped = encodeIdentityEnvelopeShape . bindingToShape Bindings.identityEnvelopeBinding

parseIdentityEnvelopeMapped :: Value -> Parser IdentityEnvelope
parseIdentityEnvelopeMapped value = bindingFromShape Bindings.identityEnvelopeBinding <$> parseIdentityEnvelopeShape value

decodeIdentityEnvelopeMapped :: Value -> Either Text IdentityEnvelope
decodeIdentityEnvelopeMapped = mapLeftText . parseEither parseIdentityEnvelopeMapped

encodeIdentityEnvelopeShape :: ShapeIdentityEnvelope.IdentityEnvelopeShape -> Value
encodeIdentityEnvelopeShape shape =
  object
      [ "legacyId" .= encodeLegacyIdLeaf shape.legacyId
      , "previousId" .= maybe Null (\item0 -> encodeLegacyIdLeaf item0) (shape.previousId)
      , "labelsById" .= Object (KeyMap.fromList [(Key.fromText (renderLegacyIdLeafKey key0), toJSON (item0)) | (key0, item0) <- Map.toList (shape.labelsById)])
      ]

parseIdentityEnvelopeShape :: Value -> Parser ShapeIdentityEnvelope.IdentityEnvelopeShape
parseIdentityEnvelopeShape = withObject "IdentityEnvelopeShape" $ \objectValue -> do
  rejectUnknownFields "IdentityEnvelope" ["legacyId", "previousId", "labelsById"] objectValue
  ShapeIdentityEnvelope.IdentityEnvelope
    <$> explicitParseField (parseLegacyIdLeaf) objectValue "legacyId"
    <*> parseOptionalField (pure Nothing) (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseLegacyIdLeaf) other0) objectValue "previousId"
    <*> explicitParseField (\value0 -> withObject "Map[LegacyId]" (\object0 -> Map.fromList <$> traverse (\(rawKey0, item0) -> do key0 <- parseLegacyIdLeafKey (Key.toText rawKey0) <?> Key rawKey0; parsedItem0 <- (parseJSON) item0 <?> Key rawKey0; pure (key0, parsedItem0)) (KeyMap.toList object0)) value0) objectValue "labelsById"

encodeIdentityWork :: IdentityWork -> Value
encodeIdentityWork payload =
  object
    [ "legacy_id" .= encodeLegacyIdLeaf payload.legacyId
    , "envelope" .= encodeIdentityEnvelopeMapped payload.envelope
    ]

parseIdentityWork :: Value -> Either Text IdentityWork
parseIdentityWork = mapLeftText . parseEither (withObject "IdentityWork" go)
  where
    go objectValue = IdentityWork <$> explicitParseField (parseLegacyIdLeaf) objectValue "legacy_id" <*> explicitParseField (parseIdentityEnvelopeMapped) objectValue "envelope"

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

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