chore: clean-up WIP

src/Cardano/CEM.hs

@@ -4,26 +4,18 @@
 -- FIXME: move all lib functions (`LiftPlutarch`s) to another module
 module Cardano.CEM where
 
-import Prelude
-
 import Data.Map qualified as Map
 import Data.Maybe (fromJust)
+import Data.Singletons.TH
+import Data.Spine (HasPlutusSpine, HasSpine (..), derivePlutusSpine, spineFieldsNum)
+import Data.Text (Text)
 import GHC.OverloadedLabels (IsLabel (..))
 import GHC.Records (HasField (..))
 import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
-import Unsafe.Coerce (unsafeCoerce)
-
--- Plutus imports
-import PlutusLedgerApi.V1.Crypto (PubKeyHash)
-import PlutusLedgerApi.V2 (ToData (..), Value)
-import PlutusTx qualified
-import PlutusTx.Builtins qualified as PlutusTx
-
-import Data.Singletons.TH
-import Data.Text (Text)
 import Plutarch (Config (..), (#))
 import Plutarch.Builtin (PIsData)
 import Plutarch.Evaluate (evalTerm)
+import Plutarch.Extras
 import Plutarch.LedgerApi (KeyGuarantees (..))
 import Plutarch.LedgerApi.Value
 import Plutarch.Lift (PUnsafeLiftDecl (..), pconstant, plift)
@@ -37,11 +29,13 @@ import Plutarch.Prelude (
   (#&&),
   (:-->),
  )
+import PlutusLedgerApi.V1.Crypto (PubKeyHash)
+import PlutusLedgerApi.V2 (ToData (..), Value)
 import PlutusLedgerApi.V2.Contexts (TxInfo)
-
--- Project imports
-import Data.Spine (HasPlutusSpine, HasSpine (..), derivePlutusSpine, spineFieldsNum)
-import Plutarch.Extras
+import PlutusTx qualified
+import PlutusTx.Builtins qualified as PlutusTx
+import Unsafe.Coerce (unsafeCoerce)
+import Prelude
 
 data CVar = CParams | CState | CTransition | CComp | CTxInfo
   deriving stock (Show)
@@ -60,18 +54,18 @@ type family DSLPattern (resolved :: Bool) script value where
 data TxFanKind = In | InRef | Out
   deriving stock (Prelude.Eq, Prelude.Show)
 
-data TxFanFilterNew (resolved :: Bool) script
+data TxFanFilter (resolved :: Bool) script
   = UserAddress (DSLValue resolved script PubKeyHash)
   | -- FIXME: should have spine been specified known statically
     SameScript (DSLValue resolved script (State script))
 
-deriving stock instance (CEMScript script) => (Show (TxFanFilterNew True script))
-deriving stock instance (Show (TxFanFilterNew False script))
+deriving stock instance (CEMScript script) => (Show (TxFanFilter True script))
+deriving stock instance (Show (TxFanFilter False script))
 
 data TxConstraint (resolved :: Bool) script
   = TxFan
       { kind :: TxFanKind
-      , cFilter :: TxFanFilterNew resolved script
+      , cFilter :: TxFanFilter resolved script
       , value :: DSLValue resolved script Value
       }
   | MainSignerCoinSelect
@@ -479,7 +473,7 @@ type CEMScriptSpec resolved script =
       [TxConstraint resolved script]
   )
 
-data CompilationConfig = MkCompilationConfig
+newtype CompilationConfig = MkCompilationConfig
   { errorCodesPrefix :: String
   }
 

src/Cardano/CEM/Address.hs

@@ -31,25 +31,23 @@ cardanoAddressBech32 = MkAddressBech32 . Cardano.Api.serialiseToBech32
 scriptCardanoAddress ::
   forall script.
   (Compiled.CEMScriptCompiled script) =>
-  Proxy script ->
   Cardano.Api.Ledger.Network ->
+  Proxy script ->
   Either String (Cardano.Api.Address Cardano.Api.ShelleyAddr)
-scriptCardanoAddress p network =
+scriptCardanoAddress network =
   plutusAddressToShelleyAddress network
     . flip PlutusLedgerApi.V1.Address Nothing
     . scriptCredential
-    $ p
 
 scriptCredential ::
   forall script.
   (Compiled.CEMScriptCompiled script) =>
   Proxy script ->
   PlutusLedgerApi.V1.Credential
-scriptCredential p =
+scriptCredential =
   PlutusLedgerApi.V1.ScriptCredential
     . scriptHash
     . Compiled.cemScriptCompiled
-    $ p
 
 plutusAddressToShelleyAddress ::
   Cardano.Api.Ledger.Network ->

src/Cardano/CEM/DSL.hs

@@ -1,19 +1,15 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE RecordWildCards #-}
 
 module Cardano.CEM.DSL where
 
-import Prelude
-
-import Data.Map qualified as Map
-
-import Data.Text (pack, unpack)
-import Text.Show.Pretty (ppShowList)
-
 import Cardano.CEM
+import Data.Map qualified as Map
 import Data.Maybe (listToMaybe, mapMaybe)
 import Data.Spine (HasSpine (..))
+import Data.Text (pack, unpack)
 import PlutusLedgerApi.V1 (PubKeyHash)
+import Text.Show.Pretty (ppShowList)
+import Prelude
 
 -- Generic check datatypes
 
@@ -44,11 +40,9 @@ sameScriptStateSpinesOfKind ::
   TxConstraint False script ->
   [Spine (State script)]
 sameScriptStateSpinesOfKind xKind constr = case constr of
-  TxFan kind (SameScript state) _ ->
-    if kind == xKind then [parseSpine state] else []
-  If _ t e -> recur t <> (recur e)
-  MatchBySpine _ caseSwitch ->
-    foldMap recur (Map.elems caseSwitch)
+  TxFan kind (SameScript state) _ -> [parseSpine state | kind == xKind]
+  If _ t e -> recur t <> recur e
+  MatchBySpine _ caseSwitch -> foldMap recur (Map.elems caseSwitch)
   _ -> []
   where
     recur = sameScriptStateSpinesOfKind xKind
@@ -58,8 +52,7 @@ sameScriptStateSpinesOfKind xKind constr = case constr of
     parseSpine (UnsafeOfSpine spine _) = spine
     parseSpine (UnsafeUpdateOfSpine _ spine _) = spine
     -- FIXME: yet another not-properly DSL type encoded place
-    parseSpine _ =
-      error "SameScript is too complex to statically know its spine"
+    parseSpine _ = error "SameScript is too complex to statically know its spine"
 
 isSameScriptOfKind :: TxFanKind -> TxConstraint resolved script -> CheckResult
 isSameScriptOfKind xKind constr = case constr of

src/Cardano/CEM/Documentation.hs

@@ -1,37 +1,26 @@
-module Cardano.CEM.Documentation (cemDotGraphString) where
-
-import Prelude
+module Cardano.CEM.Documentation (genCemGraph) where
 
+import Cardano.CEM (
+  CEMScript (perTransitionScriptSpec),
+  CEMScriptTypes (Transition),
+  TxFanKind (In, Out),
+ )
+import Cardano.CEM.DSL (transitionStateSpines)
 import Data.Foldable (fold)
 import Data.Map qualified as Map
 import Data.Proxy
-
-import Cardano.CEM
-import Cardano.CEM.DSL (transitionStateSpines)
 import Data.Spine (allSpines)
+import Prelude
 
-dotStyling :: String
-dotStyling =
-  "rankdir=LR;\n"
-    <> "node [shape=\"dot\",fontsize=14,fixedsize=true,width=1.5];\n"
-    <> "edge [fontsize=11];\n"
-    <> "\"Void In\" [color=\"orange\"];\n"
-    <> "\"Void Out\" [color=\"orange\"];\n"
-
--- FIXME: cover with golden test
-cemDotGraphString ::
-  forall script. (CEMScript script) => String -> Proxy script -> String
-cemDotGraphString name _proxy =
+genCemGraph :: forall script. (CEMScript script) => String -> Proxy script -> String
+genCemGraph name _proxy =
   "digraph "
     <> name
     <> " {\n"
     <> dotStyling
     <> edges
     <> "}"
   where
-    showSpine :: (Show s) => s -> String
-    showSpine = stripSpineSuffix . show
-    stripSpineSuffix = reverse . drop 5 . reverse
     edges =
       fold $
         [ from
@@ -49,3 +38,16 @@ cemDotGraphString name _proxy =
         perTransitionScriptSpec @script Map.! transition of
         [] -> ["\"Void " <> show kind <> "\""]
         x -> map showSpine x
+
+    showSpine :: (Show s) => s -> String
+    showSpine = stripSpineSuffix . show
+
+    stripSpineSuffix = reverse . drop 5 . reverse
+
+    dotStyling :: String
+    dotStyling =
+      "rankdir=LR;\n"
+        <> "node [shape=\"dot\",fontsize=14,fixedsize=true,width=1.5];\n"
+        <> "edge [fontsize=11];\n"
+        <> "\"Void In\" [color=\"orange\"];\n"
+        <> "\"Void Out\" [color=\"orange\"];\n"

src/Cardano/CEM/Examples/Auction.hs

@@ -3,20 +3,16 @@
 
 module Cardano.CEM.Examples.Auction where
 
-import PlutusTx.Prelude
-import Prelude qualified
-
+import Cardano.CEM
+import Cardano.CEM.TH (deriveCEMAssociatedTypes)
 import Data.Map qualified as Map
-
+import Data.Spine (derivePlutusSpine)
 import PlutusLedgerApi.V1.Crypto (PubKeyHash)
 import PlutusLedgerApi.V2 (Value)
+import PlutusTx.Prelude
+import Prelude qualified
 
-import Cardano.CEM
-import Cardano.CEM.TH (deriveCEMAssociatedTypes)
-import Data.Spine
-
--- Simple no-deposit auction
-
+-- | Simple no-deposit auction
 data SimpleAuction
 
 data Bid = MkBet

src/Cardano/CEM/Indexing/Event.hs

@@ -76,8 +76,8 @@ extractEvent ::
   Tx ->
   IO (Maybe (IndexerEvent script))
 extractEvent network tx = do
-  -- Script payemnt credential based predicate
-  let ~(Right scriptAddr) = Address.scriptCardanoAddress (Proxy @script) network
+  -- Script payment credential based predicate
+  let ~(Right scriptAddr) = Address.scriptCardanoAddress network (Proxy @script)
   let cPred = hasAddr scriptAddr
 
   -- Source state

src/Cardano/CEM/Indexing/Oura.hs

@@ -68,7 +68,7 @@ ouraMonitoringScript p network sourcePath sinkPath =
     . pure
     . selectByAddress
     . Address.cardanoAddressBech32
-    <$> Address.scriptCardanoAddress p network
+    <$> Address.scriptCardanoAddress network p
 
 cursor :: Toml.Table
 cursor =

src/Cardano/CEM/TH.hs

@@ -76,7 +76,7 @@ deriveCEMAssociatedTypes _deriveBlueprint scriptName = do
 
 compileCEM :: Bool -> Name -> Q [Dec]
 compileCEM debugBuild name = do
-  -- FIXIT: two duplicating cases on `transitionComp`
+  -- TODO: two duplicating cases on `transitionComp`
   let plutusScript =
         [|
           \a b c -> case transitionComp @($(conT name)) of

src/Cardano/CEM/Testing/StateMachine.hs

@@ -9,7 +9,7 @@ module Cardano.CEM.Testing.StateMachine where
 import Prelude
 
 import Cardano.Api (PaymentKey, SigningKey, TxId, Value)
-import Cardano.CEM (CEMScript, CEMScriptTypes (Params, State, Transition), TxConstraint (TxFan), TxFanFilterNew (SameScript), TxFanKind (Out))
+import Cardano.CEM (CEMScript, CEMScriptTypes (Params, State, Transition), TxConstraint (TxFan), TxFanFilter (SameScript), TxFanKind (Out))
 import Cardano.CEM.DSL (getMainSigner)
 import Cardano.CEM.Monads (
   BlockchainMonadEvent (..),

test/Main.hs

@@ -8,7 +8,8 @@ import Test.Hspec (hspec, runIO)
 
 import Auction (auctionSpec)
 import Data.Maybe (isJust)
-import Dynamic (dynamicSpec)
+
+-- import Dynamic (dynamicSpec)
 import OffChain (offChainSpec)
 import OuraFilters.Simple (simpleSpec)
 import System.Environment (lookupEnv)
@@ -22,7 +23,7 @@ main = do
     auctionSpec
     votingSpec
     offChainSpec
-    dynamicSpec
+    -- dynamicSpec
     if runIndexing
       then do
         -- These tests are not currently supported on CI

test/OuraFilters/Auction.hs

@@ -8,7 +8,6 @@ import Cardano.CEM.Examples.Auction qualified as Auction
 import Cardano.CEM.Examples.Compilation ()
 import Cardano.CEM.Indexing.Oura qualified as OuraConfig
 import Cardano.CEM.Indexing.Tx qualified as Tx
-import Cardano.CEM.OnChain qualified as Compiled
 import Cardano.Ledger.BaseTypes qualified as Ledger
 import Control.Lens ((%~), (.~))
 import Control.Monad ((>=>))
@@ -20,7 +19,6 @@ import Data.Data (Proxy (Proxy))
 import Data.Text qualified as T
 import Oura.Communication qualified as Oura
 import OuraFilters.Mock qualified as Mock
-import Plutus.Extras (scriptValidatorHash)
 import PlutusLedgerApi.V1 qualified
 import System.Process (ProcessHandle)
 import Test.Hspec (describe, focus, it, shouldBe)