chore: remove redundant transitionStage

Author: euonymos

example/CEM/Example/Auction.hs

@@ -59,14 +59,14 @@ $(deriveCEMAssociatedTypes False ''SimpleAuction)
 instance CEMScript SimpleAuction where
   compilationConfig = MkCompilationConfig "AUC"
 
-  transitionStage _ =
-    Map.fromList
-      [ (CreateSpine, (Nothing, Just NotStartedSpine))
-      , (StartSpine, (Just NotStartedSpine, Just CurrentBidSpine))
-      , (MakeBidSpine, (Just CurrentBidSpine, Just CurrentBidSpine))
-      , (CloseSpine, (Just CurrentBidSpine, Just WinnerSpine))
-      , (BuyoutSpine, (Just WinnerSpine, Nothing))
-      ]
+  -- transitionStage _ =
+  --   Map.fromList
+  --     [ (CreateSpine, (Nothing, Just NotStartedSpine))
+  --     , (StartSpine, (Just NotStartedSpine, Just CurrentBidSpine))
+  --     , (MakeBidSpine, (Just CurrentBidSpine, Just CurrentBidSpine))
+  --     , (CloseSpine, (Just CurrentBidSpine, Just WinnerSpine))
+  --     , (BuyoutSpine, (Just WinnerSpine, Nothing))
+  --     ]
 
   perTransitionScriptSpec =
     Map.fromList

lib/data-spine/Data/Spine.hs

@@ -79,7 +79,7 @@ allSpines = [Prelude.minBound .. Prelude.maxBound]
 data MaybeSpine a = JustSpine | NothingSpine
   deriving stock (Eq, Ord, Show, Bounded, Enum)
 
--- FIXME: could such types be derived?
+-- TODO: could such types be derived?
 instance HasSpine (Maybe x) where
   type Spine (Maybe x) = MaybeSpine x
   getSpine Just {} = JustSpine

src/Cardano/CEM.hs

@@ -3,13 +3,10 @@ module Cardano.CEM (
 ) where
 
 -- TODO: review
-import Cardano.CEM.DSL as X
-
--- ( CEMScript (..),
---   CEMScriptTypes(..)
--- )
 
 import Cardano.CEM.Address as X (scriptCredential)
+import Cardano.CEM.Compile as X
+import Cardano.CEM.DSL as X
 import Cardano.CEM.DSLSmart as X
 import Cardano.CEM.Monads as X
 import Cardano.CEM.Monads.CLB as X

src/Cardano/CEM/Compile.hs

@@ -1,5 +1,7 @@
 module Cardano.CEM.Compile (
+  allTransitions,
   transitionInStateSpine,
+  transitionOutStateSpine,
   transitionStateSpines,
   preProcessForOnChainCompilation,
 ) where
@@ -10,6 +12,19 @@ import Data.Spine (HasSpine (..))
 import Text.Show.Pretty (ppShowList)
 import Prelude
 
+allTransitions ::
+  forall script.
+  (CEMScript script) =>
+  Map.Map
+    (Spine (Transition script))
+    ( Maybe (Spine (State script)) -- source 'State'
+    , Maybe (Spine (State script)) -- target 'State'
+    )
+allTransitions = Map.map foo perTransitionScriptSpec
+  where
+    foo :: [TxConstraint False script] -> (Maybe (Spine (State script)), Maybe (Spine (State script)))
+    foo cs = (transitionInStateSpine cs, transitionOutStateSpine cs)
+
 transitionInStateSpine ::
   (CEMScript script) =>
   [TxConstraint False script] ->
@@ -21,6 +36,17 @@ transitionInStateSpine spec = case transitionStateSpines In spec of
     error
       "Transition should not have more than one SameScript In constraint"
 
+transitionOutStateSpine ::
+  (CEMScript script) =>
+  [TxConstraint False script] ->
+  Maybe (Spine (State script))
+transitionOutStateSpine spec = case transitionStateSpines Out spec of
+  [x] -> Just x
+  [] -> Nothing
+  _ ->
+    error
+      "Transition should not have more than one SameScript In constraint"
+
 transitionStateSpines :: (CEMScript script) => TxFanKind -> [TxConstraint False script] -> [Spine (State script)]
 transitionStateSpines kind spec = concat $ map (sameScriptStateSpinesOfKind kind) spec
   where
@@ -47,7 +73,7 @@ transitionStateSpines kind spec = concat $ map (sameScriptStateSpinesOfKind kind
 
 -- FIXME: check MainSignerCoinSelect, ...
 
--- | Checking for errors and normaliing
+-- | Checking for errors and normalising
 preProcessForOnChainCompilation ::
   (CEMScript script, Show a) =>
   Map.Map a [TxConstraint False script] ->

src/Cardano/CEM/DSL.hs

@@ -362,19 +362,6 @@ class
 
   compilationConfig :: CompilationConfig
 
-  -- TODO: remove
-
-  -- | This is the map of all possible machine 'Transition's.
-  -- This statically associates every 'Transition' with
-  -- a 'Stage' through source/target 'State's.
-  transitionStage ::
-    Proxy script ->
-    Map.Map
-      (Spine (Transition script))
-      ( Maybe (Spine (State script)) -- source 'State'
-      , Maybe (Spine (State script)) -- target 'State'
-      )
-  transitionStage _ = Map.empty
 
 type DefaultConstraints datatype =
   ( Eq datatype

src/Cardano/CEM/Indexing/Event.hs

@@ -6,7 +6,7 @@ module Cardano.CEM.Indexing.Event where
 import Cardano.Api qualified as C
 import Cardano.Api.ScriptData qualified as C
 import Cardano.Api.SerialiseRaw qualified as SerialiseRaw
-import Cardano.CEM (CEMScript (transitionStage), CEMScriptDatum, State, Transition)
+import Cardano.CEM (CEMScript, CEMScriptDatum, State, Transition, allTransitions)
 import Cardano.CEM.Address qualified as Address
 import Cardano.CEM.Indexing.Tx
 import Cardano.CEM.OnChain (CEMScriptCompiled)
@@ -91,7 +91,7 @@ extractEvent network tx = do
   let mTargetSpine :: Maybe (Spine (State script)) = getSpine <$> mTargetState
 
   -- Look up the transition
-  let transitions = swap <$> Map.toList (transitionStage $ Proxy @script)
+  let transitions = swap <$> Map.toList allTransitions
   let transSpine = lookup (mSourceSpine, mTargetSpine) transitions
 
   -- Return