studio: Show GluedTransitionId history for a given firing. #307

statebox · Jan 21, 2020 · 60f5140 · 60f5140
1 parent c2fdada
commit 60f5140
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 6 deletions.
diff --git a/stbx-core/src/Statebox/Core/Lenses.purs b/stbx-core/src/Statebox/Core/Lenses.purs
@@ -1,11 +1,12 @@
 module Statebox.Core.Lenses where
 
 import Prelude
-import Data.Lens (Prism', prism', Lens', lens)
+import Data.Lens (Prism', Iso', Lens', lens, prism', re, _Newtype)
+import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Maybe (Maybe(..))
 import Data.NonEmpty (singleton, head)
 import Statebox.Core.Transaction (TxSum(..), WiringTx, FiringTx, isExecutionTx)
-import Statebox.Core.Types (Firing, GluedTransitionIdRaw)
+import Statebox.Core.Types (Firing, GluedTransitionId(..), GluedTransitionIdRaw)
 
 --------------------------------------------------------------------------------
 
@@ -26,5 +27,11 @@ _executionTx = prism' FiringTxInj $ case _ of FiringTxInj x | isExecutionTx x ->
 _firing :: Lens' FiringTx Firing
 _firing = lens (_.firing) (_ { firing = _ })
 
-_firingPath :: Lens' Firing GluedTransitionIdRaw
-_firingPath = lens (_.path >>> head) (\r x -> r { path = singleton x })
+_firingPath :: Lens' Firing GluedTransitionId
+_firingPath = _firingPathRaw <<< re _GluedTransitionId
+
+_firingPathRaw :: Lens' Firing GluedTransitionIdRaw
+_firingPathRaw = lens (_.path >>> head) (\r x -> r { path = singleton x })
+
+_GluedTransitionId :: Iso' GluedTransitionId GluedTransitionIdRaw
+_GluedTransitionId = _Newtype
diff --git a/studio/src/View/Transaction.purs b/studio/src/View/Transaction.purs
@@ -14,8 +14,9 @@ import Halogen.HTML.Properties (href)
 import View.Studio.Model (Action(..))
 import View.Studio.Model.Route (WiringFiringInfo, ExecutionTrace)
 import Statebox.Client (txUrl)
-import Statebox.Core.Transaction (HashStr, TxSum, FiringTx, WiringTx, isExecution)
 import Statebox.Core.Lenses (_firingTx, _firing, _firingPath)
+import Statebox.Core.Transaction (HashStr, TxSum, FiringTx, WiringTx, isExecution)
+import Statebox.Core.Types (TID, GluedTransitionId(..))
 
 
 firingTxView :: ∀ s m. MonadAff m => WiringFiringInfo -> FiringTx -> String \/ ExecutionTrace -> ComponentHTML Action s m
@@ -24,9 +25,12 @@ firingTxView wfi tx executionTrace =
       [ p     [] [ text $ if isExecution tx.firing then "Execution" else "Firing" ]
       , table [] $ txWrapperRows wfi tx <>
                    firingTxBodyRows wfi tx <>
-                   [ row "trace" $ text $ show $ map (mapMaybe (preview (second <<< _Just <<< _firingTx <<< _firing <<< _firingPath))) executionTrace ] <>
+                   [ row "trace" $ text $ show $ firedTransitions ] <>
                    [ row "trace raw" $ text (show executionTrace) ]
       ]
+  where
+    firedTransitions :: String \/ Array GluedTransitionId
+    firedTransitions = map (mapMaybe (preview (second <<< _Just <<< _firingTx <<< _firing <<< _firingPath))) executionTrace
 
 wiringTxView :: ∀ s m. MonadAff m => WiringFiringInfo -> WiringTx -> ComponentHTML Action s m
 wiringTxView wfi tx =