diff --git a/stbx-protocol/src/Statebox/Protocol/Fire.purs b/stbx-protocol/src/Statebox/Protocol/Fire.purs index ab02f051..05bccc74 100644 --- a/stbx-protocol/src/Statebox/Protocol/Fire.purs +++ b/stbx-protocol/src/Statebox/Protocol/Fire.purs @@ -7,8 +7,8 @@ import Data.Either.Nested (type (\/)) import Data.Maybe (maybe) import Data.NonEmpty (head) -import Data.Petrinet.Representation.Dict (fireAtMarking) import Data.Petrinet.Representation.Marking (MarkingF) +import Data.Petrinet.Representation.Dict (fireEnabledAtMarking) import Statebox.Core.Transition (gluedTokens) import Statebox.Core.Types (Firing, Wiring, PID) import Statebox.Core.WiringTree (LinearizationError, fromWiring, linearize) @@ -38,7 +38,10 @@ fire wiring firing marking = maybe in maybe (Left FireTransitionIndexOutOfBounds) (\gluedTransition -> - Right $ fireAtMarking marking $ gluedTokens gluedTransition) + maybe + (Left FireTransitionNotEnabled) + Right + (fireEnabledAtMarking marking $ gluedTokens gluedTransition)) (index gluedTransitions transitionIndex)) (linearize wiringTree)) (fromWiring wiring) diff --git a/studio-common/src/Data/Petrinet/Representation/Dict.purs b/studio-common/src/Data/Petrinet/Representation/Dict.purs index 11f1a05c..caf83072 100644 --- a/studio-common/src/Data/Petrinet/Representation/Dict.purs +++ b/studio-common/src/Data/Petrinet/Representation/Dict.purs @@ -13,6 +13,7 @@ module Data.Petrinet.Representation.Dict , fire , fireAtMarking , isTransitionEnabled + , fireEnabledAtMarking , preMarking , postMarking @@ -154,3 +155,17 @@ isTransitionEnabled marking t = isPlaceEnabled `all` t.pre where isPlaceEnabled :: PlaceMarkingF pid tok -> Boolean isPlaceEnabled tp = fromMaybe false $ (>=) <$> marking `tokensAt` tp.place <*> Just tp.tokens + +fireEnabledAtMarking + :: ∀ p tok + . Ord p + => Ord tok + => Semiring tok + => Group (MarkingF p tok) + => MarkingF p tok + -> TransitionF p tok + -> Maybe (MarkingF p tok) +fireEnabledAtMarking marking t = + if isTransitionEnabled marking t + then Just $ fireAtMarking marking t + else Nothing