Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}

-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.StructuralConformance.ArtifactCatalog.Codec (
    artifactCatalogCodec,
    parseArtifactCatalogEvent,
    encodeArtifactCatalogEvent,
    encodeArtifactInfoMapped,
    decodeArtifactInfoMapped,
    encodeArtifactKindMapped,
    decodeArtifactKindMapped,
    encodeArtifactLocationMapped,
    decodeArtifactLocationMapped,
    encodeArtifactMetadataMapped,
    decodeArtifactMetadataMapped,
) where

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, parseEither)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Text qualified as T
import Generated.StructuralConformance.ArtifactCatalog.Domain
import Keiro.Codec (Codec (..), EventType (..))
import Keiro.Codec.Structural (bindingFromShape, bindingToShape)

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
        <$> ((objectValue .: "artifact_key" :: Parser Value) >>= (parseJSON))
        <*> ((objectValue .: "display_name" :: Parser Value) >>= (parseJSON))
        <*> (case KeyMap.lookup (Key.fromText "artifact_hash") objectValue of Nothing -> pure Nothing; Just presentValue -> (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other) presentValue)
        <*> (case KeyMap.lookup (Key.fromText "artifact_kind") objectValue of Nothing -> pure Generated.StructuralConformance.Structural.Shape.ArtifactKind.Guide; Just presentValue -> (parseArtifactKindShape) presentValue)
        <*> ((objectValue .: "location" :: Parser Value) >>= (parseArtifactLocationShape))
        <*> ((objectValue .: "metadata" :: Parser Value) >>= (parseArtifactMetadataShape))
        <*> (case KeyMap.lookup (Key.fromText "active") objectValue of Nothing -> pure False; Just presentValue -> (parseJSON) presentValue)
        <*> (case KeyMap.lookup (Key.fromText "tags") objectValue of Nothing -> pure []; Just presentValue -> (\value -> (parseJSON value :: Parser [Value]) >>= traverse (parseJSON)) presentValue)

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
    _ -> fail "unknown ArtifactKind wire value"

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 <- objectValue .: "tag" :: Parser Text
    case tag of
        "local_file" -> do
            rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
            Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocalFile <$> (objectValue .: "contents" >>= (parseJSON))
        "local_dir" -> do
            rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
            Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocalDir <$> (objectValue .: "contents" >>= (parseJSON))
        "repo_path" -> do
            rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
            Generated.StructuralConformance.Structural.Shape.ArtifactLocation.RepoPath <$> (objectValue .: "contents" >>= (parseJSON))
        "url" -> do
            rejectUnknownFields "ArtifactLocation" ["tag", "contents"] objectValue
            Generated.StructuralConformance.Structural.Shape.ArtifactLocation.LocUrl <$> (objectValue .: "contents" >>= (parseJSON))
        "canonical" -> do
            rejectUnknownFields "ArtifactLocation" ["tag"] objectValue
            pure Generated.StructuralConformance.Structural.Shape.ArtifactLocation.Canonical
        _ -> fail "unknown ArtifactLocation union tag"

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
        <$> ((objectValue .: "note" :: Parser Value) >>= (\value -> case value of Null -> pure Nothing; other -> Just <$> parseJSON other))

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 <$> (o .: "artifact" >>= parseArtifactInfoMapped) <*> o .: "geometry" <*> o .: "accepted")
            "ArtifactAccepted" ->
                ArtifactAccepted <$> (ArtifactAcceptedData <$> o .: "accepted")
            _ -> fail "unknown event type"

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