Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate Project; do not edit.
module Generated.WorkspaceNominalProof.Project.Codec (
    projectCodec,
    parseProjectEvent,
    encodeProjectEvent,
) where

import Generated.WorkspaceNominalProof.Project.Domain
import Generated.WorkspaceNominalProof.Nominals (ProjectId, projectIdText, ProjectPhase (..), projectPhaseText)
import Generated.WorkspaceNominalProof.Nominals.Internal (unsafeProjectIdFromLegacyText)
import Data.Aeson (Value, object, withObject, withText, (.:), (.=))
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 (Codec (..), EventType (..))


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


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
      ]
  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"
                )
        "ArchivalRecorded" ->
          ArchivalRecorded
            <$> ( ArchivalRecordedData
                    <$> (unsafeProjectIdFromLegacyText <$> o .: "projectId")
                    <*> explicitParseField (withText "ProjectPhase" parseProjectPhase) o "phase"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> _renderEventTypes projectEventTypes)

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