Nominals.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
-- @generated by keiro-dsl 0.8.0.0 (language keiro-dsl 4) from context hospital-capacity generated nominal declarations; do not edit.
module Generated.HospitalCapacity.Nominals
  ( BedType (..)
  , bedTypeText
  , CommandId
  , parseCommandId
  , mkCommandId
  , commandIdText
  , DivertStatus (..)
  , divertStatusText
  , DivertStatusEqualityProjection
  , divertStatusEqualityWitness
  , HospitalId
  , parseHospitalId
  , mkHospitalId
  , hospitalIdText
  , PatientAcuity (..)
  , patientAcuityText
  , TransferReservationId
  , parseTransferReservationId
  , mkTransferReservationId
  , transferReservationIdText
  ) where

import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import Keiki.Shape (CanonicalTypeName)
import Generated.HospitalCapacity.Nominals.Internal (CommandId, mkCommandId, parseCommandId, commandIdText, HospitalId, mkHospitalId, parseHospitalId, hospitalIdText, TransferReservationId, mkTransferReservationId, parseTransferReservationId, transferReservationIdText)
import Keiki.Core (ExactFieldProjection (..), FieldProjection (..), FieldWitness, exactFieldWitness, fieldWitness)
import Data.List.NonEmpty (NonEmpty (..))
import Keiki.ProjectionDomain (TextPattern, finiteProjectionDomain, textProjectionDomain)
import Keiro.Codec.IdDomain (idDomainTextPattern, typeIdV7Domain)

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"

instance CanonicalTypeName CommandId

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 DivertStatusEqualityProjection

instance FieldProjection DivertStatusEqualityProjection where
  type FieldName DivertStatusEqualityProjection = "DivertStatus"
  type FieldOwner DivertStatusEqualityProjection = DivertStatus
  type FieldResult DivertStatusEqualityProjection = Text
  fieldShapeId _ = "nominal-equality|name=DivertStatus|contract=keiro-dsl/nominal-equality/1|key=Text|domain=finite-text:open,partial-divert,total-divert|owner=generated"
  projectFieldValue _ = divertStatusText

instance ExactFieldProjection DivertStatusEqualityProjection where
  fieldProjectionDomain _ = finiteProjectionDomain ("open" :| ["partial-divert", "total-divert"])
  reconstructFieldOwner _ = \case
    "open" -> Just Open
    "partial-divert" -> Just PartialDivert
    "total-divert" -> Just TotalDivert
    _ -> Nothing

divertStatusEqualityWitness :: FieldWitness DivertStatusEqualityProjection
divertStatusEqualityWitness = exactFieldWitness @DivertStatusEqualityProjection

instance CanonicalTypeName HospitalId

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"

instance CanonicalTypeName TransferReservationId