Codec.hs

-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Project; do not edit.
module Generated.WorkspaceNominalProof.Project.Codec (
    projectCodec,
    parseProjectEvent,
    encodeProjectEvent,
    encodeProjectClaimMapped,
    decodeProjectClaimMapped,
) where

import Generated.WorkspaceNominalProof.Project.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.ProjectClaim qualified as ShapeProjectClaim
import WorkspaceNominalProof.Bindings qualified as Bindings
import WorkspaceNominalProof.Domain (ProjectClaim)

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

encodeProjectClaimMapped :: ProjectClaim -> Value
encodeProjectClaimMapped = encodeProjectClaimShape . bindingToShape Bindings.projectClaimBinding

parseProjectClaimMapped :: Value -> Parser ProjectClaim
parseProjectClaimMapped value = bindingFromShape Bindings.projectClaimBinding <$> parseProjectClaimShape value

decodeProjectClaimMapped :: Value -> Either Text ProjectClaim
decodeProjectClaimMapped = mapLeftText . parseEither parseProjectClaimMapped

encodeProjectClaimShape :: ShapeProjectClaim.ProjectClaimShape -> Value
encodeProjectClaimShape shape =
  object
      [ "claimId" .= encodeClaimIdLeaf shape.claimId
      ]

parseProjectClaimShape :: Value -> Parser ShapeProjectClaim.ProjectClaimShape
parseProjectClaimShape = withObject "ProjectClaimShape" $ \objectValue -> do
  rejectUnknownFields "ProjectClaim" ["claimId"] objectValue
  ShapeProjectClaim.ProjectClaim
    <$> explicitParseField (parseClaimIdLeaf) objectValue "claimId"

projectEventTypes :: NonEmpty EventType
projectEventTypes = EventType "ProjectRegistered" :| [EventType "ArchivalRecorded"]

projectCodec :: Codec ProjectEvent
projectCodec =
  Codec
    { eventTypes = projectEventTypes
    , eventType = \case
        ProjectRegistered{} -> EventType "ProjectRegistered"
        ArchivalRecorded{} -> EventType "ArchivalRecorded"
    , schemaVersion = 1
    , encode = encodeProjectEvent
    , decode = parseProjectEvent
    , upcasters = []
    }

encodeProjectEvent :: ProjectEvent -> Value
encodeProjectEvent = \case
  ProjectRegistered payload ->
    object
      [ "kind" .= ("ProjectRegistered" :: Text)
      , "projectId" .= projectIdText payload.projectId
      , "phase" .= projectPhaseText payload.phase
      , "claim" .= encodeProjectClaimMapped payload.claim
      ]
  ArchivalRecorded payload ->
    object
      [ "kind" .= ("ArchivalRecorded" :: Text)
      , "projectId" .= projectIdText payload.projectId
      , "phase" .= projectPhaseText payload.phase
      ]

parseProjectEvent :: EventType -> Value -> Either Text ProjectEvent
parseProjectEvent (EventType tag) = mapLeftText . parseEither (withObject "ProjectEvent" go)
  where
    go o = do
      case tag of
        "ProjectRegistered" ->
          ProjectRegistered
            <$> ( ProjectRegisteredData
                    <$> (unsafeProjectIdFromLegacyText <$> o .: "projectId")
                    <*> explicitParseField (withText "ProjectPhase" parseProjectPhase) o "phase"
                    <*> explicitParseField parseProjectClaimMapped o "claim"
                )
        "ArchivalRecorded" ->
          ArchivalRecorded
            <$> ( ArchivalRecordedData
                    <$> (unsafeProjectIdFromLegacyText <$> o .: "projectId")
                    <*> explicitParseField (withText "ProjectPhase" parseProjectPhase) o "phase"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes projectEventTypes)

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