Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate Surge; do not edit.
module SkelProcess.Generated.MyService.Surge.Codec (
    surgeCodec,
    parseSurgeEvent,
    encodeSurgeEvent,
) where

import SkelProcess.Generated.MyService.Surge.Domain
import SkelProcess.Generated.MyService.Nominals (HospitalId, hospitalIdText)
import SkelProcess.Generated.MyService.Nominals.Internal (unsafeHospitalIdFromLegacyText)
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 (..))





surgeEventTypes :: NonEmpty EventType
surgeEventTypes = EventType "SurgeThresholdNoted" :| [EventType "SurgeTimerMarked"]

surgeCodec :: Codec SurgeEvent
surgeCodec =
  Codec
    { eventTypes = surgeEventTypes
    , eventType = \case
        SurgeThresholdNoted{} -> EventType "SurgeThresholdNoted"
        SurgeTimerMarked{} -> EventType "SurgeTimerMarked"
    , schemaVersion = 1
    , encode = encodeSurgeEvent
    , decode = parseSurgeEvent
    , upcasters = []
    }

encodeSurgeEvent :: SurgeEvent -> Value
encodeSurgeEvent = \case
  SurgeThresholdNoted payload ->
    object
      [ "kind" .= ("SurgeThresholdNoted" :: Text)
      , "hospitalId" .= hospitalIdText payload.hospitalId
      , "availableIcuBeds" .= payload.availableIcuBeds
      , "redDemand" .= payload.redDemand
      , "timerId" .= payload.timerId
      ]
  SurgeTimerMarked payload ->
    object
      [ "kind" .= ("SurgeTimerMarked" :: Text)
      , "hospitalId" .= hospitalIdText payload.hospitalId
      , "timerId" .= payload.timerId
      ]

parseSurgeEvent :: EventType -> Value -> Either Text SurgeEvent
parseSurgeEvent (EventType tag) = mapLeftText . parseEither (withObject "SurgeEvent" go)
  where
    go o = do
      case tag of
        "SurgeThresholdNoted" ->
          SurgeThresholdNoted
            <$> ( SurgeThresholdNotedData
                    <$> (unsafeHospitalIdFromLegacyText <$> o .: "hospitalId")
                    <*> o .: "availableIcuBeds"
                    <*> o .: "redDemand"
                    <*> o .: "timerId"
                )
        "SurgeTimerMarked" ->
          SurgeTimerMarked
            <$> ( SurgeTimerMarkedData
                    <$> (unsafeHospitalIdFromLegacyText <$> o .: "hospitalId")
                    <*> o .: "timerId"
                )
        _ -> fail ("unknown event type " <> show tag <> "; expected one of: " <> _renderEventTypes surgeEventTypes)

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