Router.hs

-- @generated by keiro-dsl 0.12.0.0 (language keiro-dsl 5) from router HospitalTransferRouter; do not edit.
module Generated.TransferRouting.HospitalTransferRouter.Router
  ( hospitalTransferRouterName
  , hospitalTransferRouterWorkerOptions
  , hospitalTransferRouterSelectionFingerprint
  , hospitalTransferRouterSelectionContract
  , hospitalTransferRouterSelect
  , hospitalTransferRouter
  ) where

import Data.Text (Text)
import Effectful (Eff, IOE, (:>))
import Generated.TransferRouting.StructuralProjections qualified as StructuralProjections
import Generated.TransferRouting.HospitalLoad.QueryContract (HospitalLoadQueryInput)
import Generated.TransferRouting.HospitalLoad.ReadModel qualified as SelectionQuery
import Generated.TransferRouting.Hospital.Domain qualified as TargetDomain
import Generated.TransferRouting.Hospital.EventStream qualified as TargetStream
import Keiki.Core (HsPred, fieldWitnessGet)
import Keiro.ProcessManager (PMCommand (..), PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))
import Keiro.ReadModel (runQuery)
import Keiro.Router
  ( DeclarativeRouter (..)
  , EmptySelectionPolicy (..)
  , PartialDispatchPolicy (..)
  , RedeliveryPolicy (..)
  , RouterSelectionContract (..)
  , RouterSelectionFailure (..)
  , SelectionDedupe (..)
  , SelectionFailurePolicy (..)
  , SelectionFingerprint (..)
  , SelectionIdentity (..)
  , SelectionOrder (..)
  , mkRecipientLimit
  , mkSelectionVersion
  )
import Keiro.Stream (entityStream)
import Kiroku.Store.Effect (Store)
import Shibuya.Core.Ack (RetryDelay (..))

-- The STABLE router name. It remains part of every target-keyed
-- deterministic router command id; selection metadata never re-keys dispatches.
hospitalTransferRouterName :: Text
hospitalTransferRouterName = "hospital-transfer-router"

-- SHA-256 of the checked selection semantics (locations and formatting excluded).
hospitalTransferRouterSelectionFingerprint :: Text
hospitalTransferRouterSelectionFingerprint = "64cef46d4f1d19cda4ed0cf91b1e0d783f72580ef0cbabdd2b52c83a6fadc3a9"

hospitalTransferRouterSelectionContract :: RouterSelectionContract
hospitalTransferRouterSelectionContract =
  RouterSelectionContract
    { identity = SelectionIdentity "hospital-transfer-selection"
    , version = checkedSelectionVersion
    , fingerprint = SelectionFingerprint hospitalTransferRouterSelectionFingerprint
    , limit = checkedRecipientLimit
    , order = OrderByTargetStream
    , dedupe = DedupeByTargetStream
    , emptyPolicy = EmptyAck
    , failurePolicy = FailureRetry
    , redeliveryPolicy = StableUnion
    , partialPolicy = RetainSuccesses
    }
  where
    checkedSelectionVersion = case mkSelectionVersion 1 of
      Right value -> value
      Left _ -> error "keiro-dsl emitted a non-positive checked selection version"
    checkedRecipientLimit = case mkRecipientLimit 64 of
      Right value -> value
      Left _ -> error "keiro-dsl emitted a non-positive checked recipient limit"

hospitalTransferRouterSelect ::
  (IOE :> es, Store :> es) =>
  HospitalLoadQueryInput ->
  Eff es (Either RouterSelectionFailure [PMCommand TargetDomain.HospitalCommand])
hospitalTransferRouterSelect input = do
  queryResult <- runQuery Nothing SelectionQuery.hospitalLoadReadModel input
  pure $ case queryResult of
    Left _ -> Left (SelectionQueryFailed "read-model hospital_load query failed")
    Right rows ->
      Right
        [ PMCommand
            { target = entityStream TargetStream.hospitalCommandCategory ((fieldWitnessGet StructuralProjections.hospitalLoadRowHospitalIdWitness row))
            , command = TargetDomain.RouteAcceptedTransferNeed (TargetDomain.RouteAcceptedTransferNeedData ((fieldWitnessGet StructuralProjections.transferRouteInputTransferNeedIdWitness input)) ((fieldWitnessGet StructuralProjections.hospitalLoadRowHospitalIdWitness row)))
            }
        | row <- rows
        , (((fieldWitnessGet StructuralProjections.hospitalLoadRowRegionWitness row) == (fieldWitnessGet StructuralProjections.transferRouteInputRegionWitness input)) && ((fieldWitnessGet StructuralProjections.hospitalLoadRowAvailableBedsWitness row) > 0))
        ]

hospitalTransferRouter ::
  (IOE :> es, Store :> es) =>
  DeclarativeRouter
    HospitalLoadQueryInput
    (HsPred TargetDomain.HospitalRegs TargetDomain.HospitalCommand)
    TargetDomain.HospitalRegs
    TargetDomain.HospitalVertex
    TargetDomain.HospitalCommand
    TargetDomain.HospitalEvent
    es
hospitalTransferRouter =
  DeclarativeRouter
    { name = hospitalTransferRouterName
    , key = \input -> (fieldWitnessGet StructuralProjections.transferRouteInputTransferNeedIdWitness input)
    , selectionContract = hospitalTransferRouterSelectionContract
    , select = hospitalTransferRouterSelect
    , targetEventStream = TargetStream.hospitalEventStream
    , targetProjections = const []
    }

-- Node-level worker policy. Pair it with runDeclarativeRouterWorkerWith.
-- Selection empty/failure policy remains in the generated selection contract.
hospitalTransferRouterWorkerOptions :: WorkerOptions es msg
hospitalTransferRouterWorkerOptions =
  WorkerOptions
    { poisonPolicy = PoisonHalt,
      rejectedCommandPolicy = RejectedDeadLetter,
      transientRetryDelay = RetryDelay 5, -- matches defaultWorkerOptions; runtime tuning
      metrics = Nothing -- runtime configuration; install at call site
    }