fix reach task feedback

fmidue · Dec 2, 2024 · 1892067 · 1892067
1 parent aa4d121
commit 1892067
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 19 deletions.
diff --git a/src/Modelling/PetriNet/Reach/Deadlock.hs b/src/Modelling/PetriNet/Reach/Deadlock.hs
@@ -109,7 +109,7 @@ deadlockInitial = TransitionsList . reverse . S.toList . transitions . petriNet
 
 deadlockSyntax
   :: OutputCapable m
-  => DeadlockInstance s Transition
+  => DeadlockInstance Place Transition
   -> [Transition]
   -> LangM m
 deadlockSyntax = transitionsValid . petriNet
@@ -121,17 +121,15 @@ deadlockEvaluation
     MonadDiagrams m,
     MonadGraphviz m,
     MonadThrow m,
-    Ord s,
-    OutputCapable m,
-    Show s
+    OutputCapable m
     )
   => FilePath
-  -> DeadlockInstance s Transition
+  -> DeadlockInstance Place Transition
   -> [Transition]
   -> Rated m
-deadlockEvaluation path deadlockInstance ts =
+deadlockEvaluation path deadlock ts =
   isNoLonger (noLongerThan deadlockInstance) ts
-  $>> executes path (drawUsing deadlockInstance) n ts
+  $>> executes path (drawUsing deadlockInstance) n (map ShowTransition ts)
   $>>= \eitherOutcome ->
     whenRight eitherOutcome (\outcome ->
       yesNo (null $ successors n outcome)
@@ -147,10 +145,11 @@ deadlockEvaluation path deadlockInstance ts =
     ts
     eitherOutcome
   where
+    deadlockInstance = toShowDeadlockInstance deadlock
     n = petriNet deadlockInstance
     aSolution
       | showSolution deadlockInstance
-      = Just $ show $ TransitionsList $ deadlockSolution deadlockInstance
+      = Just $ show $ TransitionsList $ deadlockSolution deadlock
       | otherwise
       = Nothing
 

diff --git a/src/Modelling/PetriNet/Reach/Reach.hs b/src/Modelling/PetriNet/Reach/Reach.hs
@@ -208,32 +208,37 @@ reachEvaluation
     MonadDiagrams m,
     MonadGraphviz m,
     MonadThrow m,
-    Ord s,
-    OutputCapable m,
-    Show s
+    OutputCapable m
     )
   => FilePath
-  -> ReachInstance s Transition
+  -> ReachInstance Place Transition
   -> [Transition]
   -> Rated m
-reachEvaluation path inst ts =
-  do isNoLonger (noLongerThan inst) ts
+reachEvaluation path reach ts =
+  do isNoLonger (noLongerThan reachInstance) ts
      paragraph $ translate $ do
        english "Start marking:"
        german "Startmarkierung:"
      indent $ text $ show (start n)
      pure ()
-  $>> executes path (drawUsing inst) n ts
+  $>> executes path (drawUsing reachInstance) n (map ShowTransition ts)
   $>>= \eitherOutcome -> whenRight eitherOutcome (\outcome ->
-    yesNo (outcome == goal inst) $ translate $ do
+    yesNo (outcome == goal reachInstance) $ translate $ do
       english "Reached target marking?"
       german "Zielmarkierung erreicht?"
     )
-  $>> assertReachPoints aSolution ((==) . goal) minLength inst ts eitherOutcome
+  $>> assertReachPoints
+    aSolution
+    ((==) . goal)
+    minLength
+    reachInstance
+    ts
+    eitherOutcome
   where
-    n = petriNet inst
+    reachInstance = toShowReachInstance reach
+    n = petriNet reachInstance
     aSolution
-      | showSolution inst = Just $ show $ TransitionsList $ reachSolution inst
+      | showSolution reach = Just $ show $ TransitionsList $ reachSolution reach
       | otherwise = Nothing
 
 reachSolution :: Ord s => ReachInstance s t -> [t]