Transducer.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE TypeApplications #-}
-- @generated by keiro-dsl 0.8.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.
module Generated.TransferRouting.Hospital.Transducer
  ( hospitalTransducer
  , hospitalFoldFingerprint
  , BehaviorOwnership (..)
  , hospitalPredicateVerifications
  ) where

import Generated.TransferRouting.Hospital.Domain
import Data.Text (Text)
import Keiki.Builder qualified as B
import Keiki.Core (HsPred, SymTransducer)
import Keiki.Core qualified as K
import Keiki.Symbolic qualified as S

hospitalTransducer
  :: SymTransducer
       (HsPred HospitalRegs HospitalCommand)
       HospitalRegs
       HospitalVertex
       HospitalCommand
       HospitalEvent
hospitalTransducer =
  B.buildTransducer HospitalAccepting initialHospitalRegs isTerminal do
    B.from HospitalAccepting do
      B.onCmd inCtorRouteAcceptedTransferNeed $ \d -> B.do
        B.emit wireAcceptedTransferNeedRouted (AcceptedTransferNeedRoutedTermFields
          { transferNeedId = d.transferNeedId
          , hospitalId = d.hospitalId
          })
        B.goto HospitalAccepting
 where
  isTerminal = \case

    _ -> False

hospitalFoldFingerprint :: Text
hospitalFoldFingerprint = "a5fa22bc0f5337c57d80b5e1c43bb860"

data BehaviorOwnership = GeneratedOwned | HoleOwned
  deriving stock (Eq, Show)

-- Every checked transition predicate is audited through Keiki's conservative
-- symbolic verifier. Opaque Hole terms remain explicitly unverified.
hospitalPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]
hospitalPredicateVerifications = sequence
  [ verifyTransition "transition1AcceptingRouteAcceptedTransferNeed" GeneratedOwned HospitalAccepting 0
  ]
 where
  verifyTransition label owner source edgeIndex =
    case drop edgeIndex (K.edgesOut hospitalTransducer source) of
      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate
      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")