Codec.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.WorkspaceNominalProof.ProjectArtifact.Codec (
    projectArtifactCodec,
    parseProjectArtifactEvent,
    encodeProjectArtifactEvent,
) where

import Generated.WorkspaceNominalProof.ProjectArtifact.Domain
import Generated.WorkspaceNominalProof.Nominals (ProjectId (..), projectIdText, ProjectPhase (..), projectPhaseText)
import Data.Aeson (Value, object, withObject, (.:), (.=))
import Data.Aeson.Types (Parser, parseEither)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec (Codec (..), EventType (..))


parseProjectPhase :: Text -> Parser ProjectPhase
parseProjectPhase = \case
  "draft" -> pure Draft
  "active" -> pure Active
  _ -> fail "unknown ProjectPhase"


projectArtifactCodec :: Codec ProjectArtifactEvent
projectArtifactCodec =
  Codec
    { eventTypes = EventType "ArtifactRecorded" :| []
    , 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
      ]

parseProjectArtifactEvent :: EventType -> Value -> Either Text ProjectArtifactEvent
parseProjectArtifactEvent (EventType tag) = mapLeftText . parseEither (withObject "ProjectArtifactEvent" go)
  where
    go o = do
      case tag of
        "ArtifactRecorded" ->
          ArtifactRecorded <$> (ArtifactRecordedData <$> (ProjectId <$> o .: "projectId") <*> (o .: "phase" >>= parseProjectPhase))
        _ -> fail "unknown event type"

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