[#328] [studio-common, stbx-protocol] check if transition is enabled before firing

Author: marcosh

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)

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