Codec.hs

-- @generated by keiro-dsl 0.22.0.0 (language keiro-dsl 6) from aggregate ScopeGate; do not edit.
module Generated.MappedStructuralEnumEquality.ScopeGate.Codec (
    scopeGateCodec,
    parseScopeGateEvent,
    encodeScopeGateEvent,
    encodeRequestMapped,
    decodeRequestMapped,
    encodeRequiredScopeMapped,
    decodeRequiredScopeMapped,
) where

import Generated.MappedStructuralEnumEquality.ScopeGate.Domain
import Control.Monad (unless)
import Data.Aeson (Value (..), object, 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.List.NonEmpty qualified as NonEmpty
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec.Structural (bindingFromShape, bindingToShape)
import Keiro.Codec (Codec (..), EventType (..))


import Conformance.MappedStructuralEnumEquality.Bindings qualified as Bindings
import Conformance.MappedStructuralEnumEquality.Domain (Request, RequiredScope)
import Generated.MappedStructuralEnumEquality.Structural.Shape.Request qualified as ShapeRequest
import Generated.MappedStructuralEnumEquality.Structural.Shape.RequiredScope qualified as ShapeRequiredScope



encodeRequestMapped :: Request -> Value
encodeRequestMapped = encodeRequestShape . bindingToShape Bindings.requestBinding

parseRequestMapped :: Value -> Parser Request
parseRequestMapped value = bindingFromShape Bindings.requestBinding <$> parseRequestShape value

decodeRequestMapped :: Value -> Either Text Request
decodeRequestMapped = mapLeftText . parseEither parseRequestMapped

encodeRequestShape :: ShapeRequest.RequestShape -> Value
encodeRequestShape shape =
  object
      [ "requiredScope" .= encodeRequiredScopeShape (shape.requiredScope)
      ]

parseRequestShape :: Value -> Parser ShapeRequest.RequestShape
parseRequestShape = withObject "RequestShape" $ \objectValue -> do
  rejectUnknownFields "Request" ["requiredScope"] objectValue
  ShapeRequest.Request
    <$> explicitParseField (parseRequiredScopeShape) objectValue "requiredScope"

encodeRequiredScopeMapped :: RequiredScope -> Value
encodeRequiredScopeMapped = encodeRequiredScopeShape . bindingToShape Bindings.requiredScopeBinding

parseRequiredScopeMapped :: Value -> Parser RequiredScope
parseRequiredScopeMapped value = bindingFromShape Bindings.requiredScopeBinding <$> parseRequiredScopeShape value

decodeRequiredScopeMapped :: Value -> Either Text RequiredScope
decodeRequiredScopeMapped = mapLeftText . parseEither parseRequiredScopeMapped

encodeRequiredScopeShape :: ShapeRequiredScope.RequiredScopeShape -> Value
encodeRequiredScopeShape = \case
  ShapeRequiredScope.PipelineScope -> String "pipeline"
  ShapeRequiredScope.DiagnosticScope -> String "diagnostic"

parseRequiredScopeShape :: Value -> Parser ShapeRequiredScope.RequiredScopeShape
parseRequiredScopeShape = withText "RequiredScopeShape" $ \tag -> case tag of
  "pipeline" -> pure ShapeRequiredScope.PipelineScope
  "diagnostic" -> pure ShapeRequiredScope.DiagnosticScope
  unknownTag -> fail ("unknown RequiredScope wire value " <> show unknownTag <> "; expected one of: pipeline, diagnostic")

scopeGateEventTypes :: NonEmpty EventType
scopeGateEventTypes = EventType "Matched" :| [EventType "Differed", EventType "EqRightAccepted", EventType "EqLeftAccepted", EventType "NeRightAccepted", EventType "NeLeftAccepted", EventType "SelfAccepted"]

scopeGateCodec :: Codec ScopeGateEvent
scopeGateCodec =
  Codec
    { eventTypes = scopeGateEventTypes
    , eventType = \case
        Matched{} -> EventType "Matched"
        Differed{} -> EventType "Differed"
        EqRightAccepted{} -> EventType "EqRightAccepted"
        EqLeftAccepted{} -> EventType "EqLeftAccepted"
        NeRightAccepted{} -> EventType "NeRightAccepted"
        NeLeftAccepted{} -> EventType "NeLeftAccepted"
        SelfAccepted{} -> EventType "SelfAccepted"
    , schemaVersion = 1
    , encode = encodeScopeGateEvent
    , decode = parseScopeGateEvent
    , upcasters = []
    }

encodeScopeGateEvent :: ScopeGateEvent -> Value
encodeScopeGateEvent = \case
  Matched payload ->
    object
      [ "kind" .= ("Matched" :: Text)
      , "requiredScope" .= encodeRequiredScopeMapped payload.requiredScope
      , "request" .= encodeRequestMapped payload.request
      ]
  Differed payload ->
    object
      [ "kind" .= ("Differed" :: Text)
      , "requiredScope" .= encodeRequiredScopeMapped payload.requiredScope
      , "request" .= encodeRequestMapped payload.request
      ]
  EqRightAccepted payload ->
    object
      [ "kind" .= ("EqRightAccepted" :: Text)
      , "requiredScope" .= encodeRequiredScopeMapped payload.requiredScope
      , "request" .= encodeRequestMapped payload.request
      ]
  EqLeftAccepted payload ->
    object
      [ "kind" .= ("EqLeftAccepted" :: Text)
      , "requiredScope" .= encodeRequiredScopeMapped payload.requiredScope
      , "request" .= encodeRequestMapped payload.request
      ]
  NeRightAccepted payload ->
    object
      [ "kind" .= ("NeRightAccepted" :: Text)
      , "requiredScope" .= encodeRequiredScopeMapped payload.requiredScope
      , "request" .= encodeRequestMapped payload.request
      ]
  NeLeftAccepted payload ->
    object
      [ "kind" .= ("NeLeftAccepted" :: Text)
      , "requiredScope" .= encodeRequiredScopeMapped payload.requiredScope
      , "request" .= encodeRequestMapped payload.request
      ]
  SelfAccepted payload ->
    object
      [ "kind" .= ("SelfAccepted" :: Text)
      , "requiredScope" .= encodeRequiredScopeMapped payload.requiredScope
      , "request" .= encodeRequestMapped payload.request
      ]

parseScopeGateEvent :: EventType -> Value -> Either Text ScopeGateEvent
parseScopeGateEvent (EventType tag) = mapLeftText . parseEither (withObject "ScopeGateEvent" go)
  where
    go o = do
      case tag of
        "Matched" ->
          Matched
            <$> ( MatchedData
                    <$> explicitParseField parseRequiredScopeMapped o "requiredScope"
                    <*> explicitParseField parseRequestMapped o "request"
                )
        "Differed" ->
          Differed
            <$> ( DifferedData
                    <$> explicitParseField parseRequiredScopeMapped o "requiredScope"
                    <*> explicitParseField parseRequestMapped o "request"
                )
        "EqRightAccepted" ->
          EqRightAccepted
            <$> ( EqRightAcceptedData
                    <$> explicitParseField parseRequiredScopeMapped o "requiredScope"
                    <*> explicitParseField parseRequestMapped o "request"
                )
        "EqLeftAccepted" ->
          EqLeftAccepted
            <$> ( EqLeftAcceptedData
                    <$> explicitParseField parseRequiredScopeMapped o "requiredScope"
                    <*> explicitParseField parseRequestMapped o "request"
                )
        "NeRightAccepted" ->
          NeRightAccepted
            <$> ( NeRightAcceptedData
                    <$> explicitParseField parseRequiredScopeMapped o "requiredScope"
                    <*> explicitParseField parseRequestMapped o "request"
                )
        "NeLeftAccepted" ->
          NeLeftAccepted
            <$> ( NeLeftAcceptedData
                    <$> explicitParseField parseRequiredScopeMapped o "requiredScope"
                    <*> explicitParseField parseRequestMapped o "request"
                )
        "SelfAccepted" ->
          SelfAccepted
            <$> ( SelfAcceptedData
                    <$> explicitParseField parseRequiredScopeMapped o "requiredScope"
                    <*> explicitParseField parseRequestMapped o "request"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes scopeGateEventTypes)

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

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