Queue.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.12.0.0 (language keiro-dsl 5) from workqueue mapped_jobs; do not edit.
module Generated.MappedQueue.MappedJobs.Queue
  ( MappedJob (..)
  , encodeMappedJob
  , parseMappedJob
  , encodeJobMetadataMapped
  , decodeJobMetadataMapped
  , encodeJobPayloadMapped
  , decodeJobPayloadMapped
  , 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, explicitParseField, parseEither)
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec.Structural (bindingFromShape, bindingToShape)
import Conformance.MappedQueue.Bindings qualified as Bindings
import Conformance.MappedQueue.Domain (JobMetadata, JobPayload)
import Generated.MappedQueue.Structural.Shape.JobMetadata qualified as ShapeJobMetadata
import Generated.MappedQueue.Structural.Shape.JobPayload qualified as ShapeJobPayload

queuePhysical, queueDlq, queueTable :: Text
queuePhysical = "mapped_jobs"
queueDlq = "mapped_jobs_dlq"
queueTable = "pgmq.q_mapped_jobs"

data MappedJob = MappedJob
  { job :: !JobPayload
  , maybeJob :: !(Maybe JobPayload)
  , trace :: !Value
  }
  deriving stock (Eq, Show)

encodeJobMetadataMapped :: JobMetadata -> Value
encodeJobMetadataMapped = encodeJobMetadataShape . bindingToShape Bindings.jobMetadataBinding

parseJobMetadataMapped :: Value -> Parser JobMetadata
parseJobMetadataMapped value = bindingFromShape Bindings.jobMetadataBinding <$> parseJobMetadataShape value

decodeJobMetadataMapped :: Value -> Either Text JobMetadata
decodeJobMetadataMapped = mapLeftText . parseEither parseJobMetadataMapped

encodeJobMetadataShape :: ShapeJobMetadata.JobMetadataShape -> Value
encodeJobMetadataShape shape =
  object
      [ "note" .= maybe Null (\item -> toJSON (item)) (ShapeJobMetadata.note shape)
      ]

parseJobMetadataShape :: Value -> Parser ShapeJobMetadata.JobMetadataShape
parseJobMetadataShape = withObject "JobMetadataShape" $ \objectValue -> do
  ShapeJobMetadata.JobMetadata
    <$> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) objectValue "note"

encodeJobPayloadMapped :: JobPayload -> Value
encodeJobPayloadMapped = encodeJobPayloadShape . bindingToShape Bindings.jobPayloadBinding

parseJobPayloadMapped :: Value -> Parser JobPayload
parseJobPayloadMapped value = bindingFromShape Bindings.jobPayloadBinding <$> parseJobPayloadShape value

decodeJobPayloadMapped :: Value -> Either Text JobPayload
decodeJobPayloadMapped = mapLeftText . parseEither parseJobPayloadMapped

encodeJobPayloadShape :: ShapeJobPayload.JobPayloadShape -> Value
encodeJobPayloadShape shape =
  object
      [ "job_id" .= toJSON (ShapeJobPayload.jobId shape)
      , "label" .= toJSON (ShapeJobPayload.label shape)
      , "metadata" .= maybe Null (\item -> encodeJobMetadataShape (item)) (ShapeJobPayload.metadata shape)
      , "geometry" .= toJSON (ShapeJobPayload.geometry shape)
      ]

parseJobPayloadShape :: Value -> Parser ShapeJobPayload.JobPayloadShape
parseJobPayloadShape = withObject "JobPayloadShape" $ \objectValue -> do
  rejectUnknownFields "JobPayload" ["job_id", "label", "metadata", "geometry"] objectValue
  ShapeJobPayload.JobPayload
    <$> explicitParseField (parseJSON) objectValue "job_id"
    <*> explicitParseField (parseJSON) objectValue "label"
    <*> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJobMetadataShape other) objectValue "metadata"
    <*> explicitParseField (parseJSON) objectValue "geometry"

encodeMappedJob :: MappedJob -> Value
encodeMappedJob payload =
  object
    [ "job" .= encodeJobPayloadMapped payload.job
    , "maybe_job" .= maybe Null (\item -> encodeJobPayloadMapped item) (payload.maybeJob)
    , "trace" .= payload.trace
    ]

parseMappedJob :: Value -> Either Text MappedJob
parseMappedJob = mapLeftText . parseEither (withObject "MappedJob" go)
  where
    go objectValue = MappedJob <$> explicitParseField (parseJobPayloadMapped) objectValue "job" <*> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJobPayloadMapped other) objectValue "maybe_job" <*> explicitParseField (pure) objectValue "trace"

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