Merge pull request #39 from Plutonomicon/tracing

Add tracing utilities; with cabal flags switching

Plutarch/Trace.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE CPP #-}
+
+module Plutarch.Trace (ptrace, ptraceIfTrue, ptraceIfFalse, ptraceError) where
+
+-- CPP support isn't great in fourmolu.
+{- ORMOLU_DISABLE -}
+
+#ifdef Development
+import Plutarch (punsafeBuiltin)
+#endif
+#ifdef Development
+import Plutarch.Bool (PBool, pif)
+#else
+import Plutarch.Bool (PBool)
+#endif
+import Plutarch.Prelude
+import Plutarch.String (PString)
+
+#ifdef Development
+import qualified PlutusCore as PLC
+#endif
+
+#ifdef Development
+ptrace' :: Term s (PString :--> a :--> a)
+ptrace' = phoistAcyclic $ pforce $ punsafeBuiltin PLC.Trace
+#endif
+
+-- | Trace the given message before evaluating the argument.
+ptrace :: Term s PString -> Term s a -> Term s a
+#ifdef Development
+ptrace s a = pforce $ ptrace' # s # pdelay a
+#else
+ptrace _ a = a
+#endif
+
+-- | Trace the given message and terminate evaluation with a 'perror'.
+ptraceError :: Term s PString -> Term s a
+#ifdef Development
+ptraceError s = pforce $ ptrace' # s # pdelay perror
+#else
+ptraceError _ = perror
+#endif
+
+-- | Trace the given message if the argument evaluates to true.
+ptraceIfTrue :: Term s PString -> Term s PBool -> Term s PBool
+#ifdef Development
+ptraceIfTrue s a' = plet a' $ \a -> pif a (ptrace' # s # a) a
+#else
+ptraceIfTrue _ a = a
+#endif
+
+-- | Trace the given message if the argument evaluates to False.
+ptraceIfFalse :: Term s PString -> Term s PBool -> Term s PBool
+#ifdef Development
+ptraceIfFalse s a' = plet a' $ \a -> pif a a (ptrace' # s # a)
+#else
+ptraceIfFalse _ a = a
+#endif

examples/Main.hs

@@ -18,6 +18,7 @@ import Plutarch.Evaluate (evaluateScript)
 import Plutarch.Integer (PInteger)
 import Plutarch.Prelude
 import Plutarch.ScriptContext (PScriptPurpose (PMinting))
+import Plutarch.Spec.Tracing (traceTests)
 import Plutarch.String (PString, pfromText)
 import Plutarch.Unit (PUnit (..))
 import qualified Plutus.V1.Ledger.Scripts as Scripts
@@ -216,6 +217,7 @@ plutarchTests =
     , testCase "PAsData equality" $ do
         expect $ let dat = pdata @PInteger 42 in dat #== dat
         expect $ pnot #$ pdata (phexByteStr "12") #== pdata (phexByteStr "ab")
+    , testCase "Tracing" $ traceTests
     , testCase "λx y -> addInteger x y => addInteger" $
         printTerm (plam $ \x y -> (x :: Term _ PInteger) + y) @?= "(program 1.0.0 addInteger)"
     , testCase "λx y -> hoist (force mkCons) x y => force mkCons" $

examples/Plutarch/Spec/Tracing.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE CPP #-}
+
+module Plutarch.Spec.Tracing (traceTests) where
+
+import Test.Tasty.HUnit
+
+import Data.Text (Text)
+import Plutarch
+import Plutarch.Bool (PBool (PFalse, PTrue))
+import Plutarch.Evaluate (evaluateScript)
+import Plutarch.Trace (ptrace, ptraceIfFalse, ptraceIfTrue)
+import Plutarch.Unit (PUnit (PUnit))
+
+traces :: ClosedTerm a -> [Text] -> Assertion
+traces x sl =
+  case evaluateScript $ compile x of
+    Left e -> assertFailure $ "Script evaluation failed: " <> show e
+    Right (_, traceLog, _) -> traceLog @?= sl
+
+traceTests :: IO ()
+traceTests = do
+
+-- CPP support isn't great in fourmolu.
+{- ORMOLU_DISABLE -}
+  ptrace "foo" (pcon PUnit) `traces`
+#ifdef Development
+    ["foo"]
+#else
+    []
+#endif
+
+  ptrace "foo" (ptrace "bar" $ pcon PUnit) `traces`
+#ifdef Development
+    ["foo", "bar"]
+#else
+    []
+#endif
+
+  ptraceIfTrue "foo" (pcon PTrue) `traces`
+#ifdef Development
+    ["foo"]
+#else
+    []
+#endif
+
+  ptraceIfTrue "foo" (pcon PFalse) `traces` []
+
+  ptraceIfTrue "foo" (ptraceIfTrue "bar" $ pcon PTrue) `traces`
+#ifdef Development
+    ["bar", "foo"]
+#else
+    []
+#endif
+
+  ptraceIfTrue "foo" (ptraceIfTrue "bar" $ pcon PFalse) `traces` []
+  ptraceIfFalse "foo" (ptraceIfTrue "bar" $ pcon PFalse) `traces`
+#ifdef Development
+    ["foo"]
+#else
+    []
+#endif
+
+  ptrace "foo" (ptraceIfTrue "bar" (pcon PTrue)) `traces`
+#ifdef Development
+    ["foo", "bar"]
+#else
+    []
+#endif
+
+  ptrace "foo" (ptraceIfTrue "bar" (pcon PFalse)) `traces`
+#ifdef Development
+    ["foo"]
+#else
+    []
+#endif
+{- ORMOLU_ENABLE -}

plutarch.cabal

@@ -7,6 +7,11 @@ license: MIT
 
 extra-source-files: README.md
 
+flag development
+  description: Enable tracing functions within plutarch.
+  manual: True
+  default: False
+
 common c
   default-language: Haskell2010
   default-extensions:
@@ -89,6 +94,7 @@ library
     Plutarch.Maybe
     Plutarch.Unit
     Plutarch.Crypto
+    Plutarch.Trace
   build-depends:
     , base
     , plutus-core
@@ -102,19 +108,27 @@ library
     , mtl
     , flat
 
+  if flag(development)
+    cpp-options: -DDevelopment
+
 test-suite examples
   import: c
   type: exitcode-stdio-1.0
   main-is: Main.hs
   hs-source-dirs: examples
   other-modules:
+    Plutarch.Spec.Tracing
   build-depends:
     , base
     , bytestring
+    , text
     , plutarch
     , tasty
     , tasty-hunit
     , plutus-ledger-api
     , plutus-core
     , aeson
     , plutus-tx
+
+  if flag(development)
+    cpp-options: -DDevelopment