Codec.hs

-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate ProjectArtifact; do not edit.
module Generated.WorkspaceNominalProof.ProjectArtifact.Codec (
    projectArtifactCodec,
    parseProjectArtifactEvent,
    encodeProjectArtifactEvent,
    encodeArtifactClaimMapped,
    decodeArtifactClaimMapped,
) where

import Generated.WorkspaceNominalProof.ProjectArtifact.Domain
import Generated.WorkspaceNominalProof.Nominals (projectIdText, ProjectPhase (..), projectPhaseText)
import Generated.WorkspaceNominalProof.Nominals.Internal (unsafeProjectIdFromLegacyText)
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 Generated.WorkspaceNominalProof.Structural.NominalLeaves (encodeClaimIdLeaf, parseClaimIdLeaf)
import Generated.WorkspaceNominalProof.Structural.Shape.ArtifactClaim qualified as ShapeArtifactClaim
import WorkspaceNominalProof.Bindings qualified as Bindings
import WorkspaceNominalProof.Domain (ArtifactClaim)

parseProjectPhase :: Text -> Parser ProjectPhase
parseProjectPhase = \case
  "draft" -> pure Draft
  "active" -> pure Active
  tag -> fail ("unknown ProjectPhase " <> show tag <> "; expected one of: draft, active")

encodeArtifactClaimMapped :: ArtifactClaim -> Value
encodeArtifactClaimMapped = encodeArtifactClaimShape . bindingToShape Bindings.artifactClaimBinding

parseArtifactClaimMapped :: Value -> Parser ArtifactClaim
parseArtifactClaimMapped value = bindingFromShape Bindings.artifactClaimBinding <$> parseArtifactClaimShape value

decodeArtifactClaimMapped :: Value -> Either Text ArtifactClaim
decodeArtifactClaimMapped = mapLeftText . parseEither parseArtifactClaimMapped

encodeArtifactClaimShape :: ShapeArtifactClaim.ArtifactClaimShape -> Value
encodeArtifactClaimShape shape =
  object
      [ "claimId" .= encodeClaimIdLeaf shape.claimId
      ]

parseArtifactClaimShape :: Value -> Parser ShapeArtifactClaim.ArtifactClaimShape
parseArtifactClaimShape = withObject "ArtifactClaimShape" $ \objectValue -> do
  rejectUnknownFields "ArtifactClaim" ["claimId"] objectValue
  ShapeArtifactClaim.ArtifactClaim
    <$> explicitParseField (parseClaimIdLeaf) objectValue "claimId"

projectArtifactEventTypes :: NonEmpty EventType
projectArtifactEventTypes = EventType "ArtifactRecorded" :| []

projectArtifactCodec :: Codec ProjectArtifactEvent
projectArtifactCodec =
  Codec
    { eventTypes = projectArtifactEventTypes
    , eventType = \case
        ArtifactRecorded{} -> EventType "ArtifactRecorded"
    , schemaVersion = 1
    , encode = encodeProjectArtifactEvent
    , decode = parseProjectArtifactEvent
    , upcasters = []
    }

encodeProjectArtifactEvent :: ProjectArtifactEvent -> Value
encodeProjectArtifactEvent = \case
  ArtifactRecorded payload ->
    object
      [ "kind" .= ("ArtifactRecorded" :: Text)
      , "projectId" .= projectIdText payload.projectId
      , "phase" .= projectPhaseText payload.phase
      , "claim" .= encodeArtifactClaimMapped payload.claim
      ]

parseProjectArtifactEvent :: EventType -> Value -> Either Text ProjectArtifactEvent
parseProjectArtifactEvent (EventType tag) = mapLeftText . parseEither (withObject "ProjectArtifactEvent" go)
  where
    go o = do
      case tag of
        "ArtifactRecorded" ->
          ArtifactRecorded
            <$> ( ArtifactRecordedData
                    <$> (unsafeProjectIdFromLegacyText <$> o .: "projectId")
                    <*> explicitParseField (withText "ProjectPhase" parseProjectPhase) o "phase"
                    <*> explicitParseField parseArtifactClaimMapped o "claim"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes projectArtifactEventTypes)

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