From 1ad6666085c7d6ac7a3c303d400dbe1d7f54feb8 Mon Sep 17 00:00:00 2001
From: Gregory Gerasev <uhbif19@gmail.com>
Date: Fri, 19 Apr 2024 14:34:47 +0700
Subject: [PATCH] Fixup: commit missing changes for graph support

---
 cem-script.cabal                    |  2 +-
 src-lib/data-spine/Data/Spine.hs    |  3 ++-
 src/Cardano/CEM.hs                  |  9 +++++++--
 src/Cardano/CEM/Examples/Auction.hs | 10 +++++-----
 src/Cardano/CEM/Examples/Voting.hs  |  8 ++++----
 src/Cardano/CEM/OffChain.hs         |  2 +-
 6 files changed, 20 insertions(+), 14 deletions(-)

diff --git a/cem-script.cabal b/cem-script.cabal
index ac0c2bf..5682aae 100644
--- a/cem-script.cabal
+++ b/cem-script.cabal
@@ -161,7 +161,7 @@ library
   hs-source-dirs:  src/
   exposed-modules:
     Cardano.CEM
-    Cardano.CEM.Documentaiton
+    Cardano.CEM.Documentation
     Cardano.CEM.Examples.Auction
     Cardano.CEM.Examples.Compilation
     Cardano.CEM.Examples.Voting
diff --git a/src-lib/data-spine/Data/Spine.hs b/src-lib/data-spine/Data/Spine.hs
index b1bc50a..675417a 100644
--- a/src-lib/data-spine/Data/Spine.hs
+++ b/src-lib/data-spine/Data/Spine.hs
@@ -23,6 +23,7 @@ import Data.Singletons
 -}
 class
   ( Ord (Spine sop)
+  , Show (Spine sop)
   ) =>
   HasSpine sop
   where
@@ -110,7 +111,7 @@ deriveSpine name = do
     suffix = "Spine"
     spineName = addSuffix name suffix
     spineTypeQ = reifyType spineName
-  spineDec <- deriveTags name suffix [''Eq, ''Ord, ''Enum]
+  spineDec <- deriveTags name suffix [''Eq, ''Ord, ''Enum, ''Show]
   -- TODO: derive Sing
   -- TODO: derive HasField (OfSpine ...)
 
diff --git a/src/Cardano/CEM.hs b/src/Cardano/CEM.hs
index d3315d8..1d0ca50 100644
--- a/src/Cardano/CEM.hs
+++ b/src/Cardano/CEM.hs
@@ -81,6 +81,7 @@ class
   ( HasSpine (Transition script)
   , HasSpine (State script)
   , Stages (Stage script)
+  , Show (Stage script)
   ) =>
   CEMScript script
   where
@@ -101,12 +102,16 @@ class
   -- | Transitions for deterministic CEM-machine
   type Transition script = transition | transition -> script
 
-  -- | Each kind of Transition has statically associated Stage and State spine
+  -- | Each kind of Transition has statically associated Stage
+  -- from/to `State`s spines
   transitionStage ::
     Proxy script ->
     Map.Map
       (Spine (Transition script))
-      (Stage script, Maybe (Spine (State script)))
+      ( Stage script
+      , Maybe (Spine (State script))
+      , Maybe (Spine (State script))
+      )
 
   -- This functions define domain logic
   transitionSpec ::
diff --git a/src/Cardano/CEM/Examples/Auction.hs b/src/Cardano/CEM/Examples/Auction.hs
index 71005e1..68b993a 100644
--- a/src/Cardano/CEM/Examples/Auction.hs
+++ b/src/Cardano/CEM/Examples/Auction.hs
@@ -86,11 +86,11 @@ instance CEMScript SimpleAuction where
 
   transitionStage Proxy =
     Map.fromList
-      [ (CreateSpine, (Open, Nothing))
-      , (StartSpine, (Open, Just NotStartedSpine))
-      , (MakeBidSpine, (Open, Just CurrentBidSpine))
-      , (CloseSpine, (Closed, Just CurrentBidSpine))
-      , (BuyoutSpine, (Closed, Just WinnerSpine))
+      [ (CreateSpine, (Open, Nothing, Just NotStartedSpine))
+      , (StartSpine, (Open, Just NotStartedSpine, Just CurrentBidSpine))
+      , (MakeBidSpine, (Open, Just CurrentBidSpine, Just CurrentBidSpine))
+      , (CloseSpine, (Closed, Just CurrentBidSpine, Just WinnerSpine))
+      , (BuyoutSpine, (Closed, Just WinnerSpine, Nothing))
       ]
 
   {-# INLINEABLE transitionSpec #-}
diff --git a/src/Cardano/CEM/Examples/Voting.hs b/src/Cardano/CEM/Examples/Voting.hs
index 2fc860c..c183eaf 100644
--- a/src/Cardano/CEM/Examples/Voting.hs
+++ b/src/Cardano/CEM/Examples/Voting.hs
@@ -108,10 +108,10 @@ instance CEMScript SimpleVoting where
 
   transitionStage _ =
     Map.fromList
-      [ (CreateSpine, (Always, Nothing))
-      , (StartSpine, (Always, Just NotStartedSpine))
-      , (VoteSpine, (Always, Just InProgressSpine))
-      , (FinalizeSpine, (Always, Just InProgressSpine))
+      [ (CreateSpine, (Always, Nothing, Just NotStartedSpine))
+      , (StartSpine, (Always, Just NotStartedSpine, Just InProgressSpine))
+      , (VoteSpine, (Always, Just InProgressSpine, Just InProgressSpine))
+      , (FinalizeSpine, (Always, Just InProgressSpine, Nothing))
       ]
 
   {-# INLINEABLE transitionSpec #-}
diff --git a/src/Cardano/CEM/OffChain.hs b/src/Cardano/CEM/OffChain.hs
index 0f67432..a07de77 100644
--- a/src/Cardano/CEM/OffChain.hs
+++ b/src/Cardano/CEM/OffChain.hs
@@ -201,7 +201,7 @@ resolveAction
       let
         -- TODO
         mScriptTxIn = case transitionStage (Proxy :: Proxy script) Map.! getSpine transition of
-          (_, Nothing) -> Nothing
+          (_, Nothing, _) -> Nothing
           _ -> mScriptTxIn'
         mState = cemTxOutState =<< snd <$> mScriptTxIn
         witnesedScriptTxIns =