From 419b8077fd92b0c27ab6295aa5519175acca11c2 Mon Sep 17 00:00:00 2001 From: jmcardon Date: Mon, 4 Nov 2024 14:53:47 -0500 Subject: [PATCH] Separate repl into separate project, fix REPL docs output --- docs/builtins/General/enforce.md | 4 +- {repl => pact-repl}/Main.hs | 0 .../Pact/Core/IR/Eval/Direct/CoreBuiltin.hs | 0 .../Pact/Core/IR/Eval/Direct/Evaluator.hs | 0 .../Pact/Core/IR/Eval/Direct/ReplBuiltin.hs | 0 .../Pact/Core/IR/Eval/Direct/Types.hs | 0 {pact => pact-repl}/Pact/Core/Repl.hs | 0 .../Pact/Core/Repl/BuiltinDocs.hs | 0 .../Pact/Core/Repl/BuiltinDocs/Internal.hs | 15 +++++- {pact => pact-repl}/Pact/Core/Repl/Compile.hs | 0 .../Pact/Core/Repl/Runtime/ReplBuiltin.hs | 0 .../Pact/Core/Repl/UserDocs.hs | 0 {pact => pact-repl}/Pact/Core/Repl/Utils.hs | 23 +++++++++ pact-tng.cabal | 48 ++++++++++++++----- pact/Pact/Core/Compile.hs | 4 +- pact/Pact/Core/Debug.hs | 32 ++++--------- pact/Pact/Core/Evaluate.hs | 26 +++++----- 17 files changed, 98 insertions(+), 54 deletions(-) rename {repl => pact-repl}/Main.hs (100%) rename {pact => pact-repl}/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs (100%) rename {pact => pact-repl}/Pact/Core/IR/Eval/Direct/Evaluator.hs (100%) rename {pact => pact-repl}/Pact/Core/IR/Eval/Direct/ReplBuiltin.hs (100%) rename {pact => pact-repl}/Pact/Core/IR/Eval/Direct/Types.hs (100%) rename {pact => pact-repl}/Pact/Core/Repl.hs (100%) rename {pact => pact-repl}/Pact/Core/Repl/BuiltinDocs.hs (100%) rename {pact => pact-repl}/Pact/Core/Repl/BuiltinDocs/Internal.hs (85%) rename {pact => pact-repl}/Pact/Core/Repl/Compile.hs (100%) rename {pact => pact-repl}/Pact/Core/Repl/Runtime/ReplBuiltin.hs (100%) rename {pact => pact-repl}/Pact/Core/Repl/UserDocs.hs (100%) rename {pact => pact-repl}/Pact/Core/Repl/Utils.hs (88%) diff --git a/docs/builtins/General/enforce.md b/docs/builtins/General/enforce.md index f43dbd602..061fb562a 100644 --- a/docs/builtins/General/enforce.md +++ b/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`: diff --git a/repl/Main.hs b/pact-repl/Main.hs similarity index 100% rename from repl/Main.hs rename to pact-repl/Main.hs diff --git a/pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs b/pact-repl/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs similarity index 100% rename from pact/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs rename to pact-repl/Pact/Core/IR/Eval/Direct/CoreBuiltin.hs diff --git a/pact/Pact/Core/IR/Eval/Direct/Evaluator.hs b/pact-repl/Pact/Core/IR/Eval/Direct/Evaluator.hs similarity index 100% rename from pact/Pact/Core/IR/Eval/Direct/Evaluator.hs rename to pact-repl/Pact/Core/IR/Eval/Direct/Evaluator.hs diff --git a/pact/Pact/Core/IR/Eval/Direct/ReplBuiltin.hs b/pact-repl/Pact/Core/IR/Eval/Direct/ReplBuiltin.hs similarity index 100% rename from pact/Pact/Core/IR/Eval/Direct/ReplBuiltin.hs rename to pact-repl/Pact/Core/IR/Eval/Direct/ReplBuiltin.hs diff --git a/pact/Pact/Core/IR/Eval/Direct/Types.hs b/pact-repl/Pact/Core/IR/Eval/Direct/Types.hs similarity index 100% rename from pact/Pact/Core/IR/Eval/Direct/Types.hs rename to pact-repl/Pact/Core/IR/Eval/Direct/Types.hs diff --git a/pact/Pact/Core/Repl.hs b/pact-repl/Pact/Core/Repl.hs similarity index 100% rename from pact/Pact/Core/Repl.hs rename to pact-repl/Pact/Core/Repl.hs diff --git a/pact/Pact/Core/Repl/BuiltinDocs.hs b/pact-repl/Pact/Core/Repl/BuiltinDocs.hs similarity index 100% rename from pact/Pact/Core/Repl/BuiltinDocs.hs rename to pact-repl/Pact/Core/Repl/BuiltinDocs.hs diff --git a/pact/Pact/Core/Repl/BuiltinDocs/Internal.hs b/pact-repl/Pact/Core/Repl/BuiltinDocs/Internal.hs similarity index 85% rename from pact/Pact/Core/Repl/BuiltinDocs/Internal.hs rename to pact-repl/Pact/Core/Repl/BuiltinDocs/Internal.hs index ab44ffbe0..e59e86a68 100644 --- a/pact/Pact/Core/Repl/BuiltinDocs/Internal.hs +++ b/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 diff --git a/pact/Pact/Core/Repl/Compile.hs b/pact-repl/Pact/Core/Repl/Compile.hs similarity index 100% rename from pact/Pact/Core/Repl/Compile.hs rename to pact-repl/Pact/Core/Repl/Compile.hs diff --git a/pact/Pact/Core/Repl/Runtime/ReplBuiltin.hs b/pact-repl/Pact/Core/Repl/Runtime/ReplBuiltin.hs similarity index 100% rename from pact/Pact/Core/Repl/Runtime/ReplBuiltin.hs rename to pact-repl/Pact/Core/Repl/Runtime/ReplBuiltin.hs diff --git a/pact/Pact/Core/Repl/UserDocs.hs b/pact-repl/Pact/Core/Repl/UserDocs.hs similarity index 100% rename from pact/Pact/Core/Repl/UserDocs.hs rename to pact-repl/Pact/Core/Repl/UserDocs.hs diff --git a/pact/Pact/Core/Repl/Utils.hs b/pact-repl/Pact/Core/Repl/Utils.hs similarity index 88% rename from pact/Pact/Core/Repl/Utils.hs rename to pact-repl/Pact/Core/Repl/Utils.hs index 55d644281..c1d544925 100644 --- a/pact/Pact/Core/Repl/Utils.hs +++ b/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 () diff --git a/pact-tng.cabal b/pact-tng.cabal index 64105a2cd..7eb3859e8 100644 --- a/pact-tng.cabal +++ b/pact-tng.cabal @@ -246,7 +246,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 +266,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 @@ -287,12 +281,13 @@ library 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 + -- 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 -- Serialization Pact.Core.Serialise @@ -311,6 +306,30 @@ library extra-libraries: mpfr +library pact-repl + import: pact-common + hs-source-dirs: pact-repl + + 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 +341,7 @@ library pact-lsp build-depends: , pact-tng + , pact-tng:pact-repl , lsp , lsp-types , filepath @@ -369,10 +389,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 @@ -523,6 +544,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 diff --git a/pact/Pact/Core/Compile.hs b/pact/Pact/Core/Compile.hs index 49eb6f6f3..400b31acc 100644 --- a/pact/Pact/Core/Compile.hs +++ b/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 diff --git a/pact/Pact/Core/Debug.hs b/pact/Pact/Core/Debug.hs index 8fc2f5e7e..9527c7e5a 100644 --- a/pact/Pact/Core/Debug.hs +++ b/pact/Pact/Core/Debug.hs @@ -1,22 +1,23 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FunctionalDependencies #-} module Pact.Core.Debug ( DebugFlag(..) , DebugPrint(..) - , debugPrint + , DebugPrintable(..) ) where -import Control.Monad.Reader import Pact.Core.Type import Pact.Core.Names import Pact.Core.Syntax.LexUtils(PosToken) import Pact.Core.Environment import qualified Pact.Core.Syntax.ParseTree as Syntax import qualified Pact.Core.IR.Term as Term -import Pact.Core.Repl.Utils -import Pact.Core.Pretty +import Pact.Core.Builtin (CoreBuiltin) data DebugPrint b i term where DPLexer :: DebugPrint b i [PosToken] @@ -29,23 +30,8 @@ data DebugFlag | DFDesugar deriving (Show, Eq, Ord, Enum, Bounded) -debugPrint :: (Pretty b) => DebugPrint b i term -> term -> EvalM e b i () -debugPrint dp term = - ask >>= \case - ExecEnv _ -> pure () - 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 () +class DebugPrintable (e :: RuntimeMode) b | e -> b where + debugPrint :: DebugPrint b i term -> term -> EvalM e b i () +instance DebugPrintable 'ExecRuntime CoreBuiltin where + debugPrint _ _ = pure () diff --git a/pact/Pact/Core/Evaluate.hs b/pact/Pact/Core/Evaluate.hs index c0345b252..a4f4cb7a0 100644 --- a/pact/Pact/Core/Evaluate.hs +++ b/pact/Pact/Core/Evaluate.hs @@ -23,7 +23,7 @@ module Pact.Core.Evaluate , Eval , EvalBuiltinEnv , allModuleExports - , evalDirectInterpreter + -- , evalDirectInterpreter , evalInterpreter , EvalInput , EnableGasLogs(..) @@ -64,8 +64,8 @@ import Pact.Core.Info import Pact.Core.Signer import Pact.Core.IR.Eval.CEK.CoreBuiltin import qualified Pact.Core.IR.Eval.CEK.Evaluator as CEK -import qualified Pact.Core.IR.Eval.Direct.Evaluator as Direct -import qualified Pact.Core.IR.Eval.Direct.CoreBuiltin as Direct +-- import qualified Pact.Core.IR.Eval.Direct.Evaluator as Direct +-- import qualified Pact.Core.IR.Eval.Direct.CoreBuiltin as Direct import qualified Pact.Core.Syntax.Lexer as Lisp import qualified Pact.Core.Syntax.Parser as Lisp import qualified Pact.Core.Syntax.ParseTree as Lisp @@ -118,16 +118,16 @@ evalInterpreter = cekEnv :: CEK.BuiltinEnv ExecRuntime CoreBuiltin Info cekEnv = coreBuiltinEnv @ExecRuntime -evalDirectInterpreter :: Interpreter ExecRuntime CoreBuiltin Info -evalDirectInterpreter = - Interpreter runGuard runTerm resume evalWithCap - where - runTerm purity term = Direct.eval purity env term - runGuard info g = Direct.interpretGuard info env g - resume info defPact = Direct.evalResumePact info env defPact - evalWithCap info purity ct term = - Direct.evalWithinCap info purity env ct term - env = Direct.coreBuiltinEnv +-- evalDirectInterpreter :: Interpreter ExecRuntime CoreBuiltin Info +-- evalDirectInterpreter = +-- Interpreter runGuard runTerm resume evalWithCap +-- where +-- runTerm purity term = Direct.eval purity env term +-- runGuard info g = Direct.interpretGuard info env g +-- resume info defPact = Direct.evalResumePact info env defPact +-- evalWithCap info purity ct term = +-- Direct.evalWithinCap info purity env ct term +-- env = Direct.coreBuiltinEnv -- | Transaction-payload related environment data. data MsgData = MsgData