Codec.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.HospitalCapacity.Reservation.Codec (
    reservationCodec,
    parseReservationEvent,
    encodeReservationEvent,
) where

import Generated.HospitalCapacity.Reservation.Domain
import Generated.HospitalCapacity.Nominals (CommandId (..), commandIdText, DivertStatus (..), divertStatusText, HospitalId (..), hospitalIdText, PatientAcuity (..), patientAcuityText, TransferReservationId (..), transferReservationIdText)
import Data.Aeson (Value, object, withObject, (.:), (.=))
import Data.Aeson.Types (Parser, parseEither)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec (Codec (..), EventType (..))


parseDivertStatus :: Text -> Parser DivertStatus
parseDivertStatus = \case
  "open" -> pure Open
  "partial-divert" -> pure PartialDivert
  "total-divert" -> pure TotalDivert
  _ -> fail "unknown DivertStatus"

parsePatientAcuity :: Text -> Parser PatientAcuity
parsePatientAcuity = \case
  "red" -> pure RedTag
  "yellow" -> pure YellowTag
  "green" -> pure GreenTag
  _ -> fail "unknown PatientAcuity"


reservationCodec :: Codec ReservationEvent
reservationCodec =
  Codec
    { eventTypes = EventType "TransferReservationCreated" :| [EventType "TransferReservationConfirmed"]
    , eventType = \case
        TransferReservationCreated{} -> EventType "TransferReservationCreated"
        TransferReservationConfirmed{} -> EventType "TransferReservationConfirmed"
    , schemaVersion = 1
    , encode = encodeReservationEvent
    , decode = parseReservationEvent
    , upcasters = []
    }

encodeReservationEvent :: ReservationEvent -> Value
encodeReservationEvent = \case
  TransferReservationCreated payload ->
    object
      [ "kind" .= ("TransferReservationCreated" :: Text)
      , "reservationId" .= transferReservationIdText payload.reservationId
      , "hospitalId" .= hospitalIdText payload.hospitalId
      , "commandId" .= commandIdText payload.commandId
      , "patientAcuity" .= patientAcuityText payload.patientAcuity
      , "divertStatus" .= divertStatusText payload.divertStatus
      , "lifeCriticalOverride" .= payload.lifeCriticalOverride
      ]
  TransferReservationConfirmed payload ->
    object
      [ "kind" .= ("TransferReservationConfirmed" :: Text)
      , "reservationId" .= transferReservationIdText payload.reservationId
      , "hospitalId" .= hospitalIdText payload.hospitalId
      , "commandId" .= commandIdText payload.commandId
      ]

parseReservationEvent :: EventType -> Value -> Either Text ReservationEvent
parseReservationEvent (EventType tag) = mapLeftText . parseEither (withObject "ReservationEvent" go)
  where
    go o = do
      case tag of
        "TransferReservationCreated" ->
          TransferReservationCreated <$> (TransferReservationCreatedData <$> (TransferReservationId <$> o .: "reservationId") <*> (HospitalId <$> o .: "hospitalId") <*> (CommandId <$> o .: "commandId") <*> (o .: "patientAcuity" >>= parsePatientAcuity) <*> (o .: "divertStatus" >>= parseDivertStatus) <*> o .: "lifeCriticalOverride")
        "TransferReservationConfirmed" ->
          TransferReservationConfirmed <$> (TransferReservationConfirmedData <$> (TransferReservationId <$> o .: "reservationId") <*> (HospitalId <$> o .: "hospitalId") <*> (CommandId <$> o .: "commandId"))
        _ -> fail "unknown event type"

mapLeftText :: Either String b -> Either Text b
mapLeftText = either (Left . T.pack) Right