Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 5ef2000

Browse files
eval: Capture stdout and stderr 
1 parent 84c9888 commit 5ef2000

File tree

3 files changed

+39
-17
lines changed

3 files changed

+39
-17
lines changed

‎haskell-language-server.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -494,6 +494,7 @@ library hls-eval-plugin
494494
, megaparsec >=9.0
495495
, mtl
496496
, parser-combinators >=1.2
497+
, silently
497498
, text
498499
, text-rope
499500
, transformers

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs‎

Lines changed: 21 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE LambdaCase #-}
21
{-# LANGUAGE OverloadedStrings #-}
32
{-# LANGUAGE ViewPatterns #-}
43
{-# OPTIONS_GHC -Wwarn #-}
@@ -15,14 +14,17 @@ import qualified Data.Text as T
1514
import Development.IDE.GHC.Compat
1615
import GHC (ExecOptions, ExecResult (..),
1716
execStmt)
17+
import GHC.Driver.Monad (reflectGhc, reifyGhc)
1818
import Ide.Plugin.Eval.Types (Language (Plain), Loc,
1919
Located (..),
2020
Section (sectionLanguage),
2121
Test (..), Txt, locate, locate0)
2222
import qualified Language.LSP.Protocol.Lens as L
2323
import Language.LSP.Protocol.Types (Position (Position),
2424
Range (Range))
25+
import System.IO (stderr, stdout)
2526
import System.IO.Extra (newTempFile, readFile')
27+
import System.IO.Silently (hCapture)
2628

2729
-- | Return the ranges of the expression and result parts of the given test
2830
testRanges :: Test -> (Range, Range)
@@ -79,20 +81,31 @@ asStmts (Example e _ _) = NE.toList e
7981
asStmts (Property t _ _) =
8082
["prop11 = " ++ t, "(propEvaluation prop11 :: IO String)"]
8183

82-
83-
8484
-- | A wrapper of 'InteractiveEval.execStmt', capturing the execution result
8585
myExecStmt :: String -> ExecOptions -> Ghc (Either String (Maybe String))
8686
myExecStmt stmt opts = do
8787
(temp, purge) <- liftIO newTempFile
8888
evalPrint <- head <$> runDecls ("evalPrint x = P.writeFile " <> show temp <> " (P.show x)")
8989
modifySession $ \hsc -> hsc {hsc_IC = setInteractivePrintName (hsc_IC hsc) evalPrint}
90-
result <- execStmt stmt opts >>= \case
91-
ExecComplete (Left err) _ -> pure $ Left $ show err
92-
ExecComplete (Right _) _ -> liftIO $ Right . (\x -> if null x then Nothing else Just x) <$> readFile' temp
93-
ExecBreak{} -> pure $ Right $ Just "breakpoints are not supported"
90+
-- NB: We capture output to @stdout@ and @stderr@ induced as a possible side
91+
-- effect by the statement being evaluated. This is fragile because the
92+
-- output may be scrambled in a concurrent setting when HLS is writing to
93+
-- one of these file handles from a different thread.
94+
(output, execResult) <- reifyGhc $ \session ->
95+
hCapture [stdout, stderr] (reflectGhc (execStmt stmt opts) session)
96+
evalResult <- case execResult of
97+
ExecComplete (Left err) _ ->
98+
pure $ Left $ show err
99+
ExecComplete (Right _) _ ->
100+
liftIO $ Right . fromList . (output <>) <$> readFile' temp
101+
ExecBreak{} ->
102+
pure $ Right $ Just "breakpoints are not supported"
94103
liftIO purge
95-
pure result
104+
pure evalResult
105+
where
106+
fromList :: String -> Maybe String
107+
fromList x | null x = Nothing
108+
| otherwise = Just x
96109

97110
{- |GHC declarations required to execute test properties
98111

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs‎

Lines changed: 17 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@
77
{-# LANGUAGE ViewPatterns #-}
88
{-# OPTIONS_GHC -Wno-type-defaults #-}
99

10-
-- | -- A plugin inspired by the REPLoid feature of
10+
-- | A plugin inspired by the REPLoid feature of
1111
-- [Dante](https://github.com/jyp/dante),
1212
-- [Haddock examples and properties](https://haskell-haddock.readthedocs.io/latest/markup.html#examples),
1313
-- and [Doctest](https://hackage.haskell.org/package/doctest).
@@ -399,9 +399,12 @@ Either a pure value:
399399
>>> 'h' : "askell"
400400
"haskell"
401401
402-
Or an 'IO a' (output on stdout/stderr is ignored):
403-
>>> print "OK" >> return "ABC"
404-
"ABC"
402+
Or an 'IO a' (output on stdout/stderr is captured):
403+
>>> putStrLn "Hello," >> pure "World!"
404+
Hello,
405+
"World!"
406+
407+
Note the quotes around @World!@, which are a result of using 'show'.
405408
406409
Nothing is returned for a correct directive:
407410
@@ -425,11 +428,15 @@ A, possibly multi line, error is returned for a wrong declaration, directive or
425428
Some flags have not been recognized: -XNonExistent
426429
427430
>>> cls C
428-
Variable not in scope: cls :: t0 -> t
429-
Data constructor not in scope: C
431+
Illegal term-level use of the class `C'
432+
defined at <interactive>:1:2
433+
In the first argument of `cls', namely `C'
434+
In the expression: cls C
435+
In an equation for `it_a1kSJ': it_a1kSJ = cls C
436+
Variable not in scope: cls :: t0_a1kU9[tau:1] -> t1_a1kUb[tau:1]
430437
431438
>>> "A
432-
lexical error in string/character literal at end of input
439+
lexical error at end of input
433440
434441
Exceptions are shown as if printed, but it can be configured to include prefix like
435442
in GHCi or doctest. This allows it to be used as a hack to simulate print until we
@@ -445,7 +452,8 @@ bad times
445452
Or for a value that does not have a Show instance and can therefore not be displayed:
446453
>>> data V = V
447454
>>> V
448-
No instance for (Show V) arising from a use of ‘evalPrint’
455+
No instance for `Show V' arising from a use of `evalPrint'
456+
In a stmt of an interactive GHCi command: evalPrint it_a1l4V
449457
-}
450458
evals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]
451459
evals recorder mark_exception fp df stmts = do
@@ -454,7 +462,7 @@ evals recorder mark_exception fp df stmts = do
454462
Left err -> errorLines err
455463
Right rs -> concat . catMaybes $ rs
456464
where
457-
dbg = logWith recorder Debug
465+
dbg = logWith recorder Debug
458466
eval :: Statement -> Ghc (Maybe [Text])
459467
eval (Located l stmt)
460468
| -- GHCi flags

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /