Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.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.List.NonEmpty qualified as 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.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 (ShapeArtifactInfo.artifactKey shape)
      , "display_name" .= toJSON (ShapeArtifactInfo.displayName shape)
      , "artifact_hash" .= maybe Null (\item -> toJSON (item)) (ShapeArtifactInfo.artifactHash shape)
      , "artifact_kind" .= encodeArtifactKindShape (ShapeArtifactInfo.artifactKind shape)
      , "location" .= encodeArtifactLocationShape (ShapeArtifactInfo.location shape)
      , "metadata" .= encodeArtifactMetadataShape (ShapeArtifactInfo.metadata shape)
      , "active" .= toJSON (ShapeArtifactInfo.active shape)
      , "tags" .= toJSON (map (\item -> toJSON (item)) (ShapeArtifactInfo.tags shape))
      ]

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"
    <*> (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 ShapeArtifactKind.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 :: 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
  tag -> fail ("unknown ArtifactKind wire value " <> show tag <> "; 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 (\item -> toJSON (item)) (ShapeArtifactMetadata.note shape)
      ]

parseArtifactMetadataShape :: Value -> Parser ShapeArtifactMetadata.ArtifactMetadataShape
parseArtifactMetadataShape = withObject "ArtifactMetadataShape" $ \objectValue -> do
  ShapeArtifactMetadata.ArtifactMetadata
    <$> explicitParseField (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) 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: " <> _renderEventTypes artifactCatalogEventTypes)

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

_renderEventTypes :: NonEmpty EventType -> String
_renderEventTypes =
  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))