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

…before firing
statebox · Feb 26, 2020 · 66e42fe · 66e42fe
1 parent 398fcb2
commit 66e42fe
Show file tree

Hide file tree

Showing 2 changed files with 20 additions and 2 deletions.
diff --git 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
@@ -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