Codec.hs

-- @generated by keiro-dsl 0.15.0.0 (language keiro-dsl 4) from aggregate Alpha; do not edit.
module Proof.WorkspaceProof.Alpha.Generated.Codec (
    alphaCodec,
    parseAlphaEvent,
    encodeAlphaEvent,
) where

import Proof.WorkspaceProof.Alpha.Generated.Domain
import Proof.WorkspaceProof.Generated.Nominals (proofIdText)
import Proof.WorkspaceProof.Generated.Nominals.Internal (unsafeProofIdFromLegacyText)
import Data.Aeson (Value, object, withObject, (.:), (.=))
import Data.Aeson.Types (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 (..))





alphaEventTypes :: NonEmpty EventType
alphaEventTypes = EventType "AlphaPinged" :| [EventType "LegacyAlphaPinged"]

alphaCodec :: Codec AlphaEvent
alphaCodec =
  Codec
    { eventTypes = alphaEventTypes
    , eventType = \case
        AlphaPinged{} -> EventType "AlphaPinged"
        LegacyAlphaPinged{} -> EventType "LegacyAlphaPinged"
    , schemaVersion = 1
    , encode = encodeAlphaEvent
    , decode = parseAlphaEvent
    , upcasters = []
    }

encodeAlphaEvent :: AlphaEvent -> Value
encodeAlphaEvent = \case
  AlphaPinged payload ->
    object
      [ "kind" .= ("AlphaPinged" :: Text)
      , "proofId" .= proofIdText payload.proofId
      , "current" .= payload.current
      ]
  LegacyAlphaPinged payload ->
    object
      [ "kind" .= ("LegacyAlphaPinged" :: Text)
      , "proofId" .= proofIdText payload.proofId
      ]

parseAlphaEvent :: EventType -> Value -> Either Text AlphaEvent
parseAlphaEvent (EventType tag) = mapLeftText . parseEither (withObject "AlphaEvent" go)
  where
    go o = do
      case tag of
        "AlphaPinged" ->
          AlphaPinged
            <$> ( AlphaPingedData
                    <$> (unsafeProofIdFromLegacyText <$> o .: "proofId")
                    <*> o .: "current"
                )
        "LegacyAlphaPinged" ->
          LegacyAlphaPinged
            <$> ( LegacyAlphaPingedData
                    <$> (unsafeProofIdFromLegacyText <$> o .: "proofId")
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes alphaEventTypes)

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