Contract.hs

-- @generated by keiro-dsl 0.15.0.0 (language keiro-dsl 4) from contract emergency; do not edit.
module Generated.HospitalCapacity.Emergency.Contract
  ( EmergencyPayload (..)
  , TransferReservationAcceptedData (..)
  , TransferReservationRejectedData (..)
  , TransferExpiredData (..)
  , PatientAdmittedData (..)
  , hospitalEventsTopic
  , messageTypeOf
  , encodeEmergencyPayload
  , parseEmergencyPayload
  ) where

import Data.Aeson (Value, object, withObject, withText, (.:), (.=))
import Data.Aeson.Types (Parser, explicitParseField, parseEither)
import Data.KindID (KindID)
import qualified Data.KindID as KindID
import Data.Text (Text)
import qualified Data.Text as T
import Keiro.Codec.IdDomain (parseKindIdV7Value)

-- topic constants
hospitalEventsTopic :: Text
hospitalEventsTopic = "emergency.hospital.events"

-- the closed payload set (discriminated by "messageType")
data TransferReservationAcceptedData = TransferReservationAcceptedData {incidentId :: !(KindID "inc"), reservationId :: !(KindID "rsv")}
  deriving stock (Eq, Show)

data TransferReservationRejectedData = TransferReservationRejectedData {incidentId :: !(KindID "inc"), reason :: !Text}
  deriving stock (Eq, Show)

data TransferExpiredData = TransferExpiredData {incidentId :: !(KindID "inc"), expiredAt :: !Text}
  deriving stock (Eq, Show)

data PatientAdmittedData = PatientAdmittedData {incidentId :: !(KindID "inc"), admissionOutcome :: !Text}
  deriving stock (Eq, Show)

data EmergencyPayload
  = TransferReservationAccepted !TransferReservationAcceptedData
  | TransferReservationRejected !TransferReservationRejectedData
  | TransferExpired !TransferExpiredData
  | PatientAdmitted !PatientAdmittedData
  deriving stock (Eq, Show)

messageTypeOf :: EmergencyPayload -> Text
messageTypeOf = \case
  TransferReservationAccepted {} -> "TransferReservationAccepted"
  TransferReservationRejected {} -> "TransferReservationRejected"
  TransferExpired {} -> "TransferExpired"
  PatientAdmitted {} -> "PatientAdmitted"

encodeEmergencyPayload :: EmergencyPayload -> Value
encodeEmergencyPayload = \case
  TransferReservationAccepted payload ->
    object
      [ "messageType" .= ("TransferReservationAccepted" :: Text),
        "incidentId" .= KindID.toText payload.incidentId,
        "reservationId" .= KindID.toText payload.reservationId
      ]
  TransferReservationRejected payload ->
    object
      [ "messageType" .= ("TransferReservationRejected" :: Text),
        "incidentId" .= KindID.toText payload.incidentId,
        "reason" .= payload.reason
      ]
  TransferExpired payload ->
    object
      [ "messageType" .= ("TransferExpired" :: Text),
        "incidentId" .= KindID.toText payload.incidentId,
        "expiredAt" .= payload.expiredAt
      ]
  PatientAdmitted payload ->
    object
      [ "messageType" .= ("PatientAdmitted" :: Text),
        "incidentId" .= KindID.toText payload.incidentId,
        "admissionOutcome" .= payload.admissionOutcome
      ]

parseEmergencyPayload :: Value -> Either Text EmergencyPayload
parseEmergencyPayload = mapLeftText . parseEither (withObject "EmergencyPayload" go)
  where
    go o = do
      kind <- explicitParseField (withText "messageType" validateMessageType) o "messageType"
      case kind of
        "TransferReservationAccepted" ->
          TransferReservationAccepted
            <$> ( TransferReservationAcceptedData
                    <$> explicitParseField (parseKindIdV7Value @"inc") o "incidentId"
                    <*> explicitParseField (parseKindIdV7Value @"rsv") o "reservationId"
                )
        "TransferReservationRejected" ->
          TransferReservationRejected
            <$> ( TransferReservationRejectedData
                    <$> explicitParseField (parseKindIdV7Value @"inc") o "incidentId"
                    <*> o .: "reason"
                )
        "TransferExpired" ->
          TransferExpired
            <$> ( TransferExpiredData
                    <$> explicitParseField (parseKindIdV7Value @"inc") o "incidentId"
                    <*> o .: "expiredAt"
                )
        "PatientAdmitted" ->
          PatientAdmitted
            <$> ( PatientAdmittedData
                    <$> explicitParseField (parseKindIdV7Value @"inc") o "incidentId"
                    <*> o .: "admissionOutcome"
                )
        _ -> fail "validated message type was not handled"

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

validateMessageType :: Text -> Parser Text
validateMessageType kind
  | kind `elem` ["TransferReservationAccepted", "TransferReservationRejected", "TransferExpired", "PatientAdmitted"] = pure kind
  | otherwise = fail ("unknown message type " <> show kind <> "; expected one of: TransferReservationAccepted, TransferReservationRejected, TransferExpired, PatientAdmitted")