Codec.hs

-- @generated by keiro-dsl 0.17.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, JSONPathElement (..), (<?>), 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.Structural.Domain ()
import Conformance.Structural.Bindings qualified as Bindings
import Conformance.Structural.Domain (ArtifactInfo, ArtifactKind, ArtifactLocation, ArtifactMetadata)
import Generated.StructuralConformance.Structural.Shape.ArtifactInfo qualified as ShapeArtifactInfo
import Generated.StructuralConformance.Structural.Shape.ArtifactKind qualified as ShapeArtifactKind
import Generated.StructuralConformance.Structural.Shape.ArtifactLocation qualified as ShapeArtifactLocation
import Generated.StructuralConformance.Structural.Shape.ArtifactMetadata qualified as ShapeArtifactMetadata



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

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

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

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

parseArtifactInfoShape :: Value -> Parser ShapeArtifactInfo.ArtifactInfoShape
parseArtifactInfoShape = withObject "ArtifactInfoShape" $ \objectValue -> do
  rejectUnknownFields "ArtifactInfo" ["artifact_key", "display_name", "artifact_hash", "artifact_kind", "location", "metadata", "active", "tags"] objectValue
  ShapeArtifactInfo.ArtifactInfo
    <$> explicitParseField (parseJSON) objectValue "artifact_key"
    <*> explicitParseField (parseJSON) objectValue "display_name"
    <*> parseOptionalField (pure Nothing) (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseJSON) other0) objectValue "artifact_hash"
    <*> parseOptionalField (pure ShapeArtifactKind.Guide) (parseArtifactKindShape) objectValue "artifact_kind"
    <*> explicitParseField (parseArtifactLocationShape) objectValue "location"
    <*> explicitParseField (parseArtifactMetadataShape) objectValue "metadata"
    <*> parseOptionalField (pure False) (parseJSON) objectValue "active"
    <*> parseOptionalField (pure []) (\value0 -> do items0 <- (parseJSON value0 :: Parser [Value]); traverse (\(index0, item0) -> (parseJSON) item0 <?> Index index0) (zip [0..] items0)) objectValue "tags"

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

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

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

encodeArtifactKindShape :: ShapeArtifactKind.ArtifactKindShape -> Value
encodeArtifactKindShape = \case
  ShapeArtifactKind.Guide -> String "guide"
  ShapeArtifactKind.Reference -> String "reference"

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

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

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

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

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

parseArtifactLocationShape :: Value -> Parser ShapeArtifactLocation.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
      ShapeArtifactLocation.LocalFile <$> explicitParseField (parseJSON) objectValue "contents"
    "local_dir" -> do
      rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
      ShapeArtifactLocation.LocalDir <$> explicitParseField (parseJSON) objectValue "contents"
    "repo_path" -> do
      rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
      ShapeArtifactLocation.RepoPath <$> explicitParseField (parseJSON) objectValue "contents"
    "url" -> do
      rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
      ShapeArtifactLocation.LocUrl <$> explicitParseField (parseJSON) objectValue "contents"
    "canonical" -> do
      rejectUnknownFields "ArtifactLocation" ["tag"] objectValue
      pure ShapeArtifactLocation.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 :: ArtifactMetadata -> Value
encodeArtifactMetadataMapped = encodeArtifactMetadataShape . bindingToShape Bindings.artifactMetadataBinding

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

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

encodeArtifactMetadataShape :: ShapeArtifactMetadata.ArtifactMetadataShape -> Value
encodeArtifactMetadataShape shape =
  object
      [ "note" .= maybe Null (\item0 -> toJSON (item0)) (shape.note)
      ]

parseArtifactMetadataShape :: Value -> Parser ShapeArtifactMetadata.ArtifactMetadataShape
parseArtifactMetadataShape = withObject "ArtifactMetadataShape" $ \objectValue -> do
  ShapeArtifactMetadata.ArtifactMetadata
    <$> explicitParseField (\value0 -> case value0 of Null -> pure Nothing; other0 -> Just <$> (parseJSON) other0) objectValue "note"

artifactCatalogEventTypes :: NonEmpty EventType
artifactCatalogEventTypes = EventType "ArtifactRecorded" :| [EventType "ArtifactAccepted"]

artifactCatalogCodec :: Codec ArtifactCatalogEvent
artifactCatalogCodec =
  Codec
    { eventTypes = artifactCatalogEventTypes
    , 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: " <> renderExpectedEventTypes artifactCatalogEventTypes)

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