Domain.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module Generated.HospitalCapacity.Reservation.Domain where

import Data.Aeson (FromJSON, ToJSON)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import GHC.Generics (Generic)
import Keiki.Core (RegFile (..))
import Keiki.Generics.TH (deriveAggregateCtorsAll, deriveWireCtorsAll)
import Keiki.Shape (CanonicalStateShape, CanonicalTypeName)

newtype TransferReservationId = TransferReservationId Text
    deriving stock (Generic, Eq, Ord, Show)
    deriving anyclass (ToJSON, FromJSON)
instance CanonicalTypeName TransferReservationId

transferReservationIdText :: TransferReservationId -> Text
transferReservationIdText (TransferReservationId t) = t

newtype HospitalId = HospitalId Text
    deriving stock (Generic, Eq, Ord, Show)
    deriving anyclass (ToJSON, FromJSON)
instance CanonicalTypeName HospitalId

hospitalIdText :: HospitalId -> Text
hospitalIdText (HospitalId t) = t

newtype CommandId = CommandId Text
    deriving stock (Generic, Eq, Ord, Show)
    deriving anyclass (ToJSON, FromJSON)
instance CanonicalTypeName CommandId

commandIdText :: CommandId -> Text
commandIdText (CommandId t) = t

data PatientAcuity = RedTag | YellowTag | GreenTag
    deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)
    deriving anyclass (ToJSON, FromJSON)
instance CanonicalTypeName PatientAcuity

patientAcuityText :: PatientAcuity -> Text
patientAcuityText = \case
    RedTag -> "red"
    YellowTag -> "yellow"
    GreenTag -> "green"

data BedType = Icu | MedicalSurgical
    deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)
    deriving anyclass (ToJSON, FromJSON)
instance CanonicalTypeName BedType

bedTypeText :: BedType -> Text
bedTypeText = \case
    Icu -> "icu"
    MedicalSurgical -> "medical-surgical"

data DivertStatus = Open | PartialDivert | TotalDivert
    deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)
    deriving anyclass (ToJSON, FromJSON)
instance CanonicalTypeName DivertStatus

divertStatusText :: DivertStatus -> Text
divertStatusText = \case
    Open -> "open"
    PartialDivert -> "partial-divert"
    TotalDivert -> "total-divert"

data ReservationVertex = ReservationUnrequested | ReservationHeld | ReservationConfirmed | ReservationExpired | ReservationAdmitted | ReservationReleased
    deriving stock (Generic, Eq, Ord, Show, Enum, Bounded)
    deriving anyclass (ToJSON, FromJSON)
instance CanonicalStateShape ReservationVertex
instance CanonicalTypeName ReservationVertex

data RequestTransferReservationData = RequestTransferReservationData
    { reservationId :: !TransferReservationId
    , hospitalId :: !HospitalId
    , commandId :: !CommandId
    , patientAcuity :: !PatientAcuity
    , divertStatus :: !DivertStatus
    , lifeCriticalOverride :: !Bool
    }
    deriving stock (Generic, Eq, Show)

data ConfirmReservationData = ConfirmReservationData
    { reservationId :: !TransferReservationId
    , hospitalId :: !HospitalId
    , commandId :: !CommandId
    }
    deriving stock (Generic, Eq, Show)

data ReservationCommand
    = RequestTransferReservation !RequestTransferReservationData
    | ConfirmReservation !ConfirmReservationData
    deriving stock (Generic, Eq, Show)

data TransferReservationCreatedData = TransferReservationCreatedData
    { reservationId :: !TransferReservationId
    , hospitalId :: !HospitalId
    , commandId :: !CommandId
    , patientAcuity :: !PatientAcuity
    , divertStatus :: !DivertStatus
    , lifeCriticalOverride :: !Bool
    }
    deriving stock (Generic, Eq, Show)

data TransferReservationConfirmedData = TransferReservationConfirmedData
    { reservationId :: !TransferReservationId
    , hospitalId :: !HospitalId
    , commandId :: !CommandId
    }
    deriving stock (Generic, Eq, Show)

data ReservationEvent
    = TransferReservationCreated !TransferReservationCreatedData
    | TransferReservationConfirmed !TransferReservationConfirmedData
    deriving stock (Generic, Eq, Show)

type ReservationRegs =
    '[ '("reservationId", TransferReservationId)
     , '("hospitalId", HospitalId)
     , '("patientAcuity", PatientAcuity)
     , '("reservationState", ReservationVertex)
     ]

initialReservationRegs :: RegFile ReservationRegs
initialReservationRegs =
    RCons (Proxy @"reservationId") (TransferReservationId "") $
        RCons (Proxy @"hospitalId") (HospitalId "") $
            RCons (Proxy @"patientAcuity") GreenTag $
                RCons (Proxy @"reservationState") ReservationUnrequested RNil

$(deriveAggregateCtorsAll ''ReservationCommand ''ReservationRegs)

$(deriveWireCtorsAll ''ReservationEvent)