packages feed

keiro-dsl-0.18.0.0: test/conformance-bare-containers/Generated/BareContainers/BareStore/Transducer.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE QualifiedDo #-}
-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from aggregate BareStore; do not edit.
module Generated.BareContainers.BareStore.Transducer
  ( bareStoreTransducer
  , bareStoreFoldFingerprint
  , BehaviorOwnership (..)
  , bareStorePredicateVerifications
  ) where

import Generated.BareContainers.BareStore.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 ((=:))

bareStoreTransducer
  :: SymTransducer
       (HsPred BareStoreRegs BareStoreCommand)
       BareStoreRegs
       BareStoreVertex
       BareStoreCommand
       BareStoreEvent
bareStoreTransducer =
  B.buildTransducer BareStoreEmpty initialBareStoreRegs isTerminal do
    B.from BareStoreEmpty do
      B.onCmd inCtorStore $ \d -> B.do
        B.slot @"current" =: d.optionalLabel
        B.emit wireStoredValue (StoredValueTermFields
          { optionalLabel = d.optionalLabel
          , labels = d.labels
          , attributes = d.attributes
          , envelope = d.envelope
          })
        B.goto BareStoreStored
 where
  isTerminal = \case
    BareStoreStored -> True
    _ -> False

bareStoreFoldFingerprint :: Text
bareStoreFoldFingerprint = "d522dcd40ab98fed8f458c7388a4c085"

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