keiro-dsl-0.10.0.0: test/conformance-skeletons/SkelAggregate/Generated/MyService/Thing/Codec.hs
{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate Thing; do not edit.
module SkelAggregate.Generated.MyService.Thing.Codec (
thingCodec,
parseThingEvent,
encodeThingEvent,
) where
import SkelAggregate.Generated.MyService.Thing.Domain
import SkelAggregate.Generated.MyService.Nominals (ThingId, thingIdText)
import SkelAggregate.Generated.MyService.Nominals.Internal (unsafeThingIdFromLegacyText)
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 (..))
thingEventTypes :: NonEmpty EventType
thingEventTypes = EventType "ThingCompleted" :| []
thingCodec :: Codec ThingEvent
thingCodec =
Codec
{ eventTypes = thingEventTypes
, eventType = \case
ThingCompleted{} -> EventType "ThingCompleted"
, schemaVersion = 1
, encode = encodeThingEvent
, decode = parseThingEvent
, upcasters = []
}
encodeThingEvent :: ThingEvent -> Value
encodeThingEvent = \case
ThingCompleted payload ->
object
[ "kind" .= ("ThingCompleted" :: Text)
, "thingId" .= thingIdText payload.thingId
, "attempt" .= payload.attempt
]
parseThingEvent :: EventType -> Value -> Either Text ThingEvent
parseThingEvent (EventType tag) = mapLeftText . parseEither (withObject "ThingEvent" go)
where
go o = do
case tag of
"ThingCompleted" ->
ThingCompleted
<$> ( ThingCompletedData
<$> (unsafeThingIdFromLegacyText <$> o .: "thingId")
<*> o .: "attempt"
)
_ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> _renderEventTypes thingEventTypes)
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