chore: clean-up WIP

Author: euonymos

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)

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,5 +1,4 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE RecordWildCards #-}
 
 module Cardano.CEM.DSL where
 

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/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 =

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)