Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate Note; do not edit.
module Generated.ReplayDivergence.Note.Codec (
    noteCodec,
    parseNoteEvent,
    encodeNoteEvent,
) where

import Generated.ReplayDivergence.Note.Domain
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 (..))





noteEventTypes :: NonEmpty EventType
noteEventTypes = EventType "NoteWritten" :| []

noteCodec :: Codec NoteEvent
noteCodec =
  Codec
    { eventTypes = noteEventTypes
    , eventType = \case
        NoteWritten{} -> EventType "NoteWritten"
    , schemaVersion = 1
    , encode = encodeNoteEvent
    , decode = parseNoteEvent
    , upcasters = []
    }

encodeNoteEvent :: NoteEvent -> Value
encodeNoteEvent = \case
  NoteWritten payload ->
    object
      [ "kind" .= ("NoteWritten" :: Text)
      , "noteText" .= payload.noteText
      , "echo" .= payload.echo
      ]

parseNoteEvent :: EventType -> Value -> Either Text NoteEvent
parseNoteEvent (EventType tag) = mapLeftText . parseEither (withObject "NoteEvent" go)
  where
    go o = do
      case tag of
        "NoteWritten" ->
          NoteWritten
            <$> ( NoteWrittenData
                    <$> o .: "noteText"
                    <*> o .: "echo"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> _renderEventTypes noteEventTypes)

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