Codec.hs

{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}

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

import Data.Aeson (Value, object, withObject, (.:), (.=))
import Data.Aeson.Types (Parser, parseEither)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text)
import Data.Text qualified as T
import Generated.HospitalCapacity.Reservation.Domain
import Keiro.Codec (Codec (..), EventType (..))

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

parseBedType :: Text -> Parser BedType
parseBedType = \case
    "icu" -> pure Icu
    "medical-surgical" -> pure MedicalSurgical
    _ -> fail "unknown BedType"

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

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