Chore: Separate repl into separate project, fix REPL docs output

docs/builtins/General/enforce.md

@@ -18,7 +18,7 @@ Use the following arguments to specify the test expression and error message for
 
 | Argument | Type   | Description                                    |
 |----------|--------|------------------------------------------------|
-| `expression` | bool | Specifies the expression to evaluate.     |
+| expression | bool | Specifies the expression to evaluate.     |
 | `message` | string | Specifies the error message to display if the `expression` evaluates as false. |
 
 ### Return values
@@ -34,7 +34,7 @@ pact> (enforce (= (+ 2 2) 4) "All is well")
 true
 ```
 
-Because the specified expression (`2 + 2 = 4`) is true, the function returns true and the transaction continues. 
+Because the specified expression (`2 + 2 = 4`) is true, the function returns true and the transaction continues.
 
 The following example demonstrates how to use the `enforce` function to evaluate the expression `(2 + 2) != 4`:
 

flake.nix

@@ -50,6 +50,7 @@
                 z3
                 pkg-config
               ];
+              shell.withHoogle = false;
             };
         })
       ];

gasmodel/Pact/Core/GasModel/ContractBench.hs

@@ -41,6 +41,8 @@ import Pact.Core.Gas
 import Pact.Core.Namespace
 import Pact.Core.Serialise
 import Pact.Core.Persistence.MockPersistence
+import qualified Pact.Core.IR.Eval.Direct.Evaluator as Direct
+import qualified Pact.Core.IR.Eval.Direct.CoreBuiltin as Direct
 
 import Pact.Core.Errors
 import Pact.Core.Interpreter
@@ -59,7 +61,15 @@ interpretBigStep :: Interpreter ExecRuntime CoreBuiltin Info
 interpretBigStep = evalInterpreter
 
 interpretDirect :: Interpreter ExecRuntime CoreBuiltin Info
-interpretDirect = evalDirectInterpreter
+interpretDirect =
+  Interpreter runGuard runTerm resume evalWithCap
+  where
+  runTerm purity term = Direct.eval purity benv term
+  runGuard info g = Direct.interpretGuard info benv g
+  resume info defPact = Direct.evalResumePact info benv defPact
+  evalWithCap info purity ct term =
+    Direct.evalWithinCap info purity benv ct term
+  benv = Direct.coreBuiltinEnv
 
 
 data CoinBenchSenders
@@ -179,7 +189,7 @@ setupCoinTxs pdb = do
   putStrLn "Setting up the coin contract and the default funds"
   source <- T.readFile (contractsPath </> "coin-v5-create.pact")
   ee <- setupBenchEvalEnv pdb coinInitSigners coinInitData
-  () <$ runPactTxFromSource ee source evalDirectInterpreter
+  () <$ runPactTxFromSource ee source interpretDirect
 
 
 _run :: IO ()

pact/Pact/Core/IR/Eval/Direct/Evaluator.hs → pact-repl/Pact/Core/IR/Eval/Direct/Evaluator.hs

@@ -675,7 +675,7 @@ applyLam
   -> EvalM e b i (EvalValue e b i)
 applyLam nclo@(N (NativeFn b env fn arity i)) args
   | arity == argLen = do
-    chargeFlatNativeGas i b
+    when (builtinChargesGas b) $ chargeFlatNativeGas i b
     fn i b env args
   | argLen > arity = throwExecutionError i ClosureAppliedToTooManyArgs
   | null args = return (VClosure nclo)

pact/Pact/Core/Repl/BuiltinDocs/Internal.hs → pact-repl/Pact/Core/Repl/BuiltinDocs/Internal.hs

@@ -9,11 +9,14 @@ import Language.Haskell.TH.Syntax
 import System.Directory
 import System.FilePath
 
+import Data.Default
 import Control.Monad
+import Control.Monad.IO.Class
 import qualified Data.Text.IO as T
 import qualified Data.Text as T
 import qualified Data.Map.Strict as M
 import Data.Functor
+import Text.Pandoc hiding (runIO)
 
 listBuiltinDocs :: IO [FilePath]
 listBuiltinDocs = do
@@ -41,10 +44,20 @@ mkBuiltinDocs = embedIO action
     files <- listBuiltinDocs
     cnt <- forM files $ \f -> do
       let bname = takeBaseName f
-      content <- T.readFile f
+      content <- runIOorExplode $
+        writeANSI writerOpts =<< readMarkdown readerOpts =<< liftIO (T.readFile f)
       pure (normalizedNameToBuiltin $ T.pack bname, MarkdownDoc content)
     pure $ M.fromList cnt
 
+readerOpts :: ReaderOptions
+readerOpts = def
+  { readerExtensions = pandocExtensions
+  }
+
+writerOpts :: WriterOptions
+writerOpts = def
+  { writerExtensions = pandocExtensions
+  }
 
 builtinToNormalizedName :: T.Text -> T.Text
 builtinToNormalizedName = \case

pact/Pact/Core/Repl/Utils.hs → pact-repl/Pact/Core/Repl/Utils.hs

@@ -9,6 +9,7 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE DataKinds #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 
 module Pact.Core.Repl.Utils
@@ -68,6 +69,7 @@ import Pact.Core.Environment
 import Pact.Core.Type
 import Pact.Core.Builtin
 import Pact.Core.PactValue
+import Pact.Core.Debug
 import qualified Pact.Core.IR.Term as Term
 
 import System.Console.Haskeline.Completion
@@ -246,3 +248,24 @@ replPrintLn' :: Text -> EvalM 'ReplRuntime b SpanInfo ()
 replPrintLn' p = do
   r <- getReplState
   _replOutputLine r p
+
+-- This orphan instance allows us to separate
+-- the repl declaration out, as ugly as it is
+instance DebugPrintable 'ReplRuntime (ReplBuiltin CoreBuiltin) where
+  debugPrint dp term =
+    ask >>= \case
+      ReplEnv _ -> do
+        case dp of
+          DPLexer -> whenReplFlagSet ReplDebugLexer $ liftIO $ do
+            putStrLn "----------- Lexer output -----------------"
+            print (pretty term)
+          DPParser -> whenReplFlagSet ReplDebugParser $
+              liftIO $ do
+                putStrLn "----------- Parser output ----------------"
+                print (pretty term)
+          DPDesugar -> whenReplFlagSet ReplDebugDesugar $ case term of
+            Term.TLTerm t ->
+              liftIO $ do
+                putStrLn "----------- Desugar output ---------------"
+                print (pretty t)
+            _ -> pure ()

pact-tng.cabal

@@ -185,23 +185,14 @@ library
   import: pact-common
   hs-source-dirs: pact
 
-  if (flag(with-funcall-tracing))
-    cpp-options: -DWITH_FUNCALL_TRACING
-
-  if (flag(with-native-tracing))
-    cpp-options: -DWITH_NATIVE_TRACING
-
-  if (flag(with-native-tracing) || flag(with-funcall-tracing))
-    cpp-options: -DWITH_TRACING
-
   if (flag(with-crypto))
     build-depends: pact-tng:pact-crypto
   else
     cpp-options: -DWITHOUT_CRYPTO
 
   build-tool-depends:
     , alex:alex
-    , happy:happy < 2
+    , happy:happy
 
   other-modules:
     -- TODO: Uncomment once this is finally fixed
@@ -246,7 +237,6 @@ library
     Pact.Core.Evaluate
     Pact.Core.Scheme
     Pact.Core.SPV
-    Pact.Core.Repl
     Pact.Core.SizeOf
     Pact.Core.SizeOf.Deriving
     Pact.Core.StackFrame
@@ -267,11 +257,6 @@ library
     Pact.Core.IR.Term
     Pact.Core.IR.Desugar
 
-    Pact.Core.IR.Eval.Direct.Evaluator
-    Pact.Core.IR.Eval.Direct.CoreBuiltin
-    Pact.Core.IR.Eval.Direct.ReplBuiltin
-    Pact.Core.IR.Eval.Direct.Types
-
     -- Core IR Evaluator modules
     Pact.Core.IR.Eval.Runtime
     Pact.Core.IR.Eval.Runtime.Types
@@ -286,14 +271,6 @@ library
     Pact.Core.Trans.MPFR
     Pact.Core.Version
 
-    -- Repl
-    Pact.Core.Repl.Utils
-    Pact.Core.Repl.Runtime.ReplBuiltin
-    Pact.Core.Repl.Compile
-    Pact.Core.Repl.BuiltinDocs
-    Pact.Core.Repl.BuiltinDocs.Internal
-    Pact.Core.Repl.UserDocs
-
     -- Serialization
     Pact.Core.Serialise
     Pact.Core.Serialise.LegacyPact
@@ -311,6 +288,44 @@ library
 
   extra-libraries: mpfr
 
+library pact-repl
+  import: pact-common
+  hs-source-dirs: pact-repl
+
+  if (flag(with-crypto))
+    build-depends: pact-tng:pact-crypto
+  else
+    cpp-options: -DWITHOUT_CRYPTO
+
+  if (flag(with-funcall-tracing))
+    cpp-options: -DWITH_FUNCALL_TRACING
+
+  if (flag(with-native-tracing))
+    cpp-options: -DWITH_NATIVE_TRACING
+
+  if (flag(with-native-tracing) || flag(with-funcall-tracing))
+    cpp-options: -DWITH_TRACING
+
+  exposed-modules:
+    Pact.Core.Repl
+    Pact.Core.Repl.Utils
+    Pact.Core.Repl.Runtime.ReplBuiltin
+    Pact.Core.Repl.Compile
+    Pact.Core.Repl.BuiltinDocs
+    Pact.Core.Repl.BuiltinDocs.Internal
+    Pact.Core.Repl.UserDocs
+
+    Pact.Core.IR.Eval.Direct.Evaluator
+    Pact.Core.IR.Eval.Direct.CoreBuiltin
+    Pact.Core.IR.Eval.Direct.ReplBuiltin
+    Pact.Core.IR.Eval.Direct.Types
+
+  build-depends:
+    , pact-tng
+    , pact-tng:pact-crypto
+    , filepath
+    , pandoc
+
 library pact-lsp
   import: pact-common
   hs-source-dirs: pact-lsp
@@ -322,6 +337,7 @@ library pact-lsp
 
   build-depends:
     , pact-tng
+    , pact-tng:pact-repl
     , lsp
     , lsp-types
     , filepath
@@ -334,6 +350,7 @@ executable gasmodel
 
   build-depends:
     , pact-tng
+    , pact-tng:pact-repl
     , criterion
     , terminal-progress-bar
     , neat-interpolation
@@ -369,10 +386,11 @@ executable profile-tx
 
 executable pact
   import: pact-common
-  main-is: repl/Main.hs
+  main-is: pact-repl/Main.hs
 
   build-depends: base
                , pact-tng
+               , pact-tng:pact-repl
                , pact-tng:pact-lsp
                , optparse-applicative
                , pact-tng:pact-request-api
@@ -458,7 +476,6 @@ library test-utils
     , semirings
     , neat-interpolation
     , pact-tng:pact-request-api
-    , pact-tng:pact-lsp
     , pact-tng:unsafe
     , lsp-test >= 0.17
     , lsp-types
@@ -523,6 +540,7 @@ test-suite core-tests
     , semirings
     , neat-interpolation
     , pact-tng:pact-request-api
+    , pact-tng:pact-repl
     , pact-tng:pact-lsp
     , pact-tng:test-utils
     , pact-tng:unsafe
@@ -568,22 +586,3 @@ test-suite core-tests
     , Pact.Core.Test.ServerUtils
   if (flag(with-crypto))
     build-depends: pact-tng:pact-crypto
-
-
--- -- tools
--- executable pact-server
---   import: pact-common
---   hs-source-dirs: pact-server
-
---   main-is: Pact/Server.hs
-
---   build-depends:
---     , pact-tng
---     , async
---     , fast-logger
---     , filepath
---     , servant
---     , servant-server
---   ghc-options:         -Wall -threaded -rtsopts -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints
---   ghc-prof-options:    -fprof-auto -fprof-auto-calls
---   default-language:    Haskell2010

pact/Pact/Core/Builtin.hs

@@ -566,6 +566,7 @@ coreBuiltinToUserText = \case
 
 instance IsBuiltin CoreBuiltin where
   builtinName = NativeName . coreBuiltinToText
+  builtinChargesGas _ = True
   builtinArity = \case
     CoreAdd -> 2
     -- Num ->
@@ -783,6 +784,7 @@ data ReplOnlyBuiltin
 
 instance IsBuiltin ReplOnlyBuiltin where
   builtinName = NativeName . replBuiltinsToText
+  builtinChargesGas _ = False
   builtinArity = \case
     RExpect -> 3
     RExpectFailure -> 2
@@ -843,6 +845,9 @@ instance IsBuiltin b => IsBuiltin (ReplBuiltin b) where
   builtinArity = \case
     RBuiltinWrap b -> builtinArity b
     RBuiltinRepl b -> builtinArity b
+  builtinChargesGas = \case
+    RBuiltinWrap b -> builtinChargesGas b
+    RBuiltinRepl b -> builtinChargesGas b
 
     -- RLoad -> 1
 
@@ -961,6 +966,7 @@ replCoreBuiltinOnlyMap =
 class Show b => IsBuiltin b where
   builtinArity :: b -> Int
   builtinName :: b -> NativeName
+  builtinChargesGas :: b -> Bool
 
 
 instance Pretty CoreBuiltin where

pact/Pact/Core/Compile.hs

@@ -153,7 +153,7 @@ evalModuleGovernance interpreter tl = do
 
 compileDesugarOnly
   :: forall e b i
-  .  (HasCompileEnv b i)
+  .  (HasCompileEnv b i, DebugPrintable e b)
   => Interpreter e b i
   -> Lisp.TopLevel i
   -> EvalM e b i (EvalTopLevel b i, S.Set ModuleName)
@@ -169,7 +169,7 @@ compileDesugarOnly interpreter tl = do
 
 interpretTopLevel
   :: forall e b i
-  .  (HasCompileEnv b i)
+  .  (HasCompileEnv b i, DebugPrintable e b)
   => Interpreter e b i
   -> RawCode
   -> Lisp.TopLevel i