From 17c51339bec2883106731f0aa721cb4a2bd109fa Mon Sep 17 00:00:00 2001 From: Dominik Schrempf Date: Fri, 12 Sep 2025 17:06:35 +0200 Subject: [PATCH 1/6] Remove comment referring to GHC 9.2 and fix code --- .../src/Development/IDE/GHC/Compat/Logger.hs | 2 +- ghcide/src/Development/IDE/Spans/AtPoint.hs | 18 ++++-------------- 2 files changed, 5 insertions(+), 15 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index c3cc5247d0..9e90a18882 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} --- | Compat module for GHC 9.2 Logger infrastructure. +-- | Compat module for logger infrastructure. module Development.IDE.GHC.Compat.Logger ( putLogHook, Logger.pushLogHook, diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index ded1781f7f..a5f2d236a0 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -25,7 +25,8 @@ module Development.IDE.Spans.AtPoint ( ) where -import GHC.Data.FastString (lengthFS) +import GHC.Data.FastString (LexicalFastString (..), + lengthFS) import qualified GHC.Utils.Outputable as O import Development.IDE.GHC.Error @@ -50,7 +51,6 @@ import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe -import Data.Coerce (coerce) import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M import Data.Maybe @@ -580,18 +580,8 @@ defRowToSymbolInfo _ = Nothing pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a] pointCommand hf pos k = - M.elems $ flip M.mapMaybeWithKey (getAsts hf) $ \fs ast -> - -- Since GHC 9.2: - -- getAsts :: Map HiePath (HieAst a) - -- type HiePath = LexicalFastString - -- - -- but before: - -- getAsts :: Map HiePath (HieAst a) - -- type HiePath = FastString - -- - -- 'coerce' here to avoid an additional function for maintaining - -- backwards compatibility. - case selectSmallestContaining (sp $ coerce fs) ast of + M.elems $ flip M.mapMaybeWithKey (getAsts hf) $ \(LexicalFastString fs) ast -> + case selectSmallestContaining (sp fs) ast of Nothing -> Nothing Just ast' -> Just $ k ast' where From 53632816d8ca6d2492bb61e3b7d70026a58be22a Mon Sep 17 00:00:00 2001 From: Dominik Schrempf Date: Fri, 12 Sep 2025 17:14:03 +0200 Subject: [PATCH 2/6] Update some tests and avoid mentioning GHC 9.2 --- plugins/hls-gadt-plugin/test/Main.hs | 9 ++++----- .../test/testdata/SingleDeriving.expected.hs | 2 +- .../test/testdata/SingleDerivingGHC92.expected.hs | 5 ----- .../hls-gadt-plugin/test/testdata/SingleDerivingGHC92.hs | 4 ---- 4 files changed, 5 insertions(+), 15 deletions(-) delete mode 100644 plugins/hls-gadt-plugin/test/testdata/SingleDerivingGHC92.expected.hs delete mode 100644 plugins/hls-gadt-plugin/test/testdata/SingleDerivingGHC92.hs diff --git a/plugins/hls-gadt-plugin/test/Main.hs b/plugins/hls-gadt-plugin/test/Main.hs index e71c19aa28..f3d275ed66 100644 --- a/plugins/hls-gadt-plugin/test/Main.hs +++ b/plugins/hls-gadt-plugin/test/Main.hs @@ -34,12 +34,12 @@ tests = testGroup "GADT" , runTest "ConstructorContext" "ConstructorContext" 2 0 2 38 , runTest "Context" "Context" 2 0 4 41 , runTest "Pragma" "Pragma" 2 0 3 29 - , runTest "SingleDerivingGHC92" "SingleDerivingGHC92" 2 0 3 14 - , gadtPragmaTest "ghc-9.2 don't need to insert GADTs pragma" False + , runTest "SingleDeriving" "SingleDeriving" 2 0 3 14 + , gadtPragmaTest "no need to insert GADTs pragma" ] -gadtPragmaTest :: TestName -> Bool -> TestTree -gadtPragmaTest title hasGADT = testCase title +gadtPragmaTest :: TestName -> TestTree +gadtPragmaTest title = testCase title $ withCanonicalTempDir $ \dir -> runSessionWithServer def gadtPlugin dir $ do doc <- createDoc "A.hs" "haskell" (T.unlines ["module A where", "data Foo = Bar"]) @@ -47,7 +47,6 @@ gadtPragmaTest title hasGADT = testCase title (act:_) <- findGADTAction <$> getCodeActions doc (Range (Position 1 0) (Position 1 1)) executeCodeAction act let expected = T.unlines $ - ["{-# LANGUAGE GADTs #-}" | hasGADT] ++ ["module A where", "data Foo where", " Bar :: Foo"] contents <- skipManyTill anyMessage (getDocumentEdit doc) liftIO $ contents @?= expected diff --git a/plugins/hls-gadt-plugin/test/testdata/SingleDeriving.expected.hs b/plugins/hls-gadt-plugin/test/testdata/SingleDeriving.expected.hs index 5a8d088c5a..f3d292fc8f 100644 --- a/plugins/hls-gadt-plugin/test/testdata/SingleDeriving.expected.hs +++ b/plugins/hls-gadt-plugin/test/testdata/SingleDeriving.expected.hs @@ -2,4 +2,4 @@ module SingleDeriving where data Foo a b where Bar :: b -> a -> Foo a b - deriving Eq + deriving (Eq) diff --git a/plugins/hls-gadt-plugin/test/testdata/SingleDerivingGHC92.expected.hs b/plugins/hls-gadt-plugin/test/testdata/SingleDerivingGHC92.expected.hs deleted file mode 100644 index 46ea2c7b4d..0000000000 --- a/plugins/hls-gadt-plugin/test/testdata/SingleDerivingGHC92.expected.hs +++ /dev/null @@ -1,5 +0,0 @@ -module SingleDerivingGHC92 where - -data Foo a b where - Bar :: b -> a -> Foo a b - deriving (Eq) diff --git a/plugins/hls-gadt-plugin/test/testdata/SingleDerivingGHC92.hs b/plugins/hls-gadt-plugin/test/testdata/SingleDerivingGHC92.hs deleted file mode 100644 index d9ff28ae84..0000000000 --- a/plugins/hls-gadt-plugin/test/testdata/SingleDerivingGHC92.hs +++ /dev/null @@ -1,4 +0,0 @@ -module SingleDerivingGHC92 where - -data Foo a b = Bar b a - deriving (Eq) From a74ee7273d2a9853b91bad47a1f5708c5ec19209 Mon Sep 17 00:00:00 2001 From: Dominik Schrempf Date: Fri, 12 Sep 2025 21:39:04 +0200 Subject: [PATCH 3/6] Update Nix Flake (Darwin issues seem to be solved) --- flake.lock | 8 ++++---- flake.nix | 4 +--- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/flake.lock b/flake.lock index 352483a773..c5c44e4534 100644 --- a/flake.lock +++ b/flake.lock @@ -36,17 +36,17 @@ }, "nixpkgs": { "locked": { - "lastModified": 1748437873, - "narHash": "sha256-E2640ouB7VxooUQdCiDRo/rVXnr1ykgF9A7HrwWZVSo=", + "lastModified": 1757746433, + "narHash": "sha256-fEvTiU4s9lWgW7mYEU/1QUPirgkn+odUBTaindgiziY=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "c742ae7908a82c9bf23ce27bfca92a00e9bcd541", + "rev": "6d7ec06d6868ac6d94c371458fc2391ded9ff13d", "type": "github" }, "original": { "owner": "NixOS", + "ref": "nixpkgs-unstable", "repo": "nixpkgs", - "rev": "c742ae7908a82c9bf23ce27bfca92a00e9bcd541", "type": "github" } }, diff --git a/flake.nix b/flake.nix index 1002eb87b5..e3e76ac942 100644 --- a/flake.nix +++ b/flake.nix @@ -2,9 +2,7 @@ description = "haskell-language-server development flake"; inputs = { - # Don't use nixpkgs-unstable as aarch64-darwin is currently broken there. - # Check again, when https://github.com/NixOS/nixpkgs/pull/414242 is resolved. - nixpkgs.url = "github:NixOS/nixpkgs/c742ae7908a82c9bf23ce27bfca92a00e9bcd541"; + nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable"; flake-utils.url = "github:numtide/flake-utils"; # For default.nix flake-compat = { From bde6f67969da26d9def1542a9b2cfb0f5b9cf345 Mon Sep 17 00:00:00 2001 From: Dominik Schrempf Date: Fri, 12 Sep 2025 21:39:44 +0200 Subject: [PATCH 4/6] Clarify documentation of expected test failure --- plugins/hls-eval-plugin/test/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 03416c6902..80d73300fb 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -143,7 +143,7 @@ tests = , goldenWithEval "Test on last line insert results correctly" "TLastLine" "hs" , testGroup "with preprocessors" [ knownBrokenInEnv [HostOS Windows] - "CPP eval on Windows and/or GHC <= 8.6 fails for some reasons" $ + "CPP eval on Windows fails for some reasons" $ goldenWithEval "CPP support" "TCPP" "hs" , goldenWithEval "Literate Haskell Bird Style" "TLHS" "lhs" ] From 84c9888a569921e5e7b62a72a173c4feb3daec14 Mon Sep 17 00:00:00 2001 From: Dominik Schrempf Date: Sun, 14 Sep 2025 09:13:19 +0200 Subject: [PATCH 5/6] Docs: Fix some links in `eval` plugin in-source documentation --- .../hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index 1f19b5b476..27e2576482 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -7,11 +7,10 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-type-defaults #-} -{- | -A plugin inspired by the REPLoid feature of , 's Examples and Properties and . - -For a full example see the "Ide.Plugin.Eval.Tutorial" module. --} +-- | -- A plugin inspired by the REPLoid feature of +-- [Dante](https://github.com/jyp/dante), +-- [Haddock examples and properties](https://haskell-haddock.readthedocs.io/latest/markup.html#examples), +-- and [Doctest](https://hackage.haskell.org/package/doctest). module Ide.Plugin.Eval.Handlers ( codeAction, codeLens, @@ -397,7 +396,7 @@ The result of evaluating a test line can be: A value is returned for a correct expression. Either a pure value: ->>> 'h' :"askell" +>>> 'h' : "askell" "haskell" Or an 'IO a' (output on stdout/stderr is ignored): From 5ef2000462e619cb241b7dc00d49e4e5ff3afd0d Mon Sep 17 00:00:00 2001 From: Dominik Schrempf Date: Sun, 14 Sep 2025 16:30:31 +0200 Subject: [PATCH 6/6] eval: Capture `stdout` and `stderr` --- haskell-language-server.cabal | 1 + .../src/Ide/Plugin/Eval/Code.hs | 29 ++++++++++++++----- .../src/Ide/Plugin/Eval/Handlers.hs | 26 +++++++++++------ 3 files changed, 39 insertions(+), 17 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c30eebb8af..da8db21c12 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -494,6 +494,7 @@ library hls-eval-plugin , megaparsec >=9.0 , mtl , parser-combinators >=1.2 + , silently , text , text-rope , transformers diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs index e8b7428b10..ab8310dd69 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wwarn #-} @@ -15,6 +14,7 @@ import qualified Data.Text as T import Development.IDE.GHC.Compat import GHC (ExecOptions, ExecResult (..), execStmt) +import GHC.Driver.Monad (reflectGhc, reifyGhc) import Ide.Plugin.Eval.Types (Language (Plain), Loc, Located (..), Section (sectionLanguage), @@ -22,7 +22,9 @@ import Ide.Plugin.Eval.Types (Language (Plain), Loc, import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Types (Position (Position), Range (Range)) +import System.IO (stderr, stdout) import System.IO.Extra (newTempFile, readFile') +import System.IO.Silently (hCapture) -- | Return the ranges of the expression and result parts of the given test testRanges :: Test -> (Range, Range) @@ -79,20 +81,31 @@ asStmts (Example e _ _) = NE.toList e asStmts (Property t _ _) = ["prop11 = " ++ t, "(propEvaluation prop11 :: IO String)"] - - -- | A wrapper of 'InteractiveEval.execStmt', capturing the execution result myExecStmt :: String -> ExecOptions -> Ghc (Either String (Maybe String)) myExecStmt stmt opts = do (temp, purge) <- liftIO newTempFile evalPrint <- head <$> runDecls ("evalPrint x = P.writeFile " <> show temp <> " (P.show x)") modifySession $ \hsc -> hsc {hsc_IC = setInteractivePrintName (hsc_IC hsc) evalPrint} - result <- execStmt stmt opts >>= \case - ExecComplete (Left err) _ -> pure $ Left $ show err - ExecComplete (Right _) _ -> liftIO $ Right . (\x -> if null x then Nothing else Just x) <$> readFile' temp - ExecBreak{} -> pure $ Right $ Just "breakpoints are not supported" + -- NB: We capture output to @stdout@ and @stderr@ induced as a possible side + -- effect by the statement being evaluated. This is fragile because the + -- output may be scrambled in a concurrent setting when HLS is writing to + -- one of these file handles from a different thread. + (output, execResult) <- reifyGhc $ \session -> + hCapture [stdout, stderr] (reflectGhc (execStmt stmt opts) session) + evalResult <- case execResult of + ExecComplete (Left err) _ -> + pure $ Left $ show err + ExecComplete (Right _) _ -> + liftIO $ Right . fromList . (output <>) <$> readFile' temp + ExecBreak{} -> + pure $ Right $ Just "breakpoints are not supported" liftIO purge - pure result + pure evalResult + where + fromList :: String -> Maybe String + fromList x | null x = Nothing + | otherwise = Just x {- |GHC declarations required to execute test properties diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs index 27e2576482..131f406533 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs @@ -7,7 +7,7 @@ {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-type-defaults #-} --- | -- A plugin inspired by the REPLoid feature of +-- | A plugin inspired by the REPLoid feature of -- [Dante](https://github.com/jyp/dante), -- [Haddock examples and properties](https://haskell-haddock.readthedocs.io/latest/markup.html#examples), -- and [Doctest](https://hackage.haskell.org/package/doctest). @@ -399,9 +399,12 @@ Either a pure value: >>> 'h' : "askell" "haskell" -Or an 'IO a' (output on stdout/stderr is ignored): ->>> print "OK" >> return "ABC" -"ABC" +Or an 'IO a' (output on stdout/stderr is captured): +>>> putStrLn "Hello," >> pure "World!" +Hello, +"World!" + +Note the quotes around @World!@, which are a result of using 'show'. Nothing is returned for a correct directive: @@ -425,11 +428,15 @@ A, possibly multi line, error is returned for a wrong declaration, directive or Some flags have not been recognized: -XNonExistent >>> cls C -Variable not in scope: cls :: t0 -> t -Data constructor not in scope: C +Illegal term-level use of the class `C' + defined at :1:2 +In the first argument of `cls', namely `C' +In the expression: cls C +In an equation for `it_a1kSJ': it_a1kSJ = cls C +Variable not in scope: cls :: t0_a1kU9[tau:1] -> t1_a1kUb[tau:1] >>> "A -lexical error in string/character literal at end of input +lexical error at end of input Exceptions are shown as if printed, but it can be configured to include prefix like in GHCi or doctest. This allows it to be used as a hack to simulate print until we @@ -445,7 +452,8 @@ bad times Or for a value that does not have a Show instance and can therefore not be displayed: >>> data V = V >>> V -No instance for (Show V) arising from a use of ‘evalPrint’ +No instance for `Show V' arising from a use of `evalPrint' +In a stmt of an interactive GHCi command: evalPrint it_a1l4V -} evals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text] evals recorder mark_exception fp df stmts = do @@ -454,7 +462,7 @@ evals recorder mark_exception fp df stmts = do Left err -> errorLines err Right rs -> concat . catMaybes $ rs where - dbg = logWith recorder Debug + dbg = logWith recorder Debug eval :: Statement -> Ghc (Maybe [Text]) eval (Located l stmt) | -- GHCi flags