keiro-dsl-0.9.0.0: test/conformance-structural/Generated/StructuralConformance/ArtifactCatalog/Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.8.0.0 (language keiro-dsl 4) from aggregate ArtifactCatalog; do not edit.
module Generated.StructuralConformance.ArtifactCatalog.Codec (
    artifactCatalogCodec,
    parseArtifactCatalogEvent,
    encodeArtifactCatalogEvent,
    encodeArtifactInfoMapped,
    decodeArtifactInfoMapped,
    encodeArtifactKindMapped,
    decodeArtifactKindMapped,
    encodeArtifactLocationMapped,
    decodeArtifactLocationMapped,
    encodeArtifactMetadataMapped,
    decodeArtifactMetadataMapped,
) where

import Generated.StructuralConformance.ArtifactCatalog.Domain
import Control.Monad (unless)
import Data.Aeson (Value (..), object, parseJSON, toJSON, 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.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 Conformance.Structural.Bindings qualified
import Conformance.Structural.Domain qualified
import Generated.StructuralConformance.Structural.Shape.ArtifactInfo qualified
import Generated.StructuralConformance.Structural.Shape.ArtifactKind qualified
import Generated.StructuralConformance.Structural.Shape.ArtifactLocation qualified
import Generated.StructuralConformance.Structural.Shape.ArtifactMetadata qualified



encodeArtifactInfoMapped :: Conformance.Structural.Domain.ArtifactInfo -> Value
encodeArtifactInfoMapped = encodeArtifactInfoShape . bindingToShape Conformance.Structural.Bindings.artifactInfoBinding

parseArtifactInfoMapped :: Value -> Parser Conformance.Structural.Domain.ArtifactInfo
parseArtifactInfoMapped value = bindingFromShape Conformance.Structural.Bindings.artifactInfoBinding <$> parseArtifactInfoShape value

decodeArtifactInfoMapped :: Value -> Either Text Conformance.Structural.Domain.ArtifactInfo
decodeArtifactInfoMapped = mapLeftText . parseEither parseArtifactInfoMapped

encodeArtifactInfoShape :: Generated.StructuralConformance.Structural.Shape.ArtifactInfo.ArtifactInfoShape -> Value
encodeArtifactInfoShape shape =
  object
      [ "artifact_key" .= toJSON (Generated.StructuralConformance.Structural.Shape.ArtifactInfo.artifactKey shape)
      , "display_name" .= toJSON (Generated.StructuralConformance.Structural.Shape.ArtifactInfo.displayName shape)
      , "artifact_hash" .= maybe Null (\item -> toJSON (item)) (Generated.StructuralConformance.Structural.Shape.ArtifactInfo.artifactHash shape)
      , "artifact_kind" .= encodeArtifactKindShape (Generated.StructuralConformance.Structural.Shape.ArtifactInfo.artifactKind shape)
      , "location" .= encodeArtifactLocationShape (Generated.StructuralConformance.Structural.Shape.ArtifactInfo.location shape)
      , "metadata" .= encodeArtifactMetadataShape (Generated.StructuralConformance.Structural.Shape.ArtifactInfo.metadata shape)
      , "active" .= toJSON (Generated.StructuralConformance.Structural.Shape.ArtifactInfo.active shape)
      , "tags" .= toJSON (map (\item -> toJSON (item)) (Generated.StructuralConformance.Structural.Shape.ArtifactInfo.tags shape))
      ]

parseArtifactInfoShape :: Value -> Parser Generated.StructuralConformance.Structural.Shape.ArtifactInfo.ArtifactInfoShape
parseArtifactInfoShape = withObject "ArtifactInfoShape" $ \objectValue -> do
  rejectUnknownFields "ArtifactInfo" ["artifact_key", "display_name", "artifact_hash", "artifact_kind", "location", "metadata", "active", "tags"] objectValue
  Generated.StructuralConformance.Structural.Shape.ArtifactInfo.ArtifactInfo
    <$> explicitParseField (parseJSON) objectValue "artifact_key"
    <*> explicitParseField (parseJSON) objectValue "display_name"
    <*> (case KeyMap.lookup (Key.fromText "artifact_hash") objectValue of Nothing -> pure Nothing; Just _ -> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) objectValue "artifact_hash")
    <*> (case KeyMap.lookup (Key.fromText "artifact_kind") objectValue of Nothing -> pure Generated.StructuralConformance.Structural.Shape.ArtifactKind.Guide; Just _ -> explicitParseField (parseArtifactKindShape) objectValue "artifact_kind")
    <*> explicitParseField (parseArtifactLocationShape) objectValue "location"
    <*> explicitParseField (parseArtifactMetadataShape) objectValue "metadata"
    <*> (case KeyMap.lookup (Key.fromText "active") objectValue of Nothing -> pure False; Just _ -> explicitParseField (parseJSON) objectValue "active")
    <*> (case KeyMap.lookup (Key.fromText "tags") objectValue of Nothing -> pure []; Just _ -> explicitParseField (\value -> (parseJSON value :: Parser [Value]) >>= traverse (parseJSON)) objectValue "tags")

encodeArtifactKindMapped :: Conformance.Structural.Domain.ArtifactKind -> Value
encodeArtifactKindMapped = encodeArtifactKindShape . bindingToShape Conformance.Structural.Bindings.artifactKindBinding

parseArtifactKindMapped :: Value -> Parser Conformance.Structural.Domain.ArtifactKind
parseArtifactKindMapped value = bindingFromShape Conformance.Structural.Bindings.artifactKindBinding <$> parseArtifactKindShape value

decodeArtifactKindMapped :: Value -> Either Text Conformance.Structural.Domain.ArtifactKind
decodeArtifactKindMapped = mapLeftText . parseEither parseArtifactKindMapped

encodeArtifactKindShape :: Generated.StructuralConformance.Structural.Shape.ArtifactKind.ArtifactKindShape -> Value
encodeArtifactKindShape = \case
  Generated.StructuralConformance.Structural.Shape.ArtifactKind.Guide -> String "guide"
  Generated.StructuralConformance.Structural.Shape.ArtifactKind.Reference -> String "reference"

parseArtifactKindShape :: Value -> Parser Generated.StructuralConformance.Structural.Shape.ArtifactKind.ArtifactKindShape
parseArtifactKindShape = withText "ArtifactKindShape" $ \tag -> case tag of
  "guide" -> pure Generated.StructuralConformance.Structural.Shape.ArtifactKind.Guide
  "reference" -> pure Generated.StructuralConformance.Structural.Shape.ArtifactKind.Reference
  tag -> fail ("unknown ArtifactKind wire value " <> show tag <> "; expected one of: guide, reference")

encodeArtifactLocationMapped :: Conformance.Structural.Domain.ArtifactLocation -> Value
encodeArtifactLocationMapped = encodeArtifactLocationShape . bindingToShape Conformance.Structural.Bindings.artifactLocationBinding

parseArtifactLocationMapped :: Value -> Parser Conformance.Structural.Domain.ArtifactLocation
parseArtifactLocationMapped value = bindingFromShape Conformance.Structural.Bindings.artifactLocationBinding <$> parseArtifactLocationShape value

decodeArtifactLocationMapped :: Value -> Either Text Conformance.Structural.Domain.ArtifactLocation
decodeArtifactLocationMapped = mapLeftText . parseEither parseArtifactLocationMapped

encodeArtifactLocationShape :: Generated.StructuralConformance.Structural.Shape.ArtifactLocation.ArtifactLocationShape -> Value
encodeArtifactLocationShape = \case
  Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocalFile payload ->
    object
      [ "tag" .= ("local_file" :: Text)
      , "contents" .= toJSON (payload)
      ]
  Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocalDir payload ->
    object
      [ "tag" .= ("local_dir" :: Text)
      , "contents" .= toJSON (payload)
      ]
  Generated.StructuralConformance.Structural.Shape.ArtifactLocation.RepoPath payload ->
    object
      [ "tag" .= ("repo_path" :: Text)
      , "contents" .= toJSON (payload)
      ]
  Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocUrl payload ->
    object
      [ "tag" .= ("url" :: Text)
      , "contents" .= toJSON (payload)
      ]
  Generated.StructuralConformance.Structural.Shape.ArtifactLocation.Canonical ->
    object
      [ "tag" .= ("canonical" :: Text)
      ]

parseArtifactLocationShape :: Value -> Parser Generated.StructuralConformance.Structural.Shape.ArtifactLocation.ArtifactLocationShape
parseArtifactLocationShape = withObject "ArtifactLocationShape" $ \objectValue -> do
  tag <- explicitParseField (withText "ArtifactLocation tag" validateArtifactLocationTag) objectValue "tag"
  case tag of
    "local_file" -> do
      rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
      Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocalFile <$> explicitParseField (parseJSON) objectValue "contents"
    "local_dir" -> do
      rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
      Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocalDir <$> explicitParseField (parseJSON) objectValue "contents"
    "repo_path" -> do
      rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
      Generated.StructuralConformance.Structural.Shape.ArtifactLocation.RepoPath <$> explicitParseField (parseJSON) objectValue "contents"
    "url" -> do
      rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
      Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocUrl <$> explicitParseField (parseJSON) objectValue "contents"
    "canonical" -> do
      rejectUnknownFields "ArtifactLocation" ["tag"] objectValue
      pure Generated.StructuralConformance.Structural.Shape.ArtifactLocation.Canonical
    _ -> fail "validated union tag was not handled"

validateArtifactLocationTag :: Text -> Parser Text
validateArtifactLocationTag tag
  | tag `elem` ["local_file", "local_dir", "repo_path", "url", "canonical"] = pure tag
  | otherwise = fail ("unknown ArtifactLocation union tag " <> show tag <> "; expected one of: local_file, local_dir, repo_path, url, canonical")

encodeArtifactMetadataMapped :: Conformance.Structural.Domain.ArtifactMetadata -> Value
encodeArtifactMetadataMapped = encodeArtifactMetadataShape . bindingToShape Conformance.Structural.Bindings.artifactMetadataBinding

parseArtifactMetadataMapped :: Value -> Parser Conformance.Structural.Domain.ArtifactMetadata
parseArtifactMetadataMapped value = bindingFromShape Conformance.Structural.Bindings.artifactMetadataBinding <$> parseArtifactMetadataShape value

decodeArtifactMetadataMapped :: Value -> Either Text Conformance.Structural.Domain.ArtifactMetadata
decodeArtifactMetadataMapped = mapLeftText . parseEither parseArtifactMetadataMapped

encodeArtifactMetadataShape :: Generated.StructuralConformance.Structural.Shape.ArtifactMetadata.ArtifactMetadataShape -> Value
encodeArtifactMetadataShape shape =
  object
      [ "note" .= maybe Null (\item -> toJSON (item)) (Generated.StructuralConformance.Structural.Shape.ArtifactMetadata.note shape)
      ]

parseArtifactMetadataShape :: Value -> Parser Generated.StructuralConformance.Structural.Shape.ArtifactMetadata.ArtifactMetadataShape
parseArtifactMetadataShape = withObject "ArtifactMetadataShape" $ \objectValue -> do
  Generated.StructuralConformance.Structural.Shape.ArtifactMetadata.ArtifactMetadata
    <$> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) objectValue "note"

artifactCatalogCodec :: Codec ArtifactCatalogEvent
artifactCatalogCodec =
  Codec
    { eventTypes = EventType "ArtifactRecorded" :| [EventType "ArtifactAccepted"]
    , eventType = \case
        ArtifactRecorded{} -> EventType "ArtifactRecorded"
        ArtifactAccepted{} -> EventType "ArtifactAccepted"
    , schemaVersion = 1
    , encode = encodeArtifactCatalogEvent
    , decode = parseArtifactCatalogEvent
    , upcasters = []
    }

encodeArtifactCatalogEvent :: ArtifactCatalogEvent -> Value
encodeArtifactCatalogEvent = \case
  ArtifactRecorded payload ->
    object
      [ "kind" .= ("ArtifactRecorded" :: Text)
      , "artifact" .= encodeArtifactInfoMapped payload.artifact
      , "geometry" .= toJSON payload.geometry
      , "accepted" .= payload.accepted
      ]
  ArtifactAccepted payload ->
    object
      [ "kind" .= ("ArtifactAccepted" :: Text)
      , "accepted" .= payload.accepted
      ]

parseArtifactCatalogEvent :: EventType -> Value -> Either Text ArtifactCatalogEvent
parseArtifactCatalogEvent (EventType tag) = mapLeftText . parseEither (withObject "ArtifactCatalogEvent" go)
  where
    go o = do
      case tag of
        "ArtifactRecorded" ->
          ArtifactRecorded
            <$> ( ArtifactRecordedData
                    <$> explicitParseField parseArtifactInfoMapped o "artifact"
                    <*> o .: "geometry"
                    <*> o .: "accepted"
                )
        "ArtifactAccepted" ->
          ArtifactAccepted
            <$> ( ArtifactAcceptedData
                    <$> o .: "accepted"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: ArtifactRecorded, ArtifactAccepted")

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