Transducer.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE QualifiedDo #-}
-- @generated by keiro-dsl 0.17.0.0 (language keiro-dsl 6) from aggregate Escalation; do not edit.
module Generated.IncidentResponse.Escalation.Transducer
  ( escalationTransducer
  , escalationFoldFingerprint
  , BehaviorOwnership (..)
  , escalationPredicateVerifications
  ) where

import Generated.IncidentResponse.Escalation.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

escalationTransducer
  :: SymTransducer
       (HsPred EscalationRegs EscalationCommand)
       EscalationRegs
       EscalationVertex
       EscalationCommand
       EscalationEvent
escalationTransducer =
  B.buildTransducer EscalationOpen initialEscalationRegs isTerminal do
    B.from EscalationOpen do
      B.onCmd inCtorNoteRaised $ \d -> B.do
        B.emit wireRaisedNoted (RaisedNotedTermFields
          { incidentId = d.incidentId
          })
        B.goto EscalationOpen
      B.onCmd inCtorNoteAcknowledged $ \d -> B.do
        B.emit wireAcknowledged (AcknowledgedTermFields
          { incidentId = d.incidentId
          })
        B.goto EscalationOpen
      B.onCmd inCtorNoteIgnored $ \_d -> B.do
        B.noEmit
        B.goto EscalationOpen
      B.onCmd inCtorActivateDormant $ \d -> B.do
        B.emit wireDormantActivated (DormantActivatedTermFields
          { incidentId = d.incidentId
          })
        B.goto EscalationDormant
 where
  isTerminal = \case

    _ -> False

escalationFoldFingerprint :: Text
escalationFoldFingerprint = "c698d1c8c31d347428f9798264dcb612"

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.
escalationPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]
escalationPredicateVerifications = sequence
  [ verifyTransition "transition1OpenNoteRaised" GeneratedOwned EscalationOpen 0
  , verifyTransition "transition2OpenNoteAcknowledged" GeneratedOwned EscalationOpen 1
  , verifyTransition "transition3OpenNoteIgnored" GeneratedOwned EscalationOpen 2
  , verifyTransition "transition4OpenActivateDormant" GeneratedOwned EscalationOpen 3
  ]
 where
  verifyTransition label owner source edgeIndex =
    case drop edgeIndex (K.edgesOut escalationTransducer source) of
      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate
      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")