diff --git a/hls-eval-plugin.cabal b/hls-eval-plugin.cabal --- a/hls-eval-plugin.cabal +++ b/hls-eval-plugin.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-eval-plugin -version: 1.2.2.0 +version: 1.3.0.0 synopsis: Eval plugin for Haskell Language Server description: Please see the README on GitHub at @@ -37,6 +37,10 @@ location: https://github.com/haskell/haskell-language-server library + if impl(ghc >= 9.3) + buildable: False + else + buildable: True exposed-modules: Ide.Plugin.Eval Ide.Plugin.Eval.Types @@ -66,16 +70,16 @@ , ghc , ghc-boot-th , ghc-paths - , ghcide ^>=1.7 + , ghcide ^>=1.8 , hashable , hls-graph - , hls-plugin-api ^>=1.4 + , hls-plugin-api ^>=1.5 , lens , lsp , lsp-types , megaparsec >=9.0 , mtl - , parser-combinators + , parser-combinators >=1.2 , pretty-simple , QuickCheck , safe-exceptions @@ -97,6 +101,10 @@ TypeOperators test-suite tests + if impl(ghc >= 9.3) + buildable: False + else + buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test @@ -111,7 +119,7 @@ , filepath , hls-eval-plugin , hls-plugin-api - , hls-test-utils ^>=1.3 + , hls-test-utils ^>=1.4 , lens , lsp-types , text diff --git a/src/Ide/Plugin/Eval/CodeLens.hs b/src/Ide/Plugin/Eval/CodeLens.hs --- a/src/Ide/Plugin/Eval/CodeLens.hs +++ b/src/Ide/Plugin/Eval/CodeLens.hs @@ -23,97 +23,127 @@ evalCommand, ) where -import Control.Applicative (Alternative ((<|>))) -import Control.Arrow (second, (>>>)) -import Control.Exception (try) -import qualified Control.Exception as E -import Control.Lens (_1, _3, ix, (%~), (<&>), (^.)) -import Control.Monad (guard, join, void, when) -import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Trans (lift) -import Control.Monad.Trans.Except (ExceptT (..)) -import Data.Aeson (toJSON) -import Data.Char (isSpace) +import Control.Applicative (Alternative ((<|>))) +import Control.Arrow (second, (>>>)) +import Control.Exception (try) +import qualified Control.Exception as E +import Control.Lens (_1, _3, ix, (%~), + (<&>), (^.)) +import Control.Monad (guard, join, + void, when) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad.Trans (lift) +import Control.Monad.Trans.Except (ExceptT (..)) +import Data.Aeson (toJSON) +import Data.Char (isSpace) import Data.Default -import qualified Data.HashMap.Strict as HashMap -import Data.List (dropWhileEnd, find, - intercalate, intersperse) -import Data.Maybe (catMaybes, fromMaybe) -import Data.String (IsString) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Time (getCurrentTime) -import Data.Typeable (Typeable) -import Development.IDE (GetModSummary (..), - GhcSessionIO (..), IdeState, - ModSummaryResult (..), - NeedsCompilation (NeedsCompilation), - evalGhcEnv, - hscEnvWithImportPaths, - printOutputable, runAction, - textToStringBuffer, - toNormalizedFilePath', - uriToFilePath', useNoFile_, - useWithStale_, use_, - VFSModified(..)) -import Development.IDE.Core.Rules (GhcSessionDepsConfig (..), - ghcSessionDepsDefinition) -import Development.IDE.GHC.Compat hiding (typeKind, unitState) -import qualified Development.IDE.GHC.Compat as Compat -import qualified Development.IDE.GHC.Compat as SrcLoc -import Development.IDE.GHC.Compat.Util (GhcException, - OverridingBool (..)) +import qualified Data.HashMap.Strict as HashMap +import Data.List (dropWhileEnd, + find, + intercalate, + intersperse) +import Data.Maybe (catMaybes, + fromMaybe) +import Data.String (IsString) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time (getCurrentTime) +import Data.Typeable (Typeable) +import Development.IDE (GetDependencyInformation (..), + GetLinkable (..), + GetModSummary (..), + GhcSessionIO (..), + IdeState, + ModSummaryResult (..), + NeedsCompilation (NeedsCompilation), + VFSModified (..), + evalGhcEnv, + hscEnvWithImportPaths, + linkableHomeMod, + printOutputable, + runAction, + textToStringBuffer, + toNormalizedFilePath', + uriToFilePath', + useNoFile_, + useWithStale_, + use_, uses_) +import Development.IDE.Core.Rules (GhcSessionDepsConfig (..), + ghcSessionDepsDefinition) +import Development.IDE.GHC.Compat hiding (typeKind, + unitState) +import qualified Development.IDE.GHC.Compat as Compat +import qualified Development.IDE.GHC.Compat as SrcLoc +import Development.IDE.GHC.Compat.Util (GhcException, + OverridingBool (..)) +import Development.IDE.Import.DependencyInformation (reachableModules) import Development.IDE.Types.Options -import GHC (ClsInst, - ExecOptions (execLineNumber, execSourceFile), - FamInst, GhcMonad, - LoadHowMuch (LoadAllTargets), - NamedThing (getName), - defaultFixity, execOptions, - exprType, getInfo, - getInteractiveDynFlags, - isImport, isStmt, load, - parseName, pprFamInst, - pprInstance, setTargets, - typeKind) +import GHC (ClsInst, + ExecOptions (execLineNumber, execSourceFile), + FamInst, + GhcMonad, + LoadHowMuch (LoadAllTargets), + NamedThing (getName), + defaultFixity, + execOptions, + exprType, + getInfo, + getInteractiveDynFlags, + isImport, isStmt, + load, parseName, + pprFamInst, + pprInstance, + setTargets, + typeKind) #if MIN_VERSION_ghc(9,2,0) -import GHC (Fixity) +import GHC (Fixity) #endif -import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) +import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) -import Development.IDE.Core.FileStore (setSomethingModified) -import Development.IDE.Types.Shake (toKey) -import Ide.Plugin.Config (Config) +import Development.IDE.Core.FileStore (setSomethingModified) +import Development.IDE.Types.Shake (toKey) +import Ide.Plugin.Config (Config) #if MIN_VERSION_ghc(9,2,0) -import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) +import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) #endif -import Ide.Plugin.Eval.Code (Statement, asStatements, - evalSetup, myExecStmt, - propSetup, resultRange, - testCheck, testRanges) -import Ide.Plugin.Eval.Config (getEvalConfig, EvalConfig(..)) -import Ide.Plugin.Eval.GHC (addImport, addPackages, - hasPackage, showDynFlags) -import Ide.Plugin.Eval.Parse.Comments (commentsToSections) -import Ide.Plugin.Eval.Parse.Option (parseSetFlags) -import Ide.Plugin.Eval.Rules (queueForEvaluation) +import Ide.Plugin.Eval.Code (Statement, + asStatements, + evalSetup, + myExecStmt, + propSetup, + resultRange, + testCheck, + testRanges) +import Ide.Plugin.Eval.Config (EvalConfig (..), + getEvalConfig) +import Ide.Plugin.Eval.GHC (addImport, + addPackages, + hasPackage, + showDynFlags) +import Ide.Plugin.Eval.Parse.Comments (commentsToSections) +import Ide.Plugin.Eval.Parse.Option (parseSetFlags) +import Ide.Plugin.Eval.Rules (queueForEvaluation) import Ide.Plugin.Eval.Types -import Ide.Plugin.Eval.Util (gStrictTry, isLiterate, - logWith, response', timed) -import Ide.PluginUtils (handleMaybe, handleMaybeM, - response) +import Ide.Plugin.Eval.Util (gStrictTry, + isLiterate, + logWith, + response', timed) +import Ide.PluginUtils (handleMaybe, + handleMaybeM, + pluginResponse) import Ide.Types import Language.LSP.Server -import Language.LSP.Types hiding - (SemanticTokenAbsolute (length, line), - SemanticTokenRelative (length)) -import Language.LSP.Types.Lens (end, line) -import Language.LSP.VFS (virtualFileText) +import Language.LSP.Types hiding + (SemanticTokenAbsolute (length, line), + SemanticTokenRelative (length)) +import Language.LSP.Types.Lens (end, line) +import Language.LSP.VFS (virtualFileText) #if MIN_VERSION_ghc(9,2,0) #elif MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Session (unitDatabases, unitState) -import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) +import GHC.Driver.Session (unitDatabases, + unitState) +import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) #else import DynFlags #endif @@ -127,7 +157,7 @@ let dbg = logWith st perf = timed dbg in perf "codeLens" $ - response $ do + pluginResponse $ do let TextDocumentIdentifier uri = _textDocument fp <- handleMaybe "uri" $ uriToFilePath' uri let nfp = toNormalizedFilePath' fp @@ -294,10 +324,19 @@ setContext [Compat.IIModule modName] Right <$> getSession evalCfg <- lift $ getEvalConfig plId + + -- Get linkables for all modules below us + -- This can be optimised to only get the linkables for the symbols depended on by + -- the statement we are parsing + lbs <- liftIO $ runAction "eval: GetLinkables" st $ do + linkables_needed <- reachableModules <$> use_ GetDependencyInformation nfp + uses_ GetLinkable (filter (/= nfp) linkables_needed) -- We don't need the linkable for the current module + let hscEnv'' = hscEnv' { hsc_HPT = addListToHpt (hsc_HPT hscEnv') [(moduleName $ mi_module $ hm_iface hm, hm) | lb <- lbs, let hm = linkableHomeMod lb] } + edits <- perf "edits" $ liftIO $ - evalGhcEnv hscEnv' $ + evalGhcEnv hscEnv'' $ runTests evalCfg (st, fp) @@ -358,8 +397,9 @@ dbg "TEST RESULTS" rs let checkedResult = testCheck eval_cfg_diff (section, test) rs + let resultLines = concatMap T.lines checkedResult - let edit = asEdit (sectionFormat section) test (map pad checkedResult) + let edit = asEdit (sectionFormat section) test (map pad resultLines) dbg "TEST EDIT" edit return edit diff --git a/src/Ide/Plugin/Eval/Config.hs b/src/Ide/Plugin/Eval/Config.hs --- a/src/Ide/Plugin/Eval/Config.hs +++ b/src/Ide/Plugin/Eval/Config.hs @@ -15,8 +15,8 @@ -- | The Eval plugin configuration. (see 'properties') data EvalConfig = EvalConfig - { eval_cfg_diff :: Bool - , eval_cfg_exception :: Bool + { eval_cfg_diff :: Bool + , eval_cfg_exception :: Bool } deriving (Eq, Ord, Show) diff --git a/src/Ide/Plugin/Eval/Parse/Comments.hs b/src/Ide/Plugin/Eval/Parse/Comments.hs --- a/src/Ide/Plugin/Eval/Parse/Comments.hs +++ b/src/Ide/Plugin/Eval/Parse/Comments.hs @@ -41,8 +41,8 @@ import Language.LSP.Types (UInt) import Language.LSP.Types.Lens (character, end, line, start) -import Text.Megaparsec import qualified Text.Megaparsec as P +import Text.Megaparsec import Text.Megaparsec.Char (alphaNumChar, char, eol, hspace, letterChar) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -12,7 +12,7 @@ view, (^..)) import Data.Aeson (Value (Object), fromJSON, object, toJSON, (.=)) -import Data.Aeson.Types (Result (Success), Pair) +import Data.Aeson.Types (Pair, Result (Success)) import Data.List (isInfixOf) import Data.List.Extra (nubOrdOn) import qualified Data.Map as Map @@ -68,6 +68,7 @@ , goldenWithEval "Refresh an evaluation" "T5" "hs" , goldenWithEval "Refresh an evaluation w/ lets" "T6" "hs" , goldenWithEval "Refresh a multiline evaluation" "T7" "hs" + , goldenWithEval "Evaluate a multi-line show result" "TMultiResult" "hs" -- Do not escape from comments! , testCase "Semantic and Lexical errors are reported" $ do evalInFile "T8.hs" "-- >>> noFunctionWithThisName" "-- Variable not in scope: noFunctionWithThisName" evalInFile "T8.hs" "-- >>> res = \"a\" + \"bc\"" $ diff --git a/test/testdata/TMultiResult.expected.hs b/test/testdata/TMultiResult.expected.hs new file mode 100644 --- /dev/null +++ b/test/testdata/TMultiResult.expected.hs @@ -0,0 +1,13 @@ +module TMultiResult where +-- test multiline show instance (see #2907) + +data Multiline = M {l1 :: String, l2 :: String} deriving Read + +instance Show Multiline where + show m = "M {\n l1=" <> show (l1 m) <> ",\n l2=" <> show (l2 m) <> "\n}" + +-- >>> M "first line" "second line" +-- M { +-- l1="first line", +-- l2="second line" +-- } diff --git a/test/testdata/TMultiResult.hs b/test/testdata/TMultiResult.hs new file mode 100644 --- /dev/null +++ b/test/testdata/TMultiResult.hs @@ -0,0 +1,9 @@ +module TMultiResult where +-- test multiline show instance (see #2907) + +data Multiline = M {l1 :: String, l2 :: String} deriving Read + +instance Show Multiline where + show m = "M {\n l1=" <> show (l1 m) <> ",\n l2=" <> show (l2 m) <> "\n}" + +-- >>> M "first line" "second line"