Codec.hs

-- @generated by keiro-dsl 0.21.0.0 (language keiro-dsl 6) from aggregate Assignment; do not edit.
module Generated.HistoryDependentHoles.Assignment.Codec (
    assignmentCodec,
    parseAssignmentEvent,
    encodeAssignmentEvent,
) where

import Generated.HistoryDependentHoles.Assignment.Domain
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 (..))





assignmentEventTypes :: NonEmpty EventType
assignmentEventTypes = EventType "PropertySet" :| [EventType "PropertyCleared", EventType "Touched"]

assignmentCodec :: Codec AssignmentEvent
assignmentCodec =
  Codec
    { eventTypes = assignmentEventTypes
    , eventType = \case
        PropertySet{} -> EventType "PropertySet"
        PropertyCleared{} -> EventType "PropertyCleared"
        Touched{} -> EventType "Touched"
    , schemaVersion = 1
    , encode = encodeAssignmentEvent
    , decode = parseAssignmentEvent
    , upcasters = []
    }

encodeAssignmentEvent :: AssignmentEvent -> Value
encodeAssignmentEvent = \case
  PropertySet payload ->
    object
      [ "kind" .= ("PropertySet" :: Text)
      , "key" .= payload.key
      , "value" .= payload.value
      ]
  PropertyCleared payload ->
    object
      [ "kind" .= ("PropertyCleared" :: Text)
      , "key" .= payload.key
      ]
  Touched payload ->
    object
      [ "kind" .= ("Touched" :: Text)
      , "note" .= payload.note
      ]

parseAssignmentEvent :: EventType -> Value -> Either Text AssignmentEvent
parseAssignmentEvent (EventType tag) = mapLeftText . parseEither (withObject "AssignmentEvent" go)
  where
    go o = do
      case tag of
        "PropertySet" ->
          PropertySet
            <$> ( PropertySetData
                    <$> o .: "key"
                    <*> o .: "value"
                )
        "PropertyCleared" ->
          PropertyCleared
            <$> ( PropertyClearedData
                    <$> o .: "key"
                )
        "Touched" ->
          Touched
            <$> ( TouchedData
                    <$> o .: "note"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> renderExpectedEventTypes assignmentEventTypes)

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