Fix repl load not displaying errors, return loc info to trace

pact-lsp/Pact/Core/LanguageServer.hs

@@ -257,7 +257,7 @@ setupAndProcessFile nuri content = do
           , _replLoad = doLoad
           , _replLogType = ReplStdOut
           , _replLoadedFiles = mempty
-          , _replOutputLine = const (pure ())
+          , _replOutputLine = const $ const $ pure ()
           , _replTestResults = []
           }
   stateRef <- newIORef rstate

pact-repl/Main.hs

@@ -95,8 +95,11 @@ unsignedReqFlag = OUnsignedReq
 localFlag :: O.Parser Bool
 localFlag = O.flag False True (O.short 'l' <> O.long "local" <> O.help "Format for /local endpoint")
 
-die :: String -> IO b
-die msg = hPutStrLn stderr msg >> hFlush stderr >> exitFailure
+exitFailureWithMessage :: String -> IO b
+exitFailureWithMessage msg = hPutStrLn stderr msg >> hFlush stderr >> exitFailure
+
+exitSuccessWithMessage :: String -> IO b
+exitSuccessWithMessage msg = hPutStrLn stdout msg >> hFlush stdout >> exitSuccess
 
 main :: IO ()
 main = O.execParser argParser >>= \case
@@ -122,10 +125,11 @@ main = O.execParser argParser >>= \case
       Left perr -> putStrLn $ Y.prettyPrintParseException perr
       Right config -> runServer config noSPVSupport
   where
-    exitEither _ Left {} = die "Load failed"
-    exitEither m (Right t) = m t >> exitSuccess
-    exitLoad = exitEither (\_ -> hPutStrLn stderr "Load successful" >> hFlush stderr)
-    runScript f dolog = execScript dolog f >>= exitLoad . fst
+    runScript f dolog = execScript dolog f >>= \case
+      (Left pe, state) -> do
+        let renderedError = renderLocatedPactErrorFromState state pe
+        exitFailureWithMessage ((T.unpack renderedError) <> "\nLoad failed")
+      (Right _, _) -> exitSuccessWithMessage "Load successful"
     printVersion = putStrLn ("pact version " <> showVersion PI.version)
     printBuiltins = traverse_ (\bi -> T.putStrLn $ "\"" <> bi <> "\"") replCoreBuiltinNames
 

pact-repl/Pact/Core/IR/Eval/Direct/ReplBuiltin.hs

@@ -356,7 +356,7 @@ envSetDebug info b _env = \case
         let flagsToSet = S.difference (S.union currFlags flags) (S.intersection currFlags flags)
         replFlags .== flagsToSet
         pure flagsToSet
-    replPrintLn' $ renderCompactText' $ "set debug flags to " <> pretty (S.toList flagsSet)
+    replPrintLn' info $ renderCompactText' $ "set debug flags to " <> pretty (S.toList flagsSet)
     return VUnit
   args -> argsError info b args
 
@@ -580,7 +580,7 @@ load info b _env = \case
   args -> argsError info b args
   where
     load' sourceFile reset = do
-      replPrintLn $ PString $ "Loading " <> sourceFile <> "..."
+      replPrintLn info $ PString $ "Loading " <> sourceFile <> "..."
       fload <- useReplState replLoad
       fload (T.unpack sourceFile) reset
       return VUnit

pact-repl/Pact/Core/Repl.hs

@@ -16,8 +16,14 @@
 --
 
 
-module Pact.Core.Repl(runRepl, execScript, mkReplState) where
+module Pact.Core.Repl
+  ( runRepl
+  , execScript
+  , mkReplState
+  , renderLocatedPactErrorFromState)
+  where
 
+import Control.Lens
 import Control.Monad.IO.Class
 import Control.Exception.Safe
 import Control.Monad.Except
@@ -37,8 +43,6 @@ import Pact.Core.Repl.Utils
 import Pact.Core.Serialise
 import Pact.Core.Info
 import Pact.Core.Errors
-import Control.Lens
-import qualified Data.Map.Strict as M
 
 execScript :: Bool -> FilePath -> IO (Either (PactError FileLocSpanInfo) [ReplCompileValue], ReplState ReplCoreBuiltin)
 execScript dolog f = do
@@ -49,17 +53,27 @@ execScript dolog f = do
   state <- readIORef ref
   pure (v, state)
   where
-  logger :: Text -> EvalM e b i ()
-  logger
-    | dolog = liftIO . T.putStrLn
-    | otherwise = const (pure ())
+  logger :: FileLocSpanInfo -> Text -> EvalM e b i ()
+  logger (FileLocSpanInfo file info) v
+    | dolog = liftIO $ T.putStrLn $ T.pack file <> ":" <> renderCompactText info <> ": " <> v
+    | otherwise = pure ()
+
+-- | Render a nice error
+renderLocatedPactErrorFromState :: ReplState b -> PactError FileLocSpanInfo -> Text
+renderLocatedPactErrorFromState rstate err = rendered
+  where
+  replInfo = view peInfo err
+  originFile = case rstate ^. replLoadedFiles . at (_flsiFile replInfo) of
+            Just sc -> sc
+            Nothing -> rstate ^. replCurrSource
+  rendered = replError originFile err
 
 
 runRepl :: IO ()
 runRepl = do
   pdb <- mockPactDb serialisePact_repl_fileLocSpanInfo
   ee <- defaultEvalEnv pdb replBuiltinMap
-  let display' rcv = runInputT replSettings (displayOutput rcv)
+  let display' info rcv = runInputT replSettings (displayOutput info rcv)
   ref <- newIORef (mkReplState' ee display')
   evalReplM ref (runInputT replSettings loop) >>= \case
     Left err -> do
@@ -68,8 +82,8 @@ runRepl = do
     _ -> pure ()
   where
   replSettings = Settings (replCompletion replCoreBuiltinNames) (Just ".pc-history") True
-  displayOutput :: (Pretty a, MonadIO m) => a -> InputT m ()
-  displayOutput = outputStrLn . show . pretty
+  displayOutput :: (Pretty a, MonadIO m) => FileLocSpanInfo -> a -> InputT m ()
+  displayOutput _ = outputStrLn . show . pretty
   catch' ma = catchAny ma (\e -> outputStrLn (show e) *> loop)
   defaultSrc = SourceCode "(interactive)" mempty
   loop = do
@@ -83,10 +97,8 @@ runRepl = do
         case eout of
           Right _ -> pure ()
           Left err -> do
-            let replInfo = view peInfo err
-            rs <- lift (usesReplState replLoadedFiles (M.lookup (_flsiFile replInfo))) >>= \case
-              Just sc -> pure sc
-              Nothing -> lift (useReplState replCurrSource)
+            rstate <- lift getReplState
+            let renderedError = renderLocatedPactErrorFromState rstate err
             lift (replCurrSource .== defaultSrc)
-            outputStrLn (T.unpack (replError rs err))
+            outputStrLn (T.unpack renderedError)
         loop

pact-repl/Pact/Core/Repl/Compile.hs

@@ -82,7 +82,7 @@ data ReplCompileValue
 
 mkReplState
   :: EvalEnv b FileLocSpanInfo
-  -> (Text -> EvalM 'ReplRuntime b FileLocSpanInfo ())
+  -> (FileLocSpanInfo -> Text -> EvalM 'ReplRuntime b FileLocSpanInfo ())
   -> (FilePath -> Bool -> EvalM 'ReplRuntime b FileLocSpanInfo ())
   -> ReplState b
 mkReplState ee printfn loadFn =
@@ -105,7 +105,7 @@ mkReplState ee printfn loadFn =
 
 mkReplState'
   :: EvalEnv ReplCoreBuiltin FileLocSpanInfo
-  -> (Text -> EvalM 'ReplRuntime ReplCoreBuiltin FileLocSpanInfo ())
+  -> (FileLocSpanInfo -> Text -> EvalM 'ReplRuntime ReplCoreBuiltin FileLocSpanInfo ())
   -> ReplState ReplCoreBuiltin
 mkReplState' ee printfn =
   ReplState
@@ -257,15 +257,15 @@ interpretReplProgram interpreter sc@(SourceCode sourceFp source) = do
   parseSource lexerOutput
     | sourceIsPactFile = (fmap.fmap) (Lisp.RTLTopLevel) $ Lisp.parseProgram lexerOutput
     | otherwise = Lisp.parseReplProgram lexerOutput
-  displayValue p = p <$ replPrintLn p
+  displayValue info p = p <$ replPrintLn info p
   sliceCode = \case
     Lisp.TLModule{} -> sliceFromSource
     Lisp.TLInterface{} -> sliceFromSource
     Lisp.TLTerm{} -> \_ _ -> mempty
     Lisp.TLUse{} -> \_ _ -> mempty
   pipe' tl = case tl of
     Lisp.RTLTopLevel toplevel -> case topLevelHasDocs toplevel of
-      Just doc -> displayValue $ RBuiltinDoc doc
+      Just doc -> displayValue tlInfo $ RBuiltinDoc doc
       Nothing -> do
         functionDocs toplevel
         (ds, deps) <- compileDesugarOnly interpreter toplevel
@@ -277,15 +277,17 @@ interpretReplProgram interpreter sc@(SourceCode sourceFp source) = do
               Just d -> do
                 let qn = QualifiedName n mn
                 docs <- usesReplState replUserDocs (M.lookup qn)
-                displayValue (RUserDoc d docs)
+                displayValue tlInfo (RUserDoc d docs)
               Nothing ->
                 throwExecutionError varI $ EvalError "repl invariant violated: resolved to a top level free variable without a binder"
           _ -> do
-            let sliced = sliceCode toplevel source (view (Lisp.topLevelInfo.spanInfo) toplevel)
+            let sliced = sliceCode toplevel source (view spanInfo tlInfo)
             v <- evalTopLevel interpreter (RawCode sliced) ds deps
             emitWarnings
-            replPrintLn v
+            replPrintLn tlInfo v
             pure (RCompileValue v)
+      where
+      tlInfo = view Lisp.topLevelInfo toplevel
     _ ->  do
       ds <- runDesugarReplTopLevel tl
       interpret ds
@@ -297,13 +299,13 @@ interpretReplProgram interpreter sc@(SourceCode sourceFp source) = do
           atomicModifyIORef' ref (\old -> (newDefaultWarningStack, getWarningStack old))
         -- Todo: print located line
         -- Note: warnings are pushed FIFO, so we reverse to get the right order
-        traverse_ (replPrintLn . _locElem) (reverse warnings)
+        traverse_ (\(Located loc e) -> replPrintLn loc e) (reverse warnings)
   interpret (DesugarOutput tl _deps) = do
     case tl of
       RTLDefun df -> do
         let fqn = FullyQualifiedName replModuleName (_argName $ _dfunSpec df) replModuleHash
         loaded . loAllLoaded %= M.insert fqn (Dfun df)
-        displayValue $ RLoadedDefun $ _argName $ _dfunSpec df
+        displayValue (_dfunInfo df)  $ RLoadedDefun $ _argName $ _dfunSpec df
       RTLDefConst dc -> case _dcTerm dc of
         TermConst term -> do
           pv <- eval interpreter PSysOnly term
@@ -312,8 +314,8 @@ interpretReplProgram interpreter sc@(SourceCode sourceFp source) = do
           let dc' = set dcTerm (EvaledConst pv) dc
           let fqn = FullyQualifiedName replModuleName (_argName $ _dcSpec dc) replModuleHash
           loaded . loAllLoaded %= M.insert fqn (DConst dc')
-          displayValue $ RLoadedDefConst $ _argName $ _dcSpec dc'
+          displayValue (_dcInfo dc) $ RLoadedDefConst $ _argName $ _dcSpec dc'
         EvaledConst _ -> do
           let fqn = FullyQualifiedName replModuleName (_argName $ _dcSpec dc) replModuleHash
           loaded . loAllLoaded %= M.insert fqn (DConst dc)
-          displayValue $ RLoadedDefConst $ _argName $ _dcSpec dc
+          displayValue (_dcInfo dc) $ RLoadedDefConst $ _argName $ _dcSpec dc

pact-repl/Pact/Core/Repl/Runtime/ReplBuiltin.hs

@@ -579,7 +579,7 @@ envSetDebug info b cont handler _env = \case
         let flagsToSet = S.difference (S.union currFlags flags) (S.intersection currFlags flags)
         replFlags .== flagsToSet
         pure flagsToSet
-    replPrintLn' $ renderCompactText' $ "set debug flags to " <> pretty (S.toList flagsSet)
+    replPrintLn' info $ renderCompactText' $ "set debug flags to " <> pretty (S.toList flagsSet)
     returnCEKValue cont handler $ VUnit
   args -> argsError info b args
 
@@ -611,7 +611,7 @@ load info b cont handler _env = \case
   args -> argsError info b args
   where
     load' sourceFile reset = do
-      replPrintLn $ PString $ "Loading " <> sourceFile <> "..."
+      replPrintLn info $ PString $ "Loading " <> sourceFile <> "..."
       fload <- useReplState replLoad
       fload (T.unpack sourceFile) reset
       returnCEKValue cont handler VUnit

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

@@ -34,6 +34,7 @@ module Pact.Core.Repl.Utils
  , renderReplFlag
  , replError
  , SourceCode(..)
+ , getReplState
  , useReplState
  , usesReplState
  , (.==)
@@ -244,16 +245,16 @@ gasLogEntrytoPactValue entry = PString $ renderCompactText' $ n <> ": " <> prett
   where
     n = pretty (_gleArgs entry) <+> pretty (_gleInfo entry)
 
-replPrintLn :: Pretty a => a -> EvalM 'ReplRuntime b FileLocSpanInfo ()
-replPrintLn p = replPrintLn' (renderCompactText p)
+replPrintLn :: Pretty a => FileLocSpanInfo -> a -> EvalM 'ReplRuntime b FileLocSpanInfo ()
+replPrintLn info p = replPrintLn' info (renderCompactText p)
 
-replPrintLn' :: Text -> EvalM 'ReplRuntime b FileLocSpanInfo ()
-replPrintLn' p = do
+replPrintLn' :: FileLocSpanInfo -> Text -> EvalM 'ReplRuntime b FileLocSpanInfo ()
+replPrintLn' info p = do
   r <- getReplState
   case _replLogType r of
-    ReplStdOut -> _replOutputLine r p
+    ReplStdOut -> _replOutputLine r info p
     ReplLogOut v ->
-      liftIO (modifyIORef' v (p:))
+      liftIO (modifyIORef' v ((p, info):))
 
 recordTestResult
   :: Text

pact-tests/Pact/Core/Test/GasGolden.hs

@@ -111,7 +111,7 @@ runGasTest file interpret = do
   let ee' = ee & eeGasEnv . geGasModel .~ replTableGasModel (Just (maxBound :: MilliGasLimit))
       gasRef = ee' ^. eeGasEnv . geGasRef
   let source = SourceCode file src
-  let rstate = mkReplState ee' (const (pure ())) (\f r -> void (loadFile interpret f r)) & replCurrSource .~ source
+  let rstate = mkReplState ee' (const (const (pure ()))) (\f r -> void (loadFile interpret f r)) & replCurrSource .~ source
   stateRef <- newIORef rstate
   evalReplM stateRef (interpretReplProgram interpret source) >>= \case
     Left _ -> pure Nothing

pact-tests/Pact/Core/Test/ReplTests.hs

@@ -80,7 +80,7 @@ runReplTest
 runReplTest (ReplSourceDir path) pdb file src interp = do
   ee <- defaultEvalEnv pdb replBuiltinMap
   let source = SourceCode (path </> file) src
-  let rstate = mkReplState ee (const (pure ())) (\f reset -> void (loadFile interp f reset)) & replCurrSource .~ source
+  let rstate = mkReplState ee (const (const (pure ()))) (\f reset -> void (loadFile interp f reset)) & replCurrSource .~ source
   stateRef <- newIORef rstate
   evalReplM stateRef (interpretReplProgram interp source) >>= \case
     Left e -> let

pact-tests/Pact/Core/Test/StaticErrorTests.hs

@@ -39,7 +39,7 @@ runStaticTest label src interp predicate = do
   pdb <- mockPactDb serialisePact_repl_fileLocSpanInfo
   ee <- defaultEvalEnv pdb replBuiltinMap
   let source = SourceCode label src
-      rstate = mkReplState ee (const (pure ())) (\f reset -> void (loadFile interp f reset))
+      rstate = mkReplState ee (const (const (pure ()))) (\f reset -> void (loadFile interp f reset))
                 & replCurrSource .~ source
                 & replNativesEnabled .~ True
   stateRef <- newIORef rstate

pact/Pact/Core/Environment/Types.hs

@@ -362,7 +362,7 @@ data ReplTestResult
 
 data ReplOutput where
   ReplStdOut :: ReplOutput
-  ReplLogOut :: IORef [Text] -> ReplOutput
+  ReplLogOut :: IORef [(Text, FileLocSpanInfo)] -> ReplOutput
 
 -- | Passed in repl environment
 data ReplState b
@@ -385,7 +385,7 @@ data ReplState b
   -- ^ The current repl tx, if one has been initiated
   , _replNativesEnabled :: Bool
   -- ^ Are repl natives enabled in module code
-  , _replOutputLine :: !(Text -> EvalM 'ReplRuntime b FileLocSpanInfo ())
+  , _replOutputLine :: !(FileLocSpanInfo -> Text -> EvalM 'ReplRuntime b FileLocSpanInfo ())
   -- ^ The output line function, as an entry in the repl env
   --   to allow for custom output handling, e.g haskeline
   , _replLoad :: !(FilePath -> Bool -> EvalM 'ReplRuntime b FileLocSpanInfo ())