Transducer.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE QualifiedDo #-}
-- @generated by keiro-dsl 0.12.0.0 (language keiro-dsl 5) from aggregate Reservation; do not edit.
module Generated.DomainOutcomes.Reservation.Transducer
  ( reservationTransducer
  , reservationFoldFingerprint
  , BehaviorOwnership (..)
  , reservationPredicateVerifications
  ) where

import Generated.DomainOutcomes.Reservation.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
import Keiki.Builder ((=:))

reservationTransducer
  :: SymTransducer
       (HsPred ReservationRegs ReservationCommand)
       ReservationRegs
       ReservationVertex
       ReservationCommand
       ReservationEvent
reservationTransducer =
  B.buildTransducer ReservationEligible initialReservationRegs isTerminal do
    B.from ReservationEligible do
      B.onCmd inCtorCancel $ \d -> B.do
        B.slot @"lastRequestId" =: d.requestId
        B.emit wireCancelled (CancelledTermFields
          { requestId = d.requestId
          })
        B.goto ReservationCancelledState
    B.from ReservationCancelledState do
      B.onCmd inCtorCancel $ \d -> B.do
        B.requireGuard $
          d.requestId ./= B.reg @"lastRequestId"
        B.noEmit
        B.goto ReservationCancelledState
      B.onCmd inCtorCancel $ \d -> B.do
        B.requireGuard $
          d.requestId .== B.reg @"lastRequestId"
        B.noEmit
        B.goto ReservationCancelledState
 where
  isTerminal = \case

    _ -> False

reservationFoldFingerprint :: Text
reservationFoldFingerprint = "a1d8c04b7c9f5541e83081e8d7c51cad"

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.
reservationPredicateVerifications :: IO [(Text, BehaviorOwnership, S.PredicateVerification)]
reservationPredicateVerifications = sequence
  [ verifyTransition "transition1EligibleCancel" GeneratedOwned ReservationEligible 0
  , verifyTransition "transition2CancelledStateCancel" GeneratedOwned ReservationCancelledState 0
  , verifyTransition "transition3CancelledStateCancel" GeneratedOwned ReservationCancelledState 1
  ]
 where
  verifyTransition label owner source edgeIndex =
    case drop edgeIndex (K.edgesOut reservationTransducer source) of
      K.Edge predicate _ _ _ _ : _ -> (\result -> (label, owner, result)) <$> S.verifyPredicate predicate
      [] -> pure (label, owner, S.UnverifiedSolverFailure "generated transition edge missing")