Created
September 26, 2025 10:48
-
-
Save Aster89/e88f8c993afd6ec5d5321951329a6fec to your computer and use it in GitHub Desktop.
YCM log
This file has been truncated, but you can view the full file.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| 2025-09-26 11:24:11,877 - DEBUG - GET b'http://127.0.0.1:40435/ready' (None) | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'mVwp0fjoSwf6ZHV219ib/Ynxbmo1mys9YiK1QiOhR3Y='} | |
| 2025-09-26 11:24:11,889 - DEBUG - GET b'http://127.0.0.1:40435/signature_help_available?subserver=haskell' ({'subserver': 'haskell'}) | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'o36n0zU1HjHmD9GuT2HS/TdLUFAD+xHyWUX0G9hS/Lw='} | |
| 2025-09-26 11:24:11,921 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'3FsMuVnINxlrHo3v7YTx362I98d3B/XenhmXF3tqOsM='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "ultisnips_snippets": [{"trigger": "specf", "description": ""}, {"trigger": "fn0", "description": ""}, {"trigger": "fn1", "description": ""}, {"trigger": "fn2", "description": ""}, {"trigger": "fn3", "description": ""}, {"trigger": "LGPL2", "description": ""}, {"trigger": "LGPL3", "description": ""}, {"trigger": "let", "description": ""}, {"trigger": "GMGPL", "description": "linking exception"}, {"trigger": "todo", "description": "TODO comment"}, {"trigger": "foldp", "description": "Insert a vim fold marker pair"}, {"trigger": "diso", "description": "ISO format datetime"}, {"trigger": "(\\\\", "description": ""}, {"trigger": "imp2", "description": "Selective import"}, {"trigger": "spec", "description": ""}, {"trigger": "inline", "description": ""}, {"trigger": "itp", "description": ""}, {"trigger": "MPL2", "description": ""}, {"trigger": "c)", "description": ""}, {"trigger": "tup3", "description": ""}, {"trigger": "importq", "description": ""}, {"trigger": "ty", "description": ""}, {"trigger": "modeline", "description": "Vim modeline"}, {"trigger": "lang", "description": ""}, {"trigger": "it", "description": ""}, {"trigger": "type", "description": ""}, {"trigger": "tup2", "description": ""}, {"trigger": "=>", "description": "Type constraint"}, {"trigger": "info", "description": ""}, {"trigger": "box", "description": "A nice box with the current comment symbol"}, {"trigger": "const", "description": ""}, {"trigger": "\\\\", "description": ""}, {"trigger": "MIT", "description": ""}, {"trigger": "impq", "description": "Qualified import"}, {"trigger": "bbox", "description": "A nice box over the full width"}, {"trigger": "imp", "description": "Simple import"}, {"trigger": "BEERWARE", "description": ""}, {"trigger": "inst", "description": ""}, {"trigger": "class", "description": ""}, {"trigger": "foldc", "description": "Insert a vim fold close marker"}, {"trigger": "GPL2", "description": ""}, {"trigger": "GPL3", "description": ""}, {"trigger": "time", "description": "hh:mm"}, {"trigger": "tup", "description": ""}, {"trigger": "mod", "description": ""}, {"trigger": "import", "description": ""}, {"trigger": "WTFPL", "description": ""}, {"trigger": "fold", "description": "Insert a vim fold marker"}, {"trigger": "haddock", "description": ""}, {"trigger": "lorem", "description": ""}, {"trigger": "fn", "description": ""}, {"trigger": "module", "description": ""}, {"trigger": "data", "description": ""}, {"trigger": "desc", "description": ""}, {"trigger": "case", "description": ""}, {"trigger": "ap", "description": ""}, {"trigger": "date", "description": "YYYY-MM-DD"}, {"trigger": "ghc", "description": ""}, {"trigger": "AGPL3", "description": ""}, {"trigger": "uuid", "description": "Random UUID"}, {"trigger": "sb", "description": ""}, {"trigger": "where", "description": ""}, {"trigger": "da", "description": ""}, {"trigger": "<-", "description": ""}, {"trigger": "ddate", "description": "Month DD, YYYY"}, {"trigger": "BSD2", "description": ""}, {"trigger": "BSD3", "description": ""}, {"trigger": "BSD4", "description": ""}, {"trigger": "rec", "description": ""}, {"trigger": "datetime", "description": "YYYY-MM-DD hh:mm"}, {"trigger": "ISC", "description": ""}, {"trigger": "AGPL", "description": ""}, {"trigger": "main", "description": ""}, {"trigger": "doc", "description": ""}, {"trigger": "newtype", "description": ""}, {"trigger": "APACHE", "description": ""}, {"trigger": "import2", "description": ""}, {"trigger": "->", "description": ""}], "event_name": "BufferVisit"}' | |
| 2025-09-26 11:24:11,922 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'sp7VUNSJGfh49XQsvkX9jzxgA9K3NxphGJr+oIswKC8='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "syntax_keywords": ["class", "let", "qualified", "infixr", "deriving", "as", "mdo", "in", "module", "infixl", "else", "infix", "where", "data", "case", "if", "import", "of", "default", "then", "newtype", "do", "hiding", "family", "instance", "type"], "event_name": "FileReadyToParse"}' | |
| 2025-09-26 11:24:11,990 - DEBUG - POST b'http://127.0.0.1:40435/receive_messages' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'fJowKPF/FJsF/lPlgZWl4EbwXwCDGWcMIvVeC8g/T+M='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:12,023 - DEBUG - POST b'http://127.0.0.1:40435/semantic_completion_available' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'w1Zcrg7kW5W1q4ZzgFy4Rl+tC0jDeDo4f7KPabwyDpk='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "filetypes": "haskell"}' | |
| 2025-09-26 11:24:12,491 - DEBUG - POST b'http://127.0.0.1:40435/receive_messages' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'fJowKPF/FJsF/lPlgZWl4EbwXwCDGWcMIvVeC8g/T+M='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:16,513 - DEBUG - POST b'http://127.0.0.1:40435/debug_info' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'A7kqemwU7TP6kMmF3Uj6D9Vltnfc6N+KX1BT5l+W1Is='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:22,521 - DEBUG - POST b'http://127.0.0.1:40435/receive_messages' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'fJowKPF/FJsF/lPlgZWl4EbwXwCDGWcMIvVeC8g/T+M='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:26,127 - DEBUG - POST b'http://127.0.0.1:40435/defined_subcommands' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'joRQ6E460RZ+HafKPK1WdZn69st7H/h8y21FEfzp2nU='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 89, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:26,138 - DEBUG - POST b'http://127.0.0.1:40435/run_completer_command' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'M4l8JuROOGQhEY9ysfg795cAqqYy9YCwZSQJb4rRULE='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 89, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "options": {"tab_size": 2, "insert_spaces": true}, "command_arguments": ["GetHover"]}' | |
| 2025-09-26 11:24:28,360 - DEBUG - POST b'http://127.0.0.1:40435/run_completer_command' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'SivFklAlAIxxRMrmfEO3uLPB1PND6cfHFnKJVBAT/5s='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 74, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "options": {"tab_size": 2, "insert_spaces": true}, "command_arguments": ["GetHover"]}' | |
| 2025-09-26 11:24:30,453 - DEBUG - POST b'http://127.0.0.1:40435/run_completer_command' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'J+laaeJ7T4W7l3E6wApF9oSnbsln7ijKx8NGZQKzl0Q='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 58, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "options": {"tab_size": 2, "insert_spaces": true}, "command_arguments": ["GetHover"]}' | |
| 2025-09-26 11:24:32,567 - DEBUG - POST b'http://127.0.0.1:40435/receive_messages' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'fJowKPF/FJsF/lPlgZWl4EbwXwCDGWcMIvVeC8g/T+M='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:35,613 - DEBUG - POST b'http://127.0.0.1:40435/defined_subcommands' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'qSIx0Ez5iA+8G7NFCqa3+6z4xP3cgGC9o3zkD0IcXBU='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 83, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:39,451 - DEBUG - POST b'http://127.0.0.1:40435/run_completer_command' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'P+LCQoPtS7dOnSzC8FOTzNgcnflKBkH2OK4U1yTNB7E='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 83, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "options": {"tab_size": 2, "insert_spaces": true}, "command_arguments": ["GoToDefinition"]}' | |
| 2025-09-26 11:24:39,504 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'ut4n8w8aEWh/YbTDET/R+ur5WSYDjgsc7aMzptxHo+4='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs", "line_num": 1, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs": {"contents": "{-# LANGUAGE DeriveAnyClass #-}\\n{-# LANGUAGE DerivingStrategies #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE LambdaCase #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE TypeFamilies #-}\\n{-# LANGUAGE UndecidableInstances #-}\\n{-# OPTIONS_GHC -Wwarn #-}\\n\\nmodule Ide.Plugin.Eval.Types\\n ( Log(..),\\n locate,\\n locate0,\\n Test (..),\\n isProperty,\\n Format (..),\\n Language (..),\\n Section (..),\\n Sections (..),\\n hasTests,\\n hasPropertyTest,\\n splitSections,\\n Loc,\\n Located (..),\\n Comments (..),\\n RawBlockComment (..),\\n RawLineComment (..),\\n unLoc,\\n Txt,\\n EvalParams(..),\\n GetEvalComments(..),\\n IsEvaluating(..),\\n nullComments)\\nwhere\\n\\nimport Control.Arrow ((>>>))\\nimport Control.DeepSeq (deepseq)\\nimport Control.Lens\\nimport Data.Aeson (FromJSON, ToJSON)\\nimport Data.List (partition)\\nimport Data.List.NonEmpty (NonEmpty)\\nimport Data.Map.Strict (Map)\\nimport Data.String (IsString (..))\\nimport qualified Data.Text as T\\nimport Development.IDE (Range, RuleResult)\\nimport qualified Development.IDE.Core.Shake as Shake\\nimport qualified Development.IDE.GHC.Compat.Core as Core\\nimport Development.IDE.Graph.Classes\\nimport GHC.Generics (Generic)\\nimport Ide.Logger\\nimport Ide.Plugin.Eval.GHC (showDynFlags)\\nimport Ide.Plugin.Eval.Util\\nimport Language.LSP.Protocol.Types (TextDocumentIdentifier,\\n TextEdit)\\nimport qualified System.Time.Extra as Extra\\nimport qualified Text.Megaparsec as P\\n\\ndata Log\\n = LogShake Shake.Log\\n | LogCodeLensFp FilePath\\n | LogCodeLensComments Comments\\n | LogExecutionTime T.Text Extra.Seconds\\n | LogTests !Int !Int !Int !Int\\n | LogRunTestResults [T.Text]\\n | LogRunTestEdits TextEdit\\n | LogEvalFlags [String]\\n | LogEvalPreSetDynFlags Core.DynFlags\\n | LogEvalParsedFlags\\n (Either\\n Core.GhcException\\n (Core.DynFlags, [Core.Located String], DynFlagsParsingWarnings))\\n | LogEvalPostSetDynFlags Core.DynFlags\\n | LogEvalStmtStart String\\n | LogEvalStmtResult (Maybe [T.Text])\\n | LogEvalImport String\\n | LogEvalDeclaration String\\n\\ninstance Pretty Log where\\n pretty = \\\\case\\n LogShake shakeLog -> pretty shakeLog\\n LogCodeLensFp fp -> \\"fp\\" <+> pretty fp\\n LogCodeLensComments comments -> \\"comments\\" <+> viaShow comments\\n LogExecutionTime lbl duration -> pretty lbl <> \\":\\" <+> pretty (Extra.showDuration duration)\\n LogTests nTests nNonSetupSections nSetupSections nLenses -> \\"Tests\\" <+> fillSep\\n [ pretty nTests\\n , \\"tests in\\"\\n , pretty nNonSetupSections\\n , \\"sections\\"\\n , pretty nSetupSections\\n , \\"setups\\"\\n , pretty nLenses\\n , \\"lenses.\\"\\n ]\\n LogRunTestResults results -> \\"TEST RESULTS\\" <+> viaShow results\\n LogRunTestEdits edits -> \\"TEST EDIT\\" <+> viaShow edits\\n LogEvalFlags flags -> \\"{:SET\\" <+> pretty flags\\n LogEvalPreSetDynFlags dynFlags -> \\"pre set\\" <+> pretty (showDynFlags dynFlags)\\n LogEvalParsedFlags eans -> \\"parsed flags\\" <+> viaShow (eans\\n <&> (_1 %~ showDynFlags >>> _3 %~ prettyWarnings))\\n LogEvalPostSetDynFlags dynFlags -> \\"post set\\" <+> pretty (showDynFlags dynFlags)\\n LogEvalStmtStart stmt -> \\"{STMT\\" <+> pretty stmt\\n LogEvalStmtResult result -> \\"STMT}\\" <+> pretty result\\n LogEvalImport stmt -> \\"{IMPORT\\" <+> pretty stmt\\n LogEvalDeclaration stmt -> \\"{DECL\\" <+> pretty stmt\\n\\n-- | A thing with a location attached.\\ndata Located l a = Located {location :: l, located :: a}\\n deriving (Eq, Show, Ord, Functor, Generic, FromJSON, ToJSON)\\n\\n-- | Discard location information.\\nunLoc :: Located l a -> a\\nunLoc (Located _ a) = a\\n\\ninstance (NFData l, NFData a) => NFData (Located l a) where\\n rnf (Located loc a) = loc `deepseq` a `deepseq` ()\\n\\ntype Loc = Located Line\\n\\ntype Line = Int\\n\\nlocate :: Loc [a] -> [Loc a]\\nlocate (Located l tst) = zipWith Located [l ..] tst\\n\\nlocate0 :: [a] -> [Loc a]\\nlocate0 = locate . Located 0\\n\\ntype Txt = String\\n\\ndata Sections = Sections\\n { nonSetupSections :: [Section]\\n , setupSections :: [Section]\\n }\\n deriving (Show, Eq, Generic)\\n\\ndata Section = Section\\n { sectionName :: Txt\\n , sectionTests :: [Test]\\n , sectionLanguage :: Language\\n , sectionFormat :: Format\\n }\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\nhasTests :: Section -> Bool\\nhasTests = not . null . sectionTests\\n\\nhasPropertyTest :: Section -> Bool\\nhasPropertyTest = any isProperty . sectionTests\\n\\n-- |Split setup and normal sections\\nsplitSections :: [Section] -> ([Section], [Section])\\nsplitSections = partition ((== \\"setup\\") . sectionName)\\n\\ndata Test\\n = Example {testLines :: NonEmpty Txt, testOutput :: [Txt], testRange :: Range}\\n | Property {testline :: Txt, testOutput :: [Txt], testRange :: Range}\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ndata IsEvaluating = IsEvaluating\\n deriving (Eq, Show, Generic)\\ninstance Hashable IsEvaluating\\ninstance NFData IsEvaluating\\n\\ntype instance RuleResult IsEvaluating = Bool\\n\\ndata GetEvalComments = GetEvalComments\\n deriving (Eq, Show, Generic)\\ninstance Hashable GetEvalComments\\ninstance NFData GetEvalComments\\n\\ntype instance RuleResult GetEvalComments = Comments\\ndata Comments = Comments\\n { lineComments :: Map Range RawLineComment\\n , blockComments :: Map Range RawBlockComment\\n }\\n deriving (Show, Eq, Ord, Generic)\\n\\nnullComments :: Comments -> Bool\\nnullComments Comments{..} = null lineComments && null blockComments\\n\\ninstance NFData Comments\\n\\nnewtype RawBlockComment = RawBlockComment {getRawBlockComment :: String}\\n deriving (Show, Eq, Ord)\\n deriving newtype\\n ( IsString\\n , P.Stream\\n , P.TraversableStream\\n , P.VisualStream\\n , Semigroup\\n , Monoid\\n , NFData\\n )\\n\\nnewtype RawLineComment = RawLineComment {getRawLineComment :: String}\\n deriving (Show, Eq, Ord)\\n deriving newtype\\n ( IsString\\n , P.Stream\\n , P.TraversableStream\\n , P.VisualStream\\n , Semigroup\\n , Monoid\\n , NFData\\n )\\n\\ninstance Semigroup Comments where\\n Comments ls bs <> Comments ls\' bs\' = Comments (ls <> ls\') (bs <> bs\')\\n\\ninstance Monoid Comments where\\n mempty = Comments mempty mempty\\n\\nisProperty :: Test -> Bool\\nisProperty Property {} = True\\nisProperty _ = False\\n\\ndata Format\\n = SingleLine\\n | -- | @Range@ is that of surrounding entire block comment, not section.\\n -- Used for detecting no-newline test commands.\\n MultiLine Range\\n deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON, NFData)\\n\\ndata Language = Plain | Haddock deriving (Eq, Show, Generic, Ord, FromJSON, ToJSON, NFData)\\n\\ndata ExpectedLine = ExpectedLine [LineChunk] | WildCardLine\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ninstance IsString ExpectedLine where\\n fromString = ExpectedLine . return . LineChunk\\n\\ndata LineChunk = LineChunk String | WildCardChunk\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ninstance IsString LineChunk where\\n fromString = LineChunk\\n\\ntype EvalId = Int\\n\\n-- | Specify the test section to execute\\ndata EvalParams = EvalParams\\n { sections :: [Section]\\n , module_ :: !TextDocumentIdentifier\\n , evalId :: !EvalId -- ^ unique group id; for test uses\\n }\\n deriving (Eq, Show, Generic, FromJSON, ToJSON)\\n", "filetypes": ["haskell"]}}, "ultisnips_snippets": [{"trigger": "specf", "description": ""}, {"trigger": "fn0", "description": ""}, {"trigger": "fn1", "description": ""}, {"trigger": "fn2", "description": ""}, {"trigger": "fn3", "description": ""}, {"trigger": "LGPL2", "description": ""}, {"trigger": "LGPL3", "description": ""}, {"trigger": "let", "description": ""}, {"trigger": "GMGPL", "description": "linking exception"}, {"trigger": "todo", "description": "TODO comment"}, {"trigger": "foldp", "description": "Insert a vim fold marker pair"}, {"trigger": "diso", "description": "ISO format datetime"}, {"trigger": "(\\\\", "description": ""}, {"trigger": "imp2", "description": "Selective import"}, {"trigger": "spec", "description": ""}, {"trigger": "inline", "description": ""}, {"trigger": "itp", "description": ""}, {"trigger": "MPL2", "description": ""}, {"trigger": "c)", "description": ""}, {"trigger": "tup3", "description": ""}, {"trigger": "importq", "description": ""}, {"trigger": "ty", "description": ""}, {"trigger": "modeline", "description": "Vim modeline"}, {"trigger": "lang", "description": ""}, {"trigger": "it", "description": ""}, {"trigger": "type", "description": ""}, {"trigger": "tup2", "description": ""}, {"trigger": "=>", "description": "Type constraint"}, {"trigger": "info", "description": ""}, {"trigger": "box", "description": "A nice box with the current comment symbol"}, {"trigger": "const", "description": ""}, {"trigger": "\\\\", "description": ""}, {"trigger": "MIT", "description": ""}, {"trigger": "impq", "description": "Qualified import"}, {"trigger": "bbox", "description": "A nice box over the full width"}, {"trigger": "imp", "description": "Simple import"}, {"trigger": "BEERWARE", "description": ""}, {"trigger": "inst", "description": ""}, {"trigger": "class", "description": ""}, {"trigger": "foldc", "description": "Insert a vim fold close marker"}, {"trigger": "GPL2", "description": ""}, {"trigger": "GPL3", "description": ""}, {"trigger": "time", "description": "hh:mm"}, {"trigger": "tup", "description": ""}, {"trigger": "mod", "description": ""}, {"trigger": "import", "description": ""}, {"trigger": "WTFPL", "description": ""}, {"trigger": "fold", "description": "Insert a vim fold marker"}, {"trigger": "haddock", "description": ""}, {"trigger": "lorem", "description": ""}, {"trigger": "fn", "description": ""}, {"trigger": "module", "description": ""}, {"trigger": "data", "description": ""}, {"trigger": "desc", "description": ""}, {"trigger": "case", "description": ""}, {"trigger": "ap", "description": ""}, {"trigger": "date", "description": "YYYY-MM-DD"}, {"trigger": "ghc", "description": ""}, {"trigger": "AGPL3", "description": ""}, {"trigger": "uuid", "description": "Random UUID"}, {"trigger": "sb", "description": ""}, {"trigger": "where", "description": ""}, {"trigger": "da", "description": ""}, {"trigger": "<-", "description": ""}, {"trigger": "ddate", "description": "Month DD, YYYY"}, {"trigger": "BSD2", "description": ""}, {"trigger": "BSD3", "description": ""}, {"trigger": "BSD4", "description": ""}, {"trigger": "rec", "description": ""}, {"trigger": "datetime", "description": "YYYY-MM-DD hh:mm"}, {"trigger": "ISC", "description": ""}, {"trigger": "AGPL", "description": ""}, {"trigger": "main", "description": ""}, {"trigger": "doc", "description": ""}, {"trigger": "newtype", "description": ""}, {"trigger": "APACHE", "description": ""}, {"trigger": "import2", "description": ""}, {"trigger": "->", "description": ""}], "event_name": "BufferVisit"}' | |
| 2025-09-26 11:24:39,506 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'IsHeJ+KX9lzw69zKgtq9uWyjueHtuXNJmrY24sFJMuQ='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs", "line_num": 1, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs": {"contents": "{-# LANGUAGE DeriveAnyClass #-}\\n{-# LANGUAGE DerivingStrategies #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE LambdaCase #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE TypeFamilies #-}\\n{-# LANGUAGE UndecidableInstances #-}\\n{-# OPTIONS_GHC -Wwarn #-}\\n\\nmodule Ide.Plugin.Eval.Types\\n ( Log(..),\\n locate,\\n locate0,\\n Test (..),\\n isProperty,\\n Format (..),\\n Language (..),\\n Section (..),\\n Sections (..),\\n hasTests,\\n hasPropertyTest,\\n splitSections,\\n Loc,\\n Located (..),\\n Comments (..),\\n RawBlockComment (..),\\n RawLineComment (..),\\n unLoc,\\n Txt,\\n EvalParams(..),\\n GetEvalComments(..),\\n IsEvaluating(..),\\n nullComments)\\nwhere\\n\\nimport Control.Arrow ((>>>))\\nimport Control.DeepSeq (deepseq)\\nimport Control.Lens\\nimport Data.Aeson (FromJSON, ToJSON)\\nimport Data.List (partition)\\nimport Data.List.NonEmpty (NonEmpty)\\nimport Data.Map.Strict (Map)\\nimport Data.String (IsString (..))\\nimport qualified Data.Text as T\\nimport Development.IDE (Range, RuleResult)\\nimport qualified Development.IDE.Core.Shake as Shake\\nimport qualified Development.IDE.GHC.Compat.Core as Core\\nimport Development.IDE.Graph.Classes\\nimport GHC.Generics (Generic)\\nimport Ide.Logger\\nimport Ide.Plugin.Eval.GHC (showDynFlags)\\nimport Ide.Plugin.Eval.Util\\nimport Language.LSP.Protocol.Types (TextDocumentIdentifier,\\n TextEdit)\\nimport qualified System.Time.Extra as Extra\\nimport qualified Text.Megaparsec as P\\n\\ndata Log\\n = LogShake Shake.Log\\n | LogCodeLensFp FilePath\\n | LogCodeLensComments Comments\\n | LogExecutionTime T.Text Extra.Seconds\\n | LogTests !Int !Int !Int !Int\\n | LogRunTestResults [T.Text]\\n | LogRunTestEdits TextEdit\\n | LogEvalFlags [String]\\n | LogEvalPreSetDynFlags Core.DynFlags\\n | LogEvalParsedFlags\\n (Either\\n Core.GhcException\\n (Core.DynFlags, [Core.Located String], DynFlagsParsingWarnings))\\n | LogEvalPostSetDynFlags Core.DynFlags\\n | LogEvalStmtStart String\\n | LogEvalStmtResult (Maybe [T.Text])\\n | LogEvalImport String\\n | LogEvalDeclaration String\\n\\ninstance Pretty Log where\\n pretty = \\\\case\\n LogShake shakeLog -> pretty shakeLog\\n LogCodeLensFp fp -> \\"fp\\" <+> pretty fp\\n LogCodeLensComments comments -> \\"comments\\" <+> viaShow comments\\n LogExecutionTime lbl duration -> pretty lbl <> \\":\\" <+> pretty (Extra.showDuration duration)\\n LogTests nTests nNonSetupSections nSetupSections nLenses -> \\"Tests\\" <+> fillSep\\n [ pretty nTests\\n , \\"tests in\\"\\n , pretty nNonSetupSections\\n , \\"sections\\"\\n , pretty nSetupSections\\n , \\"setups\\"\\n , pretty nLenses\\n , \\"lenses.\\"\\n ]\\n LogRunTestResults results -> \\"TEST RESULTS\\" <+> viaShow results\\n LogRunTestEdits edits -> \\"TEST EDIT\\" <+> viaShow edits\\n LogEvalFlags flags -> \\"{:SET\\" <+> pretty flags\\n LogEvalPreSetDynFlags dynFlags -> \\"pre set\\" <+> pretty (showDynFlags dynFlags)\\n LogEvalParsedFlags eans -> \\"parsed flags\\" <+> viaShow (eans\\n <&> (_1 %~ showDynFlags >>> _3 %~ prettyWarnings))\\n LogEvalPostSetDynFlags dynFlags -> \\"post set\\" <+> pretty (showDynFlags dynFlags)\\n LogEvalStmtStart stmt -> \\"{STMT\\" <+> pretty stmt\\n LogEvalStmtResult result -> \\"STMT}\\" <+> pretty result\\n LogEvalImport stmt -> \\"{IMPORT\\" <+> pretty stmt\\n LogEvalDeclaration stmt -> \\"{DECL\\" <+> pretty stmt\\n\\n-- | A thing with a location attached.\\ndata Located l a = Located {location :: l, located :: a}\\n deriving (Eq, Show, Ord, Functor, Generic, FromJSON, ToJSON)\\n\\n-- | Discard location information.\\nunLoc :: Located l a -> a\\nunLoc (Located _ a) = a\\n\\ninstance (NFData l, NFData a) => NFData (Located l a) where\\n rnf (Located loc a) = loc `deepseq` a `deepseq` ()\\n\\ntype Loc = Located Line\\n\\ntype Line = Int\\n\\nlocate :: Loc [a] -> [Loc a]\\nlocate (Located l tst) = zipWith Located [l ..] tst\\n\\nlocate0 :: [a] -> [Loc a]\\nlocate0 = locate . Located 0\\n\\ntype Txt = String\\n\\ndata Sections = Sections\\n { nonSetupSections :: [Section]\\n , setupSections :: [Section]\\n }\\n deriving (Show, Eq, Generic)\\n\\ndata Section = Section\\n { sectionName :: Txt\\n , sectionTests :: [Test]\\n , sectionLanguage :: Language\\n , sectionFormat :: Format\\n }\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\nhasTests :: Section -> Bool\\nhasTests = not . null . sectionTests\\n\\nhasPropertyTest :: Section -> Bool\\nhasPropertyTest = any isProperty . sectionTests\\n\\n-- |Split setup and normal sections\\nsplitSections :: [Section] -> ([Section], [Section])\\nsplitSections = partition ((== \\"setup\\") . sectionName)\\n\\ndata Test\\n = Example {testLines :: NonEmpty Txt, testOutput :: [Txt], testRange :: Range}\\n | Property {testline :: Txt, testOutput :: [Txt], testRange :: Range}\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ndata IsEvaluating = IsEvaluating\\n deriving (Eq, Show, Generic)\\ninstance Hashable IsEvaluating\\ninstance NFData IsEvaluating\\n\\ntype instance RuleResult IsEvaluating = Bool\\n\\ndata GetEvalComments = GetEvalComments\\n deriving (Eq, Show, Generic)\\ninstance Hashable GetEvalComments\\ninstance NFData GetEvalComments\\n\\ntype instance RuleResult GetEvalComments = Comments\\ndata Comments = Comments\\n { lineComments :: Map Range RawLineComment\\n , blockComments :: Map Range RawBlockComment\\n }\\n deriving (Show, Eq, Ord, Generic)\\n\\nnullComments :: Comments -> Bool\\nnullComments Comments{..} = null lineComments && null blockComments\\n\\ninstance NFData Comments\\n\\nnewtype RawBlockComment = RawBlockComment {getRawBlockComment :: String}\\n deriving (Show, Eq, Ord)\\n deriving newtype\\n ( IsString\\n , P.Stream\\n , P.TraversableStream\\n , P.VisualStream\\n , Semigroup\\n , Monoid\\n , NFData\\n )\\n\\nnewtype RawLineComment = RawLineComment {getRawLineComment :: String}\\n deriving (Show, Eq, Ord)\\n deriving newtype\\n ( IsString\\n , P.Stream\\n , P.TraversableStream\\n , P.VisualStream\\n , Semigroup\\n , Monoid\\n , NFData\\n )\\n\\ninstance Semigroup Comments where\\n Comments ls bs <> Comments ls\' bs\' = Comments (ls <> ls\') (bs <> bs\')\\n\\ninstance Monoid Comments where\\n mempty = Comments mempty mempty\\n\\nisProperty :: Test -> Bool\\nisProperty Property {} = True\\nisProperty _ = False\\n\\ndata Format\\n = SingleLine\\n | -- | @Range@ is that of surrounding entire block comment, not section.\\n -- Used for detecting no-newline test commands.\\n MultiLine Range\\n deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON, NFData)\\n\\ndata Language = Plain | Haddock deriving (Eq, Show, Generic, Ord, FromJSON, ToJSON, NFData)\\n\\ndata ExpectedLine = ExpectedLine [LineChunk] | WildCardLine\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ninstance IsString ExpectedLine where\\n fromString = ExpectedLine . return . LineChunk\\n\\ndata LineChunk = LineChunk String | WildCardChunk\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ninstance IsString LineChunk where\\n fromString = LineChunk\\n\\ntype EvalId = Int\\n\\n-- | Specify the test section to execute\\ndata EvalParams = EvalParams\\n { sections :: [Section]\\n , module_ :: !TextDocumentIdentifier\\n , evalId :: !EvalId -- ^ unique group id; for test uses\\n }\\n deriving (Eq, Show, Generic, FromJSON, ToJSON)\\n", "filetypes": ["haskell"]}}, "event_name": "FileReadyToParse"}' | |
| 2025-09-26 11:24:42,600 - DEBUG - POST b'http://127.0.0.1:40435/receive_messages' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'fJowKPF/FJsF/lPlgZWl4EbwXwCDGWcMIvVeC8g/T+M='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:42,802 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'dyf3r9uC/xqlVA5h2ehCrUghHJmYHk1kQIPqTdR32Z8='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 1, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "ultisnips_snippets": [{"trigger": "specf", "description": ""}, {"trigger": "fn0", "description": ""}, {"trigger": "fn1", "description": ""}, {"trigger": "fn2", "description": ""}, {"trigger": "fn3", "description": ""}, {"trigger": "LGPL2", "description": ""}, {"trigger": "LGPL3", "description": ""}, {"trigger": "let", "description": ""}, {"trigger": "GMGPL", "description": "linking exception"}, {"trigger": "todo", "description": "TODO comment"}, {"trigger": "foldp", "description": "Insert a vim fold marker pair"}, {"trigger": "diso", "description": "ISO format datetime"}, {"trigger": "(\\\\", "description": ""}, {"trigger": "imp2", "description": "Selective import"}, {"trigger": "spec", "description": ""}, {"trigger": "inline", "description": ""}, {"trigger": "itp", "description": ""}, {"trigger": "MPL2", "description": ""}, {"trigger": "c)", "description": ""}, {"trigger": "tup3", "description": ""}, {"trigger": "importq", "description": ""}, {"trigger": "ty", "description": ""}, {"trigger": "modeline", "description": "Vim modeline"}, {"trigger": "lang", "description": ""}, {"trigger": "it", "description": ""}, {"trigger": "type", "description": ""}, {"trigger": "tup2", "description": ""}, {"trigger": "=>", "description": "Type constraint"}, {"trigger": "info", "description": ""}, {"trigger": "box", "description": "A nice box with the current comment symbol"}, {"trigger": "const", "description": ""}, {"trigger": "\\\\", "description": ""}, {"trigger": "MIT", "description": ""}, {"trigger": "impq", "description": "Qualified import"}, {"trigger": "bbox", "description": "A nice box over the full width"}, {"trigger": "imp", "description": "Simple import"}, {"trigger": "BEERWARE", "description": ""}, {"trigger": "inst", "description": ""}, {"trigger": "class", "description": ""}, {"trigger": "foldc", "description": "Insert a vim fold close marker"}, {"trigger": "GPL2", "description": ""}, {"trigger": "GPL3", "description": ""}, {"trigger": "time", "description": "hh:mm"}, {"trigger": "tup", "description": ""}, {"trigger": "mod", "description": ""}, {"trigger": "import", "description": ""}, {"trigger": "WTFPL", "description": ""}, {"trigger": "fold", "description": "Insert a vim fold marker"}, {"trigger": "haddock", "description": ""}, {"trigger": "lorem", "description": ""}, {"trigger": "fn", "description": ""}, {"trigger": "module", "description": ""}, {"trigger": "data", "description": ""}, {"trigger": "desc", "description": ""}, {"trigger": "case", "description": ""}, {"trigger": "ap", "description": ""}, {"trigger": "date", "description": "YYYY-MM-DD"}, {"trigger": "ghc", "description": ""}, {"trigger": "AGPL3", "description": ""}, {"trigger": "uuid", "description": "Random UUID"}, {"trigger": "sb", "description": ""}, {"trigger": "where", "description": ""}, {"trigger": "da", "description": ""}, {"trigger": "<-", "description": ""}, {"trigger": "ddate", "description": "Month DD, YYYY"}, {"trigger": "BSD2", "description": ""}, {"trigger": "BSD3", "description": ""}, {"trigger": "BSD4", "description": ""}, {"trigger": "rec", "description": ""}, {"trigger": "datetime", "description": "YYYY-MM-DD hh:mm"}, {"trigger": "ISC", "description": ""}, {"trigger": "AGPL", "description": ""}, {"trigger": "main", "description": ""}, {"trigger": "doc", "description": ""}, {"trigger": "newtype", "description": ""}, {"trigger": "APACHE", "description": ""}, {"trigger": "import2", "description": ""}, {"trigger": "->", "description": ""}], "event_name": "BufferVisit"}' | |
| 2025-09-26 11:24:42,806 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'Nn2vyZ4jTS49x/K+UHwOAXaN1FCTJEZSvBad8DRHxTg='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 1, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "event_name": "FileReadyToParse"}' | |
| 2025-09-26 11:24:44,978 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'Cpquc7uSBMQ5LSrWg21IXKiiMA5syOKChoN6k7odfN4='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs", "line_num": 241, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs": {"contents": "{-# LANGUAGE DeriveAnyClass #-}\\n{-# LANGUAGE DerivingStrategies #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE LambdaCase #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE TypeFamilies #-}\\n{-# LANGUAGE UndecidableInstances #-}\\n{-# OPTIONS_GHC -Wwarn #-}\\n\\nmodule Ide.Plugin.Eval.Types\\n ( Log(..),\\n locate,\\n locate0,\\n Test (..),\\n isProperty,\\n Format (..),\\n Language (..),\\n Section (..),\\n Sections (..),\\n hasTests,\\n hasPropertyTest,\\n splitSections,\\n Loc,\\n Located (..),\\n Comments (..),\\n RawBlockComment (..),\\n RawLineComment (..),\\n unLoc,\\n Txt,\\n EvalParams(..),\\n GetEvalComments(..),\\n IsEvaluating(..),\\n nullComments)\\nwhere\\n\\nimport Control.Arrow ((>>>))\\nimport Control.DeepSeq (deepseq)\\nimport Control.Lens\\nimport Data.Aeson (FromJSON, ToJSON)\\nimport Data.List (partition)\\nimport Data.List.NonEmpty (NonEmpty)\\nimport Data.Map.Strict (Map)\\nimport Data.String (IsString (..))\\nimport qualified Data.Text as T\\nimport Development.IDE (Range, RuleResult)\\nimport qualified Development.IDE.Core.Shake as Shake\\nimport qualified Development.IDE.GHC.Compat.Core as Core\\nimport Development.IDE.Graph.Classes\\nimport GHC.Generics (Generic)\\nimport Ide.Logger\\nimport Ide.Plugin.Eval.GHC (showDynFlags)\\nimport Ide.Plugin.Eval.Util\\nimport Language.LSP.Protocol.Types (TextDocumentIdentifier,\\n TextEdit)\\nimport qualified System.Time.Extra as Extra\\nimport qualified Text.Megaparsec as P\\n\\ndata Log\\n = LogShake Shake.Log\\n | LogCodeLensFp FilePath\\n | LogCodeLensComments Comments\\n | LogExecutionTime T.Text Extra.Seconds\\n | LogTests !Int !Int !Int !Int\\n | LogRunTestResults [T.Text]\\n | LogRunTestEdits TextEdit\\n | LogEvalFlags [String]\\n | LogEvalPreSetDynFlags Core.DynFlags\\n | LogEvalParsedFlags\\n (Either\\n Core.GhcException\\n (Core.DynFlags, [Core.Located String], DynFlagsParsingWarnings))\\n | LogEvalPostSetDynFlags Core.DynFlags\\n | LogEvalStmtStart String\\n | LogEvalStmtResult (Maybe [T.Text])\\n | LogEvalImport String\\n | LogEvalDeclaration String\\n\\ninstance Pretty Log where\\n pretty = \\\\case\\n LogShake shakeLog -> pretty shakeLog\\n LogCodeLensFp fp -> \\"fp\\" <+> pretty fp\\n LogCodeLensComments comments -> \\"comments\\" <+> viaShow comments\\n LogExecutionTime lbl duration -> pretty lbl <> \\":\\" <+> pretty (Extra.showDuration duration)\\n LogTests nTests nNonSetupSections nSetupSections nLenses -> \\"Tests\\" <+> fillSep\\n [ pretty nTests\\n , \\"tests in\\"\\n , pretty nNonSetupSections\\n , \\"sections\\"\\n , pretty nSetupSections\\n , \\"setups\\"\\n , pretty nLenses\\n , \\"lenses.\\"\\n ]\\n LogRunTestResults results -> \\"TEST RESULTS\\" <+> viaShow results\\n LogRunTestEdits edits -> \\"TEST EDIT\\" <+> viaShow edits\\n LogEvalFlags flags -> \\"{:SET\\" <+> pretty flags\\n LogEvalPreSetDynFlags dynFlags -> \\"pre set\\" <+> pretty (showDynFlags dynFlags)\\n LogEvalParsedFlags eans -> \\"parsed flags\\" <+> viaShow (eans\\n <&> (_1 %~ showDynFlags >>> _3 %~ prettyWarnings))\\n LogEvalPostSetDynFlags dynFlags -> \\"post set\\" <+> pretty (showDynFlags dynFlags)\\n LogEvalStmtStart stmt -> \\"{STMT\\" <+> pretty stmt\\n LogEvalStmtResult result -> \\"STMT}\\" <+> pretty result\\n LogEvalImport stmt -> \\"{IMPORT\\" <+> pretty stmt\\n LogEvalDeclaration stmt -> \\"{DECL\\" <+> pretty stmt\\n\\n-- | A thing with a location attached.\\ndata Located l a = Located {location :: l, located :: a}\\n deriving (Eq, Show, Ord, Functor, Generic, FromJSON, ToJSON)\\n\\n-- | Discard location information.\\nunLoc :: Located l a -> a\\nunLoc (Located _ a) = a\\n\\ninstance (NFData l, NFData a) => NFData (Located l a) where\\n rnf (Located loc a) = loc `deepseq` a `deepseq` ()\\n\\ntype Loc = Located Line\\n\\ntype Line = Int\\n\\nlocate :: Loc [a] -> [Loc a]\\nlocate (Located l tst) = zipWith Located [l ..] tst\\n\\nlocate0 :: [a] -> [Loc a]\\nlocate0 = locate . Located 0\\n\\ntype Txt = String\\n\\ndata Sections = Sections\\n { nonSetupSections :: [Section]\\n , setupSections :: [Section]\\n }\\n deriving (Show, Eq, Generic)\\n\\ndata Section = Section\\n { sectionName :: Txt\\n , sectionTests :: [Test]\\n , sectionLanguage :: Language\\n , sectionFormat :: Format\\n }\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\nhasTests :: Section -> Bool\\nhasTests = not . null . sectionTests\\n\\nhasPropertyTest :: Section -> Bool\\nhasPropertyTest = any isProperty . sectionTests\\n\\n-- |Split setup and normal sections\\nsplitSections :: [Section] -> ([Section], [Section])\\nsplitSections = partition ((== \\"setup\\") . sectionName)\\n\\ndata Test\\n = Example {testLines :: NonEmpty Txt, testOutput :: [Txt], testRange :: Range}\\n | Property {testline :: Txt, testOutput :: [Txt], testRange :: Range}\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ndata IsEvaluating = IsEvaluating\\n deriving (Eq, Show, Generic)\\ninstance Hashable IsEvaluating\\ninstance NFData IsEvaluating\\n\\ntype instance RuleResult IsEvaluating = Bool\\n\\ndata GetEvalComments = GetEvalComments\\n deriving (Eq, Show, Generic)\\ninstance Hashable GetEvalComments\\ninstance NFData GetEvalComments\\n\\ntype instance RuleResult GetEvalComments = Comments\\ndata Comments = Comments\\n { lineComments :: Map Range RawLineComment\\n , blockComments :: Map Range RawBlockComment\\n }\\n deriving (Show, Eq, Ord, Generic)\\n\\nnullComments :: Comments -> Bool\\nnullComments Comments{..} = null lineComments && null blockComments\\n\\ninstance NFData Comments\\n\\nnewtype RawBlockComment = RawBlockComment {getRawBlockComment :: String}\\n deriving (Show, Eq, Ord)\\n deriving newtype\\n ( IsString\\n , P.Stream\\n , P.TraversableStream\\n , P.VisualStream\\n , Semigroup\\n , Monoid\\n , NFData\\n )\\n\\nnewtype RawLineComment = RawLineComment {getRawLineComment :: String}\\n deriving (Show, Eq, Ord)\\n deriving newtype\\n ( IsString\\n , P.Stream\\n , P.TraversableStream\\n , P.VisualStream\\n , Semigroup\\n , Monoid\\n , NFData\\n )\\n\\ninstance Semigroup Comments where\\n Comments ls bs <> Comments ls\' bs\' = Comments (ls <> ls\') (bs <> bs\')\\n\\ninstance Monoid Comments where\\n mempty = Comments mempty mempty\\n\\nisProperty :: Test -> Bool\\nisProperty Property {} = True\\nisProperty _ = False\\n\\ndata Format\\n = SingleLine\\n | -- | @Range@ is that of surrounding entire block comment, not section.\\n -- Used for detecting no-newline test commands.\\n MultiLine Range\\n deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON, NFData)\\n\\ndata Language = Plain | Haddock deriving (Eq, Show, Generic, Ord, FromJSON, ToJSON, NFData)\\n\\ndata ExpectedLine = ExpectedLine [LineChunk] | WildCardLine\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ninstance IsString ExpectedLine where\\n fromString = ExpectedLine . return . LineChunk\\n\\ndata LineChunk = LineChunk String | WildCardChunk\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ninstance IsString LineChunk where\\n fromString = LineChunk\\n\\ntype EvalId = Int\\n\\n-- | Specify the test section to execute\\ndata EvalParams = EvalParams\\n { sections :: [Section]\\n , module_ :: !TextDocumentIdentifier\\n , evalId :: !EvalId -- ^ unique group id; for test uses\\n }\\n deriving (Eq, Show, Generic, FromJSON, ToJSON)\\n", "filetypes": ["haskell"]}}, "ultisnips_snippets": [{"trigger": "specf", "description": ""}, {"trigger": "fn0", "description": ""}, {"trigger": "fn1", "description": ""}, {"trigger": "fn2", "description": ""}, {"trigger": "fn3", "description": ""}, {"trigger": "LGPL2", "description": ""}, {"trigger": "LGPL3", "description": ""}, {"trigger": "let", "description": ""}, {"trigger": "GMGPL", "description": "linking exception"}, {"trigger": "todo", "description": "TODO comment"}, {"trigger": "foldp", "description": "Insert a vim fold marker pair"}, {"trigger": "diso", "description": "ISO format datetime"}, {"trigger": "(\\\\", "description": ""}, {"trigger": "imp2", "description": "Selective import"}, {"trigger": "spec", "description": ""}, {"trigger": "inline", "description": ""}, {"trigger": "itp", "description": ""}, {"trigger": "MPL2", "description": ""}, {"trigger": "c)", "description": ""}, {"trigger": "tup3", "description": ""}, {"trigger": "importq", "description": ""}, {"trigger": "ty", "description": ""}, {"trigger": "modeline", "description": "Vim modeline"}, {"trigger": "lang", "description": ""}, {"trigger": "it", "description": ""}, {"trigger": "type", "description": ""}, {"trigger": "tup2", "description": ""}, {"trigger": "=>", "description": "Type constraint"}, {"trigger": "info", "description": ""}, {"trigger": "box", "description": "A nice box with the current comment symbol"}, {"trigger": "const", "description": ""}, {"trigger": "\\\\", "description": ""}, {"trigger": "MIT", "description": ""}, {"trigger": "impq", "description": "Qualified import"}, {"trigger": "bbox", "description": "A nice box over the full width"}, {"trigger": "imp", "description": "Simple import"}, {"trigger": "BEERWARE", "description": ""}, {"trigger": "inst", "description": ""}, {"trigger": "class", "description": ""}, {"trigger": "foldc", "description": "Insert a vim fold close marker"}, {"trigger": "GPL2", "description": ""}, {"trigger": "GPL3", "description": ""}, {"trigger": "time", "description": "hh:mm"}, {"trigger": "tup", "description": ""}, {"trigger": "mod", "description": ""}, {"trigger": "import", "description": ""}, {"trigger": "WTFPL", "description": ""}, {"trigger": "fold", "description": "Insert a vim fold marker"}, {"trigger": "haddock", "description": ""}, {"trigger": "lorem", "description": ""}, {"trigger": "fn", "description": ""}, {"trigger": "module", "description": ""}, {"trigger": "data", "description": ""}, {"trigger": "desc", "description": ""}, {"trigger": "case", "description": ""}, {"trigger": "ap", "description": ""}, {"trigger": "date", "description": "YYYY-MM-DD"}, {"trigger": "ghc", "description": ""}, {"trigger": "AGPL3", "description": ""}, {"trigger": "uuid", "description": "Random UUID"}, {"trigger": "sb", "description": ""}, {"trigger": "where", "description": ""}, {"trigger": "da", "description": ""}, {"trigger": "<-", "description": ""}, {"trigger": "ddate", "description": "Month DD, YYYY"}, {"trigger": "BSD2", "description": ""}, {"trigger": "BSD3", "description": ""}, {"trigger": "BSD4", "description": ""}, {"trigger": "rec", "description": ""}, {"trigger": "datetime", "description": "YYYY-MM-DD hh:mm"}, {"trigger": "ISC", "description": ""}, {"trigger": "AGPL", "description": ""}, {"trigger": "main", "description": ""}, {"trigger": "doc", "description": ""}, {"trigger": "newtype", "description": ""}, {"trigger": "APACHE", "description": ""}, {"trigger": "import2", "description": ""}, {"trigger": "->", "description": ""}], "event_name": "BufferVisit"}' | |
| 2025-09-26 11:24:44,983 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'AgKbIPSag2CcPjHeOJFGQ69vBFEXiWt8ddJf3xGzc8k='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs", "line_num": 241, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs": {"contents": "{-# LANGUAGE DeriveAnyClass #-}\\n{-# LANGUAGE DerivingStrategies #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE LambdaCase #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE TypeFamilies #-}\\n{-# LANGUAGE UndecidableInstances #-}\\n{-# OPTIONS_GHC -Wwarn #-}\\n\\nmodule Ide.Plugin.Eval.Types\\n ( Log(..),\\n locate,\\n locate0,\\n Test (..),\\n isProperty,\\n Format (..),\\n Language (..),\\n Section (..),\\n Sections (..),\\n hasTests,\\n hasPropertyTest,\\n splitSections,\\n Loc,\\n Located (..),\\n Comments (..),\\n RawBlockComment (..),\\n RawLineComment (..),\\n unLoc,\\n Txt,\\n EvalParams(..),\\n GetEvalComments(..),\\n IsEvaluating(..),\\n nullComments)\\nwhere\\n\\nimport Control.Arrow ((>>>))\\nimport Control.DeepSeq (deepseq)\\nimport Control.Lens\\nimport Data.Aeson (FromJSON, ToJSON)\\nimport Data.List (partition)\\nimport Data.List.NonEmpty (NonEmpty)\\nimport Data.Map.Strict (Map)\\nimport Data.String (IsString (..))\\nimport qualified Data.Text as T\\nimport Development.IDE (Range, RuleResult)\\nimport qualified Development.IDE.Core.Shake as Shake\\nimport qualified Development.IDE.GHC.Compat.Core as Core\\nimport Development.IDE.Graph.Classes\\nimport GHC.Generics (Generic)\\nimport Ide.Logger\\nimport Ide.Plugin.Eval.GHC (showDynFlags)\\nimport Ide.Plugin.Eval.Util\\nimport Language.LSP.Protocol.Types (TextDocumentIdentifier,\\n TextEdit)\\nimport qualified System.Time.Extra as Extra\\nimport qualified Text.Megaparsec as P\\n\\ndata Log\\n = LogShake Shake.Log\\n | LogCodeLensFp FilePath\\n | LogCodeLensComments Comments\\n | LogExecutionTime T.Text Extra.Seconds\\n | LogTests !Int !Int !Int !Int\\n | LogRunTestResults [T.Text]\\n | LogRunTestEdits TextEdit\\n | LogEvalFlags [String]\\n | LogEvalPreSetDynFlags Core.DynFlags\\n | LogEvalParsedFlags\\n (Either\\n Core.GhcException\\n (Core.DynFlags, [Core.Located String], DynFlagsParsingWarnings))\\n | LogEvalPostSetDynFlags Core.DynFlags\\n | LogEvalStmtStart String\\n | LogEvalStmtResult (Maybe [T.Text])\\n | LogEvalImport String\\n | LogEvalDeclaration String\\n\\ninstance Pretty Log where\\n pretty = \\\\case\\n LogShake shakeLog -> pretty shakeLog\\n LogCodeLensFp fp -> \\"fp\\" <+> pretty fp\\n LogCodeLensComments comments -> \\"comments\\" <+> viaShow comments\\n LogExecutionTime lbl duration -> pretty lbl <> \\":\\" <+> pretty (Extra.showDuration duration)\\n LogTests nTests nNonSetupSections nSetupSections nLenses -> \\"Tests\\" <+> fillSep\\n [ pretty nTests\\n , \\"tests in\\"\\n , pretty nNonSetupSections\\n , \\"sections\\"\\n , pretty nSetupSections\\n , \\"setups\\"\\n , pretty nLenses\\n , \\"lenses.\\"\\n ]\\n LogRunTestResults results -> \\"TEST RESULTS\\" <+> viaShow results\\n LogRunTestEdits edits -> \\"TEST EDIT\\" <+> viaShow edits\\n LogEvalFlags flags -> \\"{:SET\\" <+> pretty flags\\n LogEvalPreSetDynFlags dynFlags -> \\"pre set\\" <+> pretty (showDynFlags dynFlags)\\n LogEvalParsedFlags eans -> \\"parsed flags\\" <+> viaShow (eans\\n <&> (_1 %~ showDynFlags >>> _3 %~ prettyWarnings))\\n LogEvalPostSetDynFlags dynFlags -> \\"post set\\" <+> pretty (showDynFlags dynFlags)\\n LogEvalStmtStart stmt -> \\"{STMT\\" <+> pretty stmt\\n LogEvalStmtResult result -> \\"STMT}\\" <+> pretty result\\n LogEvalImport stmt -> \\"{IMPORT\\" <+> pretty stmt\\n LogEvalDeclaration stmt -> \\"{DECL\\" <+> pretty stmt\\n\\n-- | A thing with a location attached.\\ndata Located l a = Located {location :: l, located :: a}\\n deriving (Eq, Show, Ord, Functor, Generic, FromJSON, ToJSON)\\n\\n-- | Discard location information.\\nunLoc :: Located l a -> a\\nunLoc (Located _ a) = a\\n\\ninstance (NFData l, NFData a) => NFData (Located l a) where\\n rnf (Located loc a) = loc `deepseq` a `deepseq` ()\\n\\ntype Loc = Located Line\\n\\ntype Line = Int\\n\\nlocate :: Loc [a] -> [Loc a]\\nlocate (Located l tst) = zipWith Located [l ..] tst\\n\\nlocate0 :: [a] -> [Loc a]\\nlocate0 = locate . Located 0\\n\\ntype Txt = String\\n\\ndata Sections = Sections\\n { nonSetupSections :: [Section]\\n , setupSections :: [Section]\\n }\\n deriving (Show, Eq, Generic)\\n\\ndata Section = Section\\n { sectionName :: Txt\\n , sectionTests :: [Test]\\n , sectionLanguage :: Language\\n , sectionFormat :: Format\\n }\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\nhasTests :: Section -> Bool\\nhasTests = not . null . sectionTests\\n\\nhasPropertyTest :: Section -> Bool\\nhasPropertyTest = any isProperty . sectionTests\\n\\n-- |Split setup and normal sections\\nsplitSections :: [Section] -> ([Section], [Section])\\nsplitSections = partition ((== \\"setup\\") . sectionName)\\n\\ndata Test\\n = Example {testLines :: NonEmpty Txt, testOutput :: [Txt], testRange :: Range}\\n | Property {testline :: Txt, testOutput :: [Txt], testRange :: Range}\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ndata IsEvaluating = IsEvaluating\\n deriving (Eq, Show, Generic)\\ninstance Hashable IsEvaluating\\ninstance NFData IsEvaluating\\n\\ntype instance RuleResult IsEvaluating = Bool\\n\\ndata GetEvalComments = GetEvalComments\\n deriving (Eq, Show, Generic)\\ninstance Hashable GetEvalComments\\ninstance NFData GetEvalComments\\n\\ntype instance RuleResult GetEvalComments = Comments\\ndata Comments = Comments\\n { lineComments :: Map Range RawLineComment\\n , blockComments :: Map Range RawBlockComment\\n }\\n deriving (Show, Eq, Ord, Generic)\\n\\nnullComments :: Comments -> Bool\\nnullComments Comments{..} = null lineComments && null blockComments\\n\\ninstance NFData Comments\\n\\nnewtype RawBlockComment = RawBlockComment {getRawBlockComment :: String}\\n deriving (Show, Eq, Ord)\\n deriving newtype\\n ( IsString\\n , P.Stream\\n , P.TraversableStream\\n , P.VisualStream\\n , Semigroup\\n , Monoid\\n , NFData\\n )\\n\\nnewtype RawLineComment = RawLineComment {getRawLineComment :: String}\\n deriving (Show, Eq, Ord)\\n deriving newtype\\n ( IsString\\n , P.Stream\\n , P.TraversableStream\\n , P.VisualStream\\n , Semigroup\\n , Monoid\\n , NFData\\n )\\n\\ninstance Semigroup Comments where\\n Comments ls bs <> Comments ls\' bs\' = Comments (ls <> ls\') (bs <> bs\')\\n\\ninstance Monoid Comments where\\n mempty = Comments mempty mempty\\n\\nisProperty :: Test -> Bool\\nisProperty Property {} = True\\nisProperty _ = False\\n\\ndata Format\\n = SingleLine\\n | -- | @Range@ is that of surrounding entire block comment, not section.\\n -- Used for detecting no-newline test commands.\\n MultiLine Range\\n deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON, NFData)\\n\\ndata Language = Plain | Haddock deriving (Eq, Show, Generic, Ord, FromJSON, ToJSON, NFData)\\n\\ndata ExpectedLine = ExpectedLine [LineChunk] | WildCardLine\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ninstance IsString ExpectedLine where\\n fromString = ExpectedLine . return . LineChunk\\n\\ndata LineChunk = LineChunk String | WildCardChunk\\n deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData)\\n\\ninstance IsString LineChunk where\\n fromString = LineChunk\\n\\ntype EvalId = Int\\n\\n-- | Specify the test section to execute\\ndata EvalParams = EvalParams\\n { sections :: [Section]\\n , module_ :: !TextDocumentIdentifier\\n , evalId :: !EvalId -- ^ unique group id; for test uses\\n }\\n deriving (Eq, Show, Generic, FromJSON, ToJSON)\\n", "filetypes": ["haskell"]}}, "event_name": "FileReadyToParse"}' | |
| 2025-09-26 11:24:46,600 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'dyf3r9uC/xqlVA5h2ehCrUghHJmYHk1kQIPqTdR32Z8='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 1, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "ultisnips_snippets": [{"trigger": "specf", "description": ""}, {"trigger": "fn0", "description": ""}, {"trigger": "fn1", "description": ""}, {"trigger": "fn2", "description": ""}, {"trigger": "fn3", "description": ""}, {"trigger": "LGPL2", "description": ""}, {"trigger": "LGPL3", "description": ""}, {"trigger": "let", "description": ""}, {"trigger": "GMGPL", "description": "linking exception"}, {"trigger": "todo", "description": "TODO comment"}, {"trigger": "foldp", "description": "Insert a vim fold marker pair"}, {"trigger": "diso", "description": "ISO format datetime"}, {"trigger": "(\\\\", "description": ""}, {"trigger": "imp2", "description": "Selective import"}, {"trigger": "spec", "description": ""}, {"trigger": "inline", "description": ""}, {"trigger": "itp", "description": ""}, {"trigger": "MPL2", "description": ""}, {"trigger": "c)", "description": ""}, {"trigger": "tup3", "description": ""}, {"trigger": "importq", "description": ""}, {"trigger": "ty", "description": ""}, {"trigger": "modeline", "description": "Vim modeline"}, {"trigger": "lang", "description": ""}, {"trigger": "it", "description": ""}, {"trigger": "type", "description": ""}, {"trigger": "tup2", "description": ""}, {"trigger": "=>", "description": "Type constraint"}, {"trigger": "info", "description": ""}, {"trigger": "box", "description": "A nice box with the current comment symbol"}, {"trigger": "const", "description": ""}, {"trigger": "\\\\", "description": ""}, {"trigger": "MIT", "description": ""}, {"trigger": "impq", "description": "Qualified import"}, {"trigger": "bbox", "description": "A nice box over the full width"}, {"trigger": "imp", "description": "Simple import"}, {"trigger": "BEERWARE", "description": ""}, {"trigger": "inst", "description": ""}, {"trigger": "class", "description": ""}, {"trigger": "foldc", "description": "Insert a vim fold close marker"}, {"trigger": "GPL2", "description": ""}, {"trigger": "GPL3", "description": ""}, {"trigger": "time", "description": "hh:mm"}, {"trigger": "tup", "description": ""}, {"trigger": "mod", "description": ""}, {"trigger": "import", "description": ""}, {"trigger": "WTFPL", "description": ""}, {"trigger": "fold", "description": "Insert a vim fold marker"}, {"trigger": "haddock", "description": ""}, {"trigger": "lorem", "description": ""}, {"trigger": "fn", "description": ""}, {"trigger": "module", "description": ""}, {"trigger": "data", "description": ""}, {"trigger": "desc", "description": ""}, {"trigger": "case", "description": ""}, {"trigger": "ap", "description": ""}, {"trigger": "date", "description": "YYYY-MM-DD"}, {"trigger": "ghc", "description": ""}, {"trigger": "AGPL3", "description": ""}, {"trigger": "uuid", "description": "Random UUID"}, {"trigger": "sb", "description": ""}, {"trigger": "where", "description": ""}, {"trigger": "da", "description": ""}, {"trigger": "<-", "description": ""}, {"trigger": "ddate", "description": "Month DD, YYYY"}, {"trigger": "BSD2", "description": ""}, {"trigger": "BSD3", "description": ""}, {"trigger": "BSD4", "description": ""}, {"trigger": "rec", "description": ""}, {"trigger": "datetime", "description": "YYYY-MM-DD hh:mm"}, {"trigger": "ISC", "description": ""}, {"trigger": "AGPL", "description": ""}, {"trigger": "main", "description": ""}, {"trigger": "doc", "description": ""}, {"trigger": "newtype", "description": ""}, {"trigger": "APACHE", "description": ""}, {"trigger": "import2", "description": ""}, {"trigger": "->", "description": ""}], "event_name": "BufferVisit"}' | |
| 2025-09-26 11:24:46,604 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'Nn2vyZ4jTS49x/K+UHwOAXaN1FCTJEZSvBad8DRHxTg='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 1, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "event_name": "FileReadyToParse"}' | |
| 2025-09-26 11:24:49,466 - DEBUG - POST b'http://127.0.0.1:40435/run_completer_command' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'/fWYs7Y6W4VAUx4hjtqCN0OzOy1pVE4Om4NtIV4DvA0='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 79, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "options": {"tab_size": 2, "insert_spaces": true}, "command_arguments": ["GoToDefinition"]}' | |
| 2025-09-26 11:24:49,506 - DEBUG - Server exception: {'exception': {'TYPE': 'RuntimeError'}, 'message': 'Cannot jump to location', 'traceback': 'Traceback (most recent call last):\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/web_plumbing.py", line 213, in __call__\n out = callback( request, response )\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/watchdog_plugin.py", line 97, in wrapper\n return callback( *args, **kwargs )\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/hmac_plugin.py", line 64, in wrapper\n body = callback( request, response )\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/handlers.py", line 89, in RunCompleterCommand\n return _JsonResponse( completer.OnUserCommand(\n ~~~~~~~~~~~~~~~~~~~~~~~^\n request_data[ \'command_arguments\' ],\n ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n request_data ), response )\n ^^^^^^^^^^^^^^\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/completers/completer.py", line 481, in OnUserCommand\n return command( self, request_data, arguments[ 1: ] )\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/completers/language_server/language_server_completer.py", line 61, in <lambda>\n lambda self, request_data, args: self.GoTo( request_data, [ \'Definition\' ] )\n ~~~~~~~~~^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/completers/language_server/language_server_completer.py", line 2620, in GoTo\n raise RuntimeError( \'Cannot jump to location\' )\nRuntimeError: Cannot jump to location\n'} | |
| 2025-09-26 11:24:49,506 - ERROR - Error while handling server response | |
| Traceback (most recent call last): | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/client/base_request.py", line 274, in _JsonFromFuture | |
| response = future.result() | |
| File "/usr/lib/python3.13/concurrent/futures/_base.py", line 456, in result | |
| return self.__get_result() | |
| ~~~~~~~~~~~~~~~~~^^ | |
| File "/usr/lib/python3.13/concurrent/futures/_base.py", line 401, in __get_result | |
| raise self._exception | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/unsafe_thread_pool_executor.py", line 42, in run | |
| result = self.fn( *self.args, **self.kwargs ) | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/client/base_request.py", line 173, in _MakeRequest | |
| return urlopen( | |
| Request( | |
| ...<3 lines>... | |
| method = method ), | |
| timeout = max( _CONNECT_TIMEOUT_SEC, timeout ) ) | |
| File "/usr/lib/python3.13/urllib/request.py", line 189, in urlopen | |
| return opener.open(url, data, timeout) | |
| ~~~~~~~~~~~^^^^^^^^^^^^^^^^^^^^ | |
| File "/usr/lib/python3.13/urllib/request.py", line 495, in open | |
| response = meth(req, response) | |
| File "/usr/lib/python3.13/urllib/request.py", line 604, in http_response | |
| response = self.parent.error( | |
| 'http', request, response, code, msg, hdrs) | |
| File "/usr/lib/python3.13/urllib/request.py", line 533, in error | |
| return self._call_chain(*args) | |
| ~~~~~~~~~~~~~~~~^^^^^^^ | |
| File "/usr/lib/python3.13/urllib/request.py", line 466, in _call_chain | |
| result = func(*args) | |
| File "/usr/lib/python3.13/urllib/request.py", line 613, in http_error_default | |
| raise HTTPError(req.full_url, code, msg, hdrs, fp) | |
| urllib.error.HTTPError: HTTP Error 500: Internal Server Error | |
| During handling of the above exception, another exception occurred: | |
| Traceback (most recent call last): | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/client/base_request.py", line 77, in HandleFuture | |
| return _JsonFromFuture( future ) | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/client/base_request.py", line 287, in _JsonFromFuture | |
| raise MakeServerException( json.loads( response_text ) ) | |
| ycmd.responses.ServerError: RuntimeError: Cannot jump to location | |
| 2025-09-26 11:24:52,653 - DEBUG - POST b'http://127.0.0.1:40435/receive_messages' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'fJowKPF/FJsF/lPlgZWl4EbwXwCDGWcMIvVeC8g/T+M='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:24:54,071 - DEBUG - POST b'http://127.0.0.1:40435/run_completer_command' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'C21K+euJwU3KDhQOYgWN2k5DF36jFExsL2DZzXvVhAc='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 59, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "options": {"tab_size": 2, "insert_spaces": true}, "command_arguments": ["GoToDefinition"]}' | |
| 2025-09-26 11:24:54,092 - DEBUG - Server exception: {'exception': {'TYPE': 'RuntimeError'}, 'message': 'Cannot jump to location', 'traceback': 'Traceback (most recent call last):\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/web_plumbing.py", line 213, in __call__\n out = callback( request, response )\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/watchdog_plugin.py", line 97, in wrapper\n return callback( *args, **kwargs )\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/hmac_plugin.py", line 64, in wrapper\n body = callback( request, response )\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/handlers.py", line 89, in RunCompleterCommand\n return _JsonResponse( completer.OnUserCommand(\n ~~~~~~~~~~~~~~~~~~~~~~~^\n request_data[ \'command_arguments\' ],\n ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n request_data ), response )\n ^^^^^^^^^^^^^^\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/completers/completer.py", line 481, in OnUserCommand\n return command( self, request_data, arguments[ 1: ] )\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/completers/language_server/language_server_completer.py", line 61, in <lambda>\n lambda self, request_data, args: self.GoTo( request_data, [ \'Definition\' ] )\n ~~~~~~~~~^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\n File "/home/enrico/.vim/plugged/YouCompleteMe/third_party/ycmd/ycmd/completers/language_server/language_server_completer.py", line 2620, in GoTo\n raise RuntimeError( \'Cannot jump to location\' )\nRuntimeError: Cannot jump to location\n'} | |
| 2025-09-26 11:24:54,092 - ERROR - Error while handling server response | |
| Traceback (most recent call last): | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/client/base_request.py", line 274, in _JsonFromFuture | |
| response = future.result() | |
| File "/usr/lib/python3.13/concurrent/futures/_base.py", line 456, in result | |
| return self.__get_result() | |
| ~~~~~~~~~~~~~~~~~^^ | |
| File "/usr/lib/python3.13/concurrent/futures/_base.py", line 401, in __get_result | |
| raise self._exception | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/unsafe_thread_pool_executor.py", line 42, in run | |
| result = self.fn( *self.args, **self.kwargs ) | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/client/base_request.py", line 173, in _MakeRequest | |
| return urlopen( | |
| Request( | |
| ...<3 lines>... | |
| method = method ), | |
| timeout = max( _CONNECT_TIMEOUT_SEC, timeout ) ) | |
| File "/usr/lib/python3.13/urllib/request.py", line 189, in urlopen | |
| return opener.open(url, data, timeout) | |
| ~~~~~~~~~~~^^^^^^^^^^^^^^^^^^^^ | |
| File "/usr/lib/python3.13/urllib/request.py", line 495, in open | |
| response = meth(req, response) | |
| File "/usr/lib/python3.13/urllib/request.py", line 604, in http_response | |
| response = self.parent.error( | |
| 'http', request, response, code, msg, hdrs) | |
| File "/usr/lib/python3.13/urllib/request.py", line 533, in error | |
| return self._call_chain(*args) | |
| ~~~~~~~~~~~~~~~~^^^^^^^ | |
| File "/usr/lib/python3.13/urllib/request.py", line 466, in _call_chain | |
| result = func(*args) | |
| File "/usr/lib/python3.13/urllib/request.py", line 613, in http_error_default | |
| raise HTTPError(req.full_url, code, msg, hdrs, fp) | |
| urllib.error.HTTPError: HTTP Error 500: Internal Server Error | |
| During handling of the above exception, another exception occurred: | |
| Traceback (most recent call last): | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/client/base_request.py", line 77, in HandleFuture | |
| return _JsonFromFuture( future ) | |
| File "/home/enrico/.vim/plugged/YouCompleteMe/python/ycm/client/base_request.py", line 287, in _JsonFromFuture | |
| raise MakeServerException( json.loads( response_text ) ) | |
| ycmd.responses.ServerError: RuntimeError: Cannot jump to location | |
| 2025-09-26 11:25:00,299 - DEBUG - POST b'http://127.0.0.1:40435/run_completer_command' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'SivFklAlAIxxRMrmfEO3uLPB1PND6cfHFnKJVBAT/5s='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 202, "column_num": 74, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}, "options": {"tab_size": 2, "insert_spaces": true}, "command_arguments": ["GetHover"]}' | |
| 2025-09-26 11:25:02,675 - DEBUG - POST b'http://127.0.0.1:40435/receive_messages' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'fJowKPF/FJsF/lPlgZWl4EbwXwCDGWcMIvVeC8g/T+M='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs", "line_num": 203, "column_num": 51, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Handlers.hs": {"contents": "{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE ExtendedDefaultRules #-}\\n{-# LANGUAGE NoMonomorphismRestriction #-}\\n{-# LANGUAGE OverloadedStrings #-}\\n{-# LANGUAGE RecordWildCards #-}\\n{-# LANGUAGE ViewPatterns #-}\\n{-# OPTIONS_GHC -Wno-type-defaults #-}\\n\\n{- |\\nA plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>\'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.\\n\\nFor a full example see the \\"Ide.Plugin.Eval.Tutorial\\" module.\\n-}\\nmodule Ide.Plugin.Eval.Handlers (\\n codeAction,\\n codeLens,\\n evalCommand,\\n) where\\n\\nimport Control.Applicative (Alternative ((<|>)))\\nimport Control.Arrow (second)\\nimport Control.Exception (bracket_)\\nimport qualified Control.Exception as E\\nimport Control.Lens (ix, (%~), (^.))\\nimport Control.Monad (guard, void,\\n when)\\nimport Control.Monad.IO.Class (MonadIO (liftIO))\\nimport Control.Monad.Trans.Except (ExceptT (..),\\n runExceptT)\\nimport Data.Aeson (toJSON)\\nimport Data.Char (isSpace)\\nimport Data.Foldable (toList)\\nimport Data.List (dropWhileEnd,\\n find,\\n intercalate,\\n intersperse)\\nimport qualified Data.Map as Map\\nimport Data.Maybe (catMaybes)\\nimport Data.String (IsString)\\nimport Data.Text (Text)\\nimport qualified Data.Text as T\\nimport qualified Data.Text.Utf16.Rope.Mixed as Rope\\nimport Development.IDE.Core.FileStore (getUriContents, setSomethingModified)\\nimport Development.IDE.Core.Rules (IdeState,\\n runAction)\\nimport Development.IDE.Core.Shake (use_, uses_, VFSModified (VFSUnmodified), useWithSeparateFingerprintRule_)\\nimport Development.IDE.GHC.Compat hiding (typeKind,\\n unitState)\\nimport Development.IDE.GHC.Compat.Util (OverridingBool (..))\\nimport Development.IDE.GHC.Util (evalGhcEnv,\\n modifyDynFlags)\\nimport Development.IDE.Import.DependencyInformation (transitiveDeps,\\n transitiveModuleDeps)\\nimport Development.IDE.Types.Location (toNormalizedFilePath\')\\nimport GHC (ClsInst,\\n ExecOptions (execLineNumber, execSourceFile),\\n FamInst,\\n GhcMonad,\\n NamedThing (getName),\\n defaultFixity,\\n execOptions,\\n exprType,\\n getInfo,\\n getInteractiveDynFlags,\\n isImport, isStmt,\\n parseName,\\n pprFamInst,\\n pprInstance,\\n typeKind)\\n\\n\\nimport Development.IDE.Core.RuleTypes (GetLinkable (GetLinkable),\\n GetModSummary (GetModSummary),\\n GetModuleGraphTransDepsFingerprints (GetModuleGraphTransDepsFingerprints),\\n GhcSessionDeps (GhcSessionDeps),\\n ModSummaryResult (msrModSummary),\\n LinkableResult (linkableHomeMod),\\n TypeCheck (..),\\n tmrTypechecked, GetModuleGraphTransDepsFingerprints(..), GetModuleGraph(..))\\nimport qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))\\nimport qualified Development.IDE.GHC.Compat.Core as SrcLoc (unLoc)\\nimport Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))\\nimport qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))\\n\\nimport Data.List.Extra (unsnoc)\\nimport Development.IDE.Core.PluginUtils\\nimport Development.IDE.Types.Shake (toKey)\\nimport GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))\\nimport Ide.Logger (Priority (..),\\n Recorder,\\n WithPriority,\\n logWith)\\nimport Ide.Plugin.Error (PluginError (PluginInternalError),\\n handleMaybeM)\\nimport Ide.Plugin.Eval.Code (Statement,\\n asStatements,\\n myExecStmt,\\n propSetup,\\n resultRange,\\n testCheck,\\n testRanges)\\nimport Ide.Plugin.Eval.Config (EvalConfig (..),\\n getEvalConfig)\\nimport Ide.Plugin.Eval.GHC (addImport,\\n addPackages,\\n hasPackage,\\n setSessionAndInteractiveDynFlags)\\nimport Ide.Plugin.Eval.Parse.Comments (commentsToSections)\\nimport Ide.Plugin.Eval.Parse.Option (parseSetFlags)\\nimport Ide.Plugin.Eval.Rules (queueForEvaluation,\\n unqueueForEvaluation)\\nimport Ide.Plugin.Eval.Types\\nimport Ide.Plugin.Eval.Util (gStrictTry,\\n isLiterate,\\n prettyWarnings,\\n response\', timed)\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport Language.LSP.Server\\n#if MIN_VERSION_ghc(9,11,0)\\nimport GHC.Unit.Module.ModIface (IfaceTopEnv (..))\\n#endif\\n\\ncodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeAction\\ncodeAction recorder st plId CodeActionParams{_textDocument,_range} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ InL command\\n | (testRange, command) <- rangeCommands\\n , _range `isSubrangeOf` testRange\\n ]\\n\\n{- | Code Lens provider\\n NOTE: Invoked every time the document is modified, not just when the document is saved.\\n-}\\ncodeLens :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState Method_TextDocumentCodeLens\\ncodeLens recorder st plId CodeLensParams{_textDocument} = do\\n rangeCommands <- mkRangeCommands recorder st plId _textDocument\\n pure\\n $ InL\\n [ CodeLens range (Just command) Nothing\\n | (range, command) <- rangeCommands\\n ]\\n\\nmkRangeCommands :: Recorder (WithPriority Log) -> IdeState -> PluginId -> TextDocumentIdentifier -> ExceptT PluginError (HandlerM Config) [(Range, Command)]\\nmkRangeCommands recorder st plId textDocument =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n in perf \\"evalMkRangeCommands\\" $\\n do\\n let TextDocumentIdentifier uri = textDocument\\n fp <- uriToFilePathE uri\\n let nfp = toNormalizedFilePath\' fp\\n isLHS = isLiterate fp\\n dbg $ LogCodeLensFp fp\\n (comments, _) <-\\n runActionE \\"eval.GetParsedModuleWithComments\\" st $ useWithStaleE GetEvalComments nfp\\n dbg $ LogCodeLensComments comments\\n\\n -- Extract tests from source code\\n let Sections{..} = commentsToSections isLHS comments\\n tests = testsBySection nonSetupSections\\n cmd = mkLspCommand plId evalCommandName \\"Evaluate=...\\" (Just [])\\n let rangeCommands =\\n [ (testRange, cmd\')\\n | (section, ident, test) <- tests\\n , let (testRange, resultRange) = testRanges test\\n args = EvalParams (setupSections ++ [section]) textDocument ident\\n cmd\' =\\n (cmd :: Command)\\n { _arguments = Just [toJSON args]\\n , _title =\\n if trivial resultRange\\n then \\"Evaluate...\\"\\n else \\"Refresh...\\"\\n }\\n ]\\n\\n perf \\"tests\\" $\\n dbg $ LogTests\\n (length tests)\\n (length nonSetupSections)\\n (length setupSections)\\n (length rangeCommands)\\n\\n pure rangeCommands\\n where\\n trivial (Range p p\') = p == p\'\\n\\nevalCommandName :: CommandId\\nevalCommandName = \\"evalCommand\\"\\n\\nevalCommand :: Recorder (WithPriority Log) -> PluginId -> PluginCommand IdeState\\nevalCommand recorder plId = PluginCommand evalCommandName \\"evaluate\\" (runEvalCmd recorder plId)\\n\\ntype EvalId = Int\\n\\nrunEvalCmd :: Recorder (WithPriority Log) -> PluginId -> CommandFunction IdeState EvalParams\\nrunEvalCmd recorder plId st mtoken EvalParams{..} =\\n let dbg = logWith recorder Debug\\n perf = timed (\\\\lbl duration -> dbg $ LogExecutionTime lbl duration)\\n cmd :: ExceptT PluginError (HandlerM Config) WorkspaceEdit\\n cmd = do\\n let tests = map (\\\\(a,_,b) -> (a,b)) $ testsBySection sections\\n\\n let TextDocumentIdentifier{_uri} = module_\\n fp <- uriToFilePathE _uri\\n let nfp = toNormalizedFilePath\' fp\\n mdlText <- moduleText st _uri\\n\\n -- enable codegen for the module which we need to evaluate.\\n final_hscEnv <- liftIO $ bracket_\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n queueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (setSomethingModified VFSUnmodified st \\"Eval\\" $ do\\n unqueueForEvaluation st nfp\\n return [toKey IsEvaluating nfp]\\n )\\n (initialiseSessionForEval (needsQuickCheck tests) st nfp)\\n\\n evalCfg <- liftIO $ runAction \\"eval: config\\" st $ getEvalConfig plId\\n\\n -- Perform the evaluation of the command\\n edits <-\\n perf \\"edits\\" $\\n liftIO $\\n evalGhcEnv final_hscEnv $ do\\n runTests recorder evalCfg fp tests\\n\\n let workspaceEditsMap = Map.singleton _uri (addFinalReturn mdlText edits)\\n let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing\\n\\n return workspaceEdits\\n in perf \\"evalCmd\\" $ ExceptT $\\n pluginWithIndefiniteProgress \\"Evaluating\\" mtoken Cancellable $ \\\\_updater ->\\n runExceptT $ response\' cmd\\n\\n-- | Create an HscEnv which is suitable for performing interactive evaluation.\\n-- All necessary home modules will have linkables and the current module will\\n-- also be loaded into the environment.\\n--\\n-- The interactive context and interactive dynamic flags are also set appropiately.\\ninitialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv\\ninitialiseSessionForEval needs_quickcheck st nfp = do\\n (ms, env1) <- runAction \\"runEvalCmd\\" st $ do\\n\\n ms <- msrModSummary <$> use_ GetModSummary nfp\\n deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp\\n\\n linkables_needed <- transitiveDeps <$> useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph nfp <*> pure nfp\\n linkables <- uses_ GetLinkable (nfp : maybe [] transitiveModuleDeps linkables_needed)\\n -- We unset the global rdr env in mi_globals when we generate interfaces\\n -- See Note [Clearing mi_globals after generating an iface]\\n -- However, the eval plugin (setContext specifically) requires the rdr_env\\n -- for the current module - so get it from the Typechecked Module and add\\n -- it back to the iface for the current module.\\n tm <- tmrTypechecked <$> use_ TypeCheck nfp\\n let rdr_env = tcg_rdr_env tm\\n let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc\\n addRdrEnv hmi\\n | iface <- hm_iface hmi\\n , ms_mod ms == mi_module iface\\n#if MIN_VERSION_ghc(9,11,0)\\n = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface}\\n#else\\n = hmi { hm_iface = iface { mi_globals = Just $!\\n#if MIN_VERSION_ghc(9,8,0)\\n forceGlobalRdrEnv\\n#endif\\n rdr_env\\n }}\\n#endif\\n | otherwise = hmi\\n\\n return (ms, linkable_hsc)\\n -- Bit awkward we need to use evalGhcEnv here but setContext requires to run\\n -- in the Ghc monad\\n env2 <- liftIO $ evalGhcEnv env1 $ do\\n setContext [Compat.IIModule (moduleName (ms_mod ms))]\\n let df = flip xopt_set LangExt.ExtendedDefaultRules\\n . flip xopt_unset LangExt.MonomorphismRestriction\\n . flip gopt_set Opt_ImplicitImportQualified\\n . flip gopt_unset Opt_DiagnosticsShowCaret\\n . setBackend ghciBackend\\n $ (ms_hspp_opts ms) {\\n useColor = Never\\n , canUseColor = False }\\n modifyDynFlags (const df)\\n when needs_quickcheck $ void $ addPackages [\\"QuickCheck\\"]\\n getSession\\n return env2\\n\\n#if MIN_VERSION_ghc(9,11,0)\\nmkIfaceImports :: [ImportUserSpec] -> [IfaceImport]\\nmkIfaceImports = map go\\n where\\n go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll\\n go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))\\n go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)\\n#endif\\n\\naddFinalReturn :: Text -> [TextEdit] -> [TextEdit]\\naddFinalReturn mdlText edits\\n | not (null edits) && not (T.null mdlText) && T.last mdlText /= \'\\\\n\' =\\n finalReturn mdlText : edits\\n | otherwise = edits\\n\\nfinalReturn :: Text -> TextEdit\\nfinalReturn txt =\\n let ls = T.lines txt\\n l = fromIntegral $ length ls -1\\n c = fromIntegral $ T.length $ maybe T.empty snd (unsnoc ls)\\n p = Position l c\\n in TextEdit (Range p p) \\"\\\\n\\"\\n\\nmoduleText :: IdeState -> Uri -> ExceptT PluginError (HandlerM config) Text\\nmoduleText state uri = do\\n contents <-\\n handleMaybeM (PluginInternalError \\"mdlText\\") $\\n liftIO $\\n runAction \\"eval.getUriContents\\" state $\\n getUriContents $\\n toNormalizedUri uri\\n pure $ Rope.toText contents\\n\\ntestsBySection :: [Section] -> [(Section, EvalId, Test)]\\ntestsBySection sections =\\n [(section, ident, test)\\n | (ident, section) <- zip [0..] sections\\n , test <- sectionTests section\\n ]\\n\\ntype TEnv = String\\n-- |GHC declarations required for expression evaluation\\nevalSetup :: Ghc ()\\nevalSetup = do\\n preludeAsP <- parseImportDecl \\"import qualified Prelude as P\\"\\n context <- getContext\\n setContext (IIDecl preludeAsP : context)\\n\\nrunTests :: Recorder (WithPriority Log) -> EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit]\\nrunTests recorder EvalConfig{..} e tests = do\\n df <- getInteractiveDynFlags\\n evalSetup\\n when (hasQuickCheck df && needsQuickCheck tests) $ void $ evals recorder True e df propSetup\\n\\n mapM (processTest e df) tests\\n where\\n processTest :: TEnv -> DynFlags -> (Section, Test) -> Ghc TextEdit\\n processTest fp df (section, test) = do\\n let dbg = logWith recorder Debug\\n let pad = pad_ $ (if isLiterate fp then (\\"> \\" `T.append`) else id) $ padPrefix (sectionFormat section)\\n rs <- runTest e df test\\n dbg $ LogRunTestResults rs\\n\\n let checkedResult = testCheck eval_cfg_diff (section, test) rs\\n let resultLines = concatMap T.lines checkedResult\\n\\n let edit = asEdit (sectionFormat section) test (map pad resultLines)\\n dbg $ LogRunTestEdits edit\\n return edit\\n\\n -- runTest :: String -> DynFlags -> Loc Test -> Ghc [Text]\\n runTest _ df test\\n | not (hasQuickCheck df) && isProperty test =\\n return $\\n singleLine\\n \\"Add QuickCheck to your cabal dependencies to run this test.\\"\\n runTest e df test = evals recorder (eval_cfg_exception && not (isProperty test)) e df (asStatements test)\\n\\nasEdit :: Format -> Test -> [Text] -> TextEdit\\nasEdit (MultiLine commRange) test resultLines\\n -- A test in a block comment, ending with @-\\\\}@ without newline in-between.\\n | testRange test ^. L.end . L.line == commRange ^. L.end . L.line\\n =\\n TextEdit\\n (Range\\n (testRange test ^. L.end)\\n (resultRange test ^. L.end)\\n )\\n (\\"\\\\n\\" <> T.unlines (resultLines <> [\\"-}\\"]))\\nasEdit _ test resultLines =\\n TextEdit (resultRange test) (T.unlines resultLines)\\n\\n{- |\\nThe result of evaluating a test line can be:\\n* a value\\n* nothing\\n* a (possibly multiline) error message\\n\\nA value is returned for a correct expression.\\n\\nEither a pure value:\\n>>> \'h\' :\\"askell\\"\\n\\"haskell\\"\\n\\nOr an \'IO a\' (output on stdout/stderr is ignored):\\n>>> print \\"OK\\" >> return \\"ABC\\"\\n\\"ABC\\"\\n\\nNothing is returned for a correct directive:\\n\\n>>>:set -XFlexibleInstances\\n>>> import Data.Maybe\\n\\nNothing is returned for a correct declaration (let..,x=, data, class)\\n\\n>>> let x = 11\\n>>> y = 22\\n>>> data B = T | F\\n>>> class C a\\n\\nNothing is returned for an empty line:\\n\\n>>>\\n\\nA, possibly multi line, error is returned for a wrong declaration, directive or value or an exception thrown by the evaluated code:\\n\\n>>>:set -XNonExistent\\nSome flags have not been recognized: -XNonExistent\\n\\n>>> cls C\\nVariable not in scope: cls :: t0 -> t\\nData constructor not in scope: C\\n\\n>>> \\"A\\nlexical error in string/character literal at end of input\\n\\nExceptions are shown as if printed, but it can be configured to include prefix like\\nin GHCi or doctest. This allows it to be used as a hack to simulate print until we\\nget proper IO support. See #1977\\n\\n>>> 3 `div` 0\\ndivide by zero\\n\\n>>> error \\"Something went wrong\\\\nbad times\\" :: E.SomeException\\nSomething went wrong\\nbad times\\n\\nOr for a value that does not have a Show instance and can therefore not be displayed:\\n>>> data V = V\\n>>> V\\nNo instance for (Show V) arising from a use of \\u2018evalPrint\\u2019\\n-}\\nevals :: Recorder (WithPriority Log) -> Bool -> TEnv -> DynFlags -> [Statement] -> Ghc [Text]\\nevals recorder mark_exception fp df stmts = do\\n er <- gStrictTry $ mapM eval stmts\\n return $ case er of\\n Left err -> errorLines err\\n Right rs -> concat . catMaybes $ rs\\n where\\n dbg = logWith recorder Debug\\n eval :: Statement -> Ghc (Maybe [Text])\\n eval (Located l stmt)\\n | -- GHCi flags\\n Just (words -> flags) <- parseSetFlags stmt = do\\n dbg $ LogEvalFlags flags\\n ndf <- getInteractiveDynFlags\\n dbg $ LogEvalPreSetDynFlags ndf\\n eans <-\\n liftIO $ try @GhcException $\\n parseDynamicFlagsCmdLine ndf\\n (map (L $ UnhelpfulSpan unhelpfulReason) flags)\\n dbg $ LogEvalParsedFlags eans\\n case eans of\\n Left err -> pure $ Just $ errorLines $ show err\\n Right (df\', ignoreds, warns) -> do\\n let warnings = do\\n guard $ not $ null warns\\n pure $ errorLines $\\n prettyWarnings warns\\n igns = do\\n guard $ not $ null ignoreds\\n pure\\n [\\"Some flags have not been recognized: \\"\\n <> T.pack (intercalate \\", \\" $ map SrcLoc.unLoc ignoreds)\\n ]\\n dbg $ LogEvalPostSetDynFlags df\'\\n setSessionAndInteractiveDynFlags df\'\\n pure $ warnings <> igns\\n | -- A type/kind command\\n Just (cmd, arg) <- parseGhciLikeCmd $ T.pack stmt =\\n evalGhciLikeCmd cmd arg\\n | -- A statement\\n isStmt pf stmt =\\n do\\n dbg $ LogEvalStmtStart stmt\\n res <- exec stmt l\\n let r = case res of\\n Left err -> Just . (if mark_exception then exceptionLines else errorLines) $ err\\n Right x -> singleLine <$> x\\n dbg $ LogEvalStmtResult r\\n return r\\n | -- An import\\n isImport pf stmt =\\n do\\n dbg $ LogEvalImport stmt\\n _ <- addImport stmt\\n return Nothing\\n | -- A declaration\\n otherwise =\\n do\\n dbg $ LogEvalDeclaration stmt\\n void $ runDecls stmt\\n return Nothing\\n pf = initParserOpts df\\n unhelpfulReason = UnhelpfulInteractive\\n exec stmt l =\\n let opts = execOptions{execSourceFile = fp, execLineNumber = l}\\n in myExecStmt stmt opts\\n\\nneedsQuickCheck :: [(Section, Test)] -> Bool\\nneedsQuickCheck = any (isProperty . snd)\\n\\nhasQuickCheck :: DynFlags -> Bool\\nhasQuickCheck df = hasPackage df \\"QuickCheck\\"\\n\\nsingleLine :: String -> [Text]\\nsingleLine s = [T.pack s]\\n\\n{- |\\n Convert error messages to a list of text lines\\n Remove unnecessary information.\\n-}\\nerrorLines :: String -> [Text]\\nerrorLines =\\n dropWhileEnd T.null\\n . takeWhile (not . (\\\\x -> \\"CallStack\\" `T.isPrefixOf` x || \\"HasCallStack\\" `T.isPrefixOf` x))\\n . T.lines\\n . T.pack\\n\\n{- |\\n Convert exception messages to a list of text lines\\n Remove unnecessary information and mark it as exception.\\n We use \'*** Exception:\' to make it identical to doctest\\n output, see #2353.\\n-}\\nexceptionLines :: String -> [Text]\\nexceptionLines = (ix 0 %~ (\\"*** Exception: \\" <>)) . errorLines\\n\\n{- |\\n>>> map (pad_ (T.pack \\"--\\")) (map T.pack [\\"2+2\\",\\"\\"])\\n[\\"--2+2\\",\\"--<BLANKLINE>\\"]\\n-}\\npad_ :: Text -> Text -> Text\\npad_ prefix = (prefix `T.append`) . convertBlank\\n\\nconvertBlank :: Text -> Text\\nconvertBlank x\\n | T.null x = \\"<BLANKLINE>\\"\\n | otherwise = x\\n\\npadPrefix :: IsString p => Format -> p\\npadPrefix SingleLine = \\"-- \\"\\npadPrefix _ = \\"\\"\\n\\n{- | Resulting @Text@ MUST NOT prefix each line with @--@\\n Such comment-related post-process will be taken place\\n solely in \'evalGhciLikeCmd\'.\\n-}\\ntype GHCiLikeCmd = DynFlags -> Text -> Ghc (Maybe Text)\\n\\n-- Should we use some sort of trie here?\\nghciLikeCommands :: [(Text, GHCiLikeCmd)]\\nghciLikeCommands =\\n [ (\\"info\\", doInfoCmd False)\\n , (\\"info!\\", doInfoCmd True)\\n , (\\"kind\\", doKindCmd False)\\n , (\\"kind!\\", doKindCmd True)\\n , (\\"type\\", doTypeCmd)\\n ]\\n\\nevalGhciLikeCmd :: Text -> Text -> Ghc (Maybe [Text])\\nevalGhciLikeCmd cmd arg = do\\n df <- getSessionDynFlags\\n case lookup cmd ghciLikeCommands\\n <|> snd\\n <$> find (T.isPrefixOf cmd . fst) ghciLikeCommands of\\n Just hndler ->\\n fmap\\n T.lines\\n <$> hndler df arg\\n _ -> E.throw $ GhciLikeCmdNotImplemented cmd arg\\n\\ndoInfoCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoInfoCmd allInfo dflags s = do\\n sdocs <- mapM infoThing (T.words s)\\n pure $ Just $ T.pack $ showSDoc dflags (vcat sdocs)\\n where\\n infoThing :: GHC.GhcMonad m => Text -> m SDoc\\n infoThing (T.unpack -> str) = do\\n names <- GHC.parseName str\\n mb_stuffs <- mapM (GHC.getInfo allInfo) names\\n let filtered = filterOutChildren (\\\\(t,_f,_ci,_fi,_sd) -> t)\\n (catMaybes $ toList mb_stuffs)\\n return $ vcat (intersperse (text \\"\\") $ map pprInfo filtered)\\n\\n filterOutChildren :: (a -> TyThing) -> [a] -> [a]\\n filterOutChildren get_thing xs\\n = filter (not . has_parent) xs\\n where\\n all_names = mkNameSet (map (getName . get_thing) xs)\\n has_parent x = case tyThingParent_maybe (get_thing x) of\\n Just p -> getName p `elemNameSet` all_names\\n Nothing -> False\\n\\n pprInfo :: (TyThing, Fixity, [GHC.ClsInst], [GHC.FamInst], SDoc) -> SDoc\\n pprInfo (thing, fixity, cls_insts, fam_insts, docs)\\n = docs\\n $$ pprTyThingInContextLoc thing\\n $$ showFixity thing fixity\\n $$ vcat (map GHC.pprInstance cls_insts)\\n $$ vcat (map GHC.pprFamInst fam_insts)\\n\\n pprTyThingInContextLoc :: TyThing -> SDoc\\n pprTyThingInContextLoc tyThing\\n = showWithLoc (pprDefinedAt (getName tyThing))\\n (pprTyThingInContext showToHeader tyThing)\\n\\n showWithLoc :: SDoc -> SDoc -> SDoc\\n showWithLoc loc doc\\n = hang doc 2 (text \\"\\\\t--\\" <+> loc)\\n\\n showFixity :: TyThing -> Fixity -> SDoc\\n showFixity thing fixity\\n | fixity /= GHC.defaultFixity || isSymOcc (getOccName thing)\\n = ppr fixity <+> pprInfixName (GHC.getName thing)\\n | otherwise = empty\\n\\ndoKindCmd :: Bool -> DynFlags -> Text -> Ghc (Maybe Text)\\ndoKindCmd False df arg = do\\n let input = T.strip arg\\n (_, kind) <- typeKind False $ T.unpack input\\n let kindText = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n pure $ Just $ T.pack (showSDoc df kindText)\\ndoKindCmd True df arg = do\\n let input = T.strip arg\\n (ty, kind) <- typeKind True $ T.unpack input\\n let kindDoc = text (T.unpack input) <+> \\"::\\" <+> pprSigmaType kind\\n tyDoc = \\"=\\" <+> pprSigmaType ty\\n pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc)\\n\\ndoTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text)\\ndoTypeCmd dflags arg = do\\n let (emod, expr) = parseExprMode arg\\n ty <- GHC.exprType emod $ T.unpack expr\\n let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty\\n broken = T.any (\\\\c -> c == \'\\\\r\' || c == \'\\\\n\') rawType\\n pure $\\n Just $\\n if broken\\n then\\n T.pack $\\n showSDoc dflags $\\n text (T.unpack expr)\\n $$ nest 2 (\\"::\\" <+> pprSigmaType ty)\\n else expr <> \\" :: \\" <> rawType <> \\"\\\\n\\"\\n\\nparseExprMode :: Text -> (TcRnExprMode, T.Text)\\nparseExprMode rawArg = case T.break isSpace rawArg of\\n (\\"+d\\", rest) -> (TM_Default, T.strip rest)\\n _ -> (TM_Inst, rawArg)\\n\\ndata GhciLikeCmdException = GhciLikeCmdNotImplemented\\n { ghciCmdName :: Text\\n , ghciCmdArg :: Text\\n }\\n\\ninstance Show GhciLikeCmdException where\\n showsPrec _ GhciLikeCmdNotImplemented{..} =\\n showString \\"unknown command \'\\"\\n . showString (T.unpack ghciCmdName)\\n . showChar \'\\\\\'\'\\n\\ninstance E.Exception GhciLikeCmdException\\n\\n{-\\n>>> parseGhciLikeCmd (T.pack \\":kind! N + M + 1\\")\\nJust (\\"kind!\\",\\"N + M + 1\\")\\n>>> parseGhciLikeCmd (T.pack \\":kind a\\")\\nJust (\\"kind\\",\\"a\\")\\n-}\\nparseGhciLikeCmd :: Text -> Maybe (Text, Text)\\nparseGhciLikeCmd input = do\\n (\':\', rest) <- T.uncons $ T.stripStart input\\n pure $ second T.strip $ T.break isSpace rest\\n", "filetypes": ["haskell"]}}}' | |
| 2025-09-26 11:25:09,221 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'+xnjeqvr+sTea18+XNbITWDcGAkEyc2PAjPI1rKBe6c='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/ghcide/src/Development/IDE/Core/Shake.hs", "line_num": 1, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/ghcide/src/Development/IDE/Core/Shake.hs": {"contents": "-- Copyright (c) 2019 The DAML Authors. All rights reserved.\\n-- SPDX-License-Identifier: Apache-2.0\\n\\n{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DerivingStrategies #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE PackageImports #-}\\n{-# LANGUAGE RecursiveDo #-}\\n{-# LANGUAGE TypeFamilies #-}\\n\\n-- | A Shake implementation of the compiler service.\\n--\\n-- There are two primary locations where data lives, and both of\\n-- these contain much the same data:\\n--\\n-- * The Shake database (inside \'shakeDb\') stores a map of shake keys\\n-- to shake values. In our case, these are all of type \'Q\' to \'A\'.\\n-- During a single run all the values in the Shake database are consistent\\n-- so are used in conjunction with each other, e.g. in \'uses\'.\\n--\\n-- * The \'Values\' type stores a map of keys to values. These values are\\n-- always stored as real Haskell values, whereas Shake serialises all \'A\' values\\n-- between runs. To deserialise a Shake value, we just consult Values.\\nmodule Development.IDE.Core.Shake(\\n IdeState, shakeSessionInit, shakeExtras, shakeDb, rootDir,\\n ShakeExtras(..), getShakeExtras, getShakeExtrasRules,\\n KnownTargets(..), Target(..), toKnownFiles, unionKnownTargets, mkKnownTargets,\\n IdeRule, IdeResult,\\n GetModificationTime(GetModificationTime, GetModificationTime_, missingFileDiagnostics),\\n shakeOpen, shakeShut,\\n shakeEnqueue,\\n newSession,\\n use, useNoFile, uses, useWithStaleFast, useWithStaleFast\', delayedAction,\\n useWithSeparateFingerprintRule,\\n useWithSeparateFingerprintRule_,\\n FastResult(..),\\n use_, useNoFile_, uses_,\\n useWithStale, usesWithStale,\\n useWithStale_, usesWithStale_,\\n BadDependency(..),\\n RuleBody(..),\\n define, defineNoDiagnostics,\\n defineEarlyCutoff,\\n defineNoFile, defineEarlyCutOffNoFile,\\n getDiagnostics,\\n mRunLspT, mRunLspTCallback,\\n getHiddenDiagnostics,\\n IsIdeGlobal, addIdeGlobal, addIdeGlobalExtras, getIdeGlobalState, getIdeGlobalAction,\\n getIdeGlobalExtras,\\n getIdeOptions,\\n getIdeOptionsIO,\\n GlobalIdeOptions(..),\\n HLS.getClientConfig,\\n getPluginConfigAction,\\n knownTargets,\\n ideLogger,\\n actionLogger,\\n getVirtualFile,\\n FileVersion(..),\\n updatePositionMapping,\\n updatePositionMappingHelper,\\n deleteValue,\\n WithProgressFunc, WithIndefiniteProgressFunc,\\n ProgressEvent(..),\\n DelayedAction, mkDelayedAction,\\n IdeAction(..), runIdeAction,\\n mkUpdater,\\n -- Exposed for testing.\\n Q(..),\\n IndexQueue,\\n HieDb,\\n HieDbWriter(..),\\n addPersistentRule,\\n garbageCollectDirtyKeys,\\n garbageCollectDirtyKeysOlderThan,\\n Log(..),\\n VFSModified(..), getClientConfigAction,\\n ThreadQueue(..),\\n runWithSignal\\n ) where\\n\\nimport Control.Concurrent.Async\\nimport Control.Concurrent.STM\\nimport Control.Concurrent.STM.Stats (atomicallyNamed)\\nimport Control.Concurrent.Strict\\nimport Control.DeepSeq\\nimport Control.Exception.Extra hiding (bracket_)\\nimport Control.Lens ((%~), (&), (?~))\\nimport Control.Monad.Extra\\nimport Control.Monad.IO.Class\\nimport Control.Monad.Reader\\nimport Control.Monad.Trans.Maybe\\nimport Data.Aeson (Result (Success),\\n toJSON)\\nimport qualified Data.Aeson.Types as A\\nimport qualified Data.ByteString.Char8 as BS\\nimport qualified Data.ByteString.Char8 as BS8\\nimport Data.Coerce (coerce)\\nimport Data.Default\\nimport Data.Dynamic\\nimport Data.EnumMap.Strict (EnumMap)\\nimport qualified Data.EnumMap.Strict as EM\\nimport Data.Foldable (find, for_)\\nimport Data.Functor ((<&>))\\nimport Data.Functor.Identity\\nimport Data.Hashable\\nimport qualified Data.HashMap.Strict as HMap\\nimport Data.HashSet (HashSet)\\nimport qualified Data.HashSet as HSet\\nimport Data.List.Extra (foldl\', partition,\\n takeEnd)\\nimport qualified Data.Map.Strict as Map\\nimport Data.Maybe\\nimport qualified Data.SortedList as SL\\nimport Data.String (fromString)\\nimport qualified Data.Text as T\\nimport Data.Time\\nimport Data.Traversable\\nimport Data.Tuple.Extra\\nimport Data.Typeable\\nimport Data.Unique\\nimport Data.Vector (Vector)\\nimport qualified Data.Vector as Vector\\nimport Development.IDE.Core.Debouncer\\nimport Development.IDE.Core.FileUtils (getModTime)\\nimport Development.IDE.Core.PositionMapping\\nimport Development.IDE.Core.ProgressReporting\\nimport Development.IDE.Core.RuleTypes\\nimport Development.IDE.Types.Options as Options\\nimport qualified Language.LSP.Protocol.Message as LSP\\nimport qualified Language.LSP.Server as LSP\\n\\nimport Development.IDE.Core.Tracing\\nimport Development.IDE.Core.WorkerThread\\nimport Development.IDE.GHC.Compat (NameCache,\\n NameCacheUpdater,\\n initNameCache,\\n knownKeyNames)\\nimport Development.IDE.GHC.Orphans ()\\nimport Development.IDE.Graph hiding (ShakeValue,\\n action)\\nimport qualified Development.IDE.Graph as Shake\\nimport Development.IDE.Graph.Database (ShakeDatabase,\\n shakeGetBuildStep,\\n shakeGetDatabaseKeys,\\n shakeNewDatabase,\\n shakeProfileDatabase,\\n shakeRunDatabaseForKeys)\\nimport Development.IDE.Graph.Rule\\nimport Development.IDE.Types.Action\\nimport Development.IDE.Types.Diagnostics\\nimport Development.IDE.Types.Exports hiding (exportsMapSize)\\nimport qualified Development.IDE.Types.Exports as ExportsMap\\nimport Development.IDE.Types.KnownTargets\\nimport Development.IDE.Types.Location\\nimport Development.IDE.Types.Monitoring (Monitoring (..))\\nimport Development.IDE.Types.Shake\\nimport qualified Focus\\nimport GHC.Fingerprint\\nimport GHC.Stack (HasCallStack)\\nimport GHC.TypeLits (KnownSymbol)\\nimport HieDb.Types\\nimport Ide.Logger hiding (Priority)\\nimport qualified Ide.Logger as Logger\\nimport Ide.Plugin.Config\\nimport qualified Ide.PluginUtils as HLS\\nimport Ide.Types\\nimport qualified Language.LSP.Protocol.Lens as L\\nimport Language.LSP.Protocol.Message\\nimport Language.LSP.Protocol.Types\\nimport qualified Language.LSP.Protocol.Types as LSP\\nimport Language.LSP.VFS hiding (start)\\nimport qualified \\"list-t\\" ListT\\nimport OpenTelemetry.Eventlog hiding (addEvent)\\nimport qualified Prettyprinter as Pretty\\nimport qualified StmContainers.Map as STM\\nimport System.FilePath hiding (makeRelative)\\nimport System.IO.Unsafe (unsafePerformIO)\\nimport System.Time.Extra\\nimport UnliftIO (MonadUnliftIO (withRunInIO))\\n\\n\\ndata Log\\n = LogCreateHieDbExportsMapStart\\n | LogCreateHieDbExportsMapFinish !Int\\n | LogBuildSessionRestart !String ![DelayedActionInternal] !KeySet !Seconds !(Maybe FilePath)\\n | LogBuildSessionRestartTakingTooLong !Seconds\\n | LogDelayedAction !(DelayedAction ()) !Seconds\\n | LogBuildSessionFinish !(Maybe SomeException)\\n | LogDiagsDiffButNoLspEnv ![FileDiagnostic]\\n | LogDefineEarlyCutoffRuleNoDiagHasDiag !FileDiagnostic\\n | LogDefineEarlyCutoffRuleCustomNewnessHasDiag !FileDiagnostic\\n | LogCancelledAction !T.Text\\n | LogSessionInitialised\\n | LogLookupPersistentKey !T.Text\\n | LogShakeGarbageCollection !T.Text !Int !Seconds\\n -- * OfInterest Log messages\\n | LogSetFilesOfInterest ![(NormalizedFilePath, FileOfInterestStatus)]\\n deriving Show\\n\\ninstance Pretty Log where\\n pretty = \\\\case\\n LogCreateHieDbExportsMapStart ->\\n \\"Initializing exports map from hiedb\\"\\n LogCreateHieDbExportsMapFinish exportsMapSize ->\\n \\"Done initializing exports map from hiedb. Size:\\" <+> pretty exportsMapSize\\n LogBuildSessionRestart reason actionQueue keyBackLog abortDuration shakeProfilePath ->\\n vcat\\n [ \\"Restarting build session due to\\" <+> pretty reason\\n , \\"Action Queue:\\" <+> pretty (map actionName actionQueue)\\n , \\"Keys:\\" <+> pretty (map show $ toListKeySet keyBackLog)\\n , \\"Aborting previous build session took\\" <+> pretty (showDuration abortDuration) <+> pretty shakeProfilePath ]\\n LogBuildSessionRestartTakingTooLong seconds ->\\n \\"Build restart is taking too long (\\" <> pretty seconds <> \\" seconds)\\"\\n LogDelayedAction delayedAct seconds ->\\n hsep\\n [ \\"Finished:\\" <+> pretty (actionName delayedAct)\\n , \\"Took:\\" <+> pretty (showDuration seconds) ]\\n LogBuildSessionFinish e ->\\n vcat\\n [ \\"Finished build session\\"\\n , pretty (fmap displayException e) ]\\n LogDiagsDiffButNoLspEnv fileDiagnostics ->\\n \\"updateFileDiagnostics published different from new diagnostics - file diagnostics:\\"\\n <+> pretty (showDiagnosticsColored fileDiagnostics)\\n LogDefineEarlyCutoffRuleNoDiagHasDiag fileDiagnostic ->\\n \\"defineEarlyCutoff RuleNoDiagnostics - file diagnostic:\\"\\n <+> pretty (showDiagnosticsColored [fileDiagnostic])\\n LogDefineEarlyCutoffRuleCustomNewnessHasDiag fileDiagnostic ->\\n \\"defineEarlyCutoff RuleWithCustomNewnessCheck - file diagnostic:\\"\\n <+> pretty (showDiagnosticsColored [fileDiagnostic])\\n LogCancelledAction action ->\\n pretty action <+> \\"was cancelled\\"\\n LogSessionInitialised -> \\"Shake session initialized\\"\\n LogLookupPersistentKey key ->\\n \\"LOOKUP PERSISTENT FOR:\\" <+> pretty key\\n LogShakeGarbageCollection label number duration ->\\n pretty label <+> \\"of\\" <+> pretty number <+> \\"keys (took \\" <+> pretty (showDuration duration) <> \\")\\"\\n LogSetFilesOfInterest ofInterest ->\\n \\"Set files of interst to\\" <> Pretty.line\\n <> indent 4 (pretty $ fmap (first fromNormalizedFilePath) ofInterest)\\n\\n-- | We need to serialize writes to the database, so we send any function that\\n-- needs to write to the database over the channel, where it will be picked up by\\n-- a worker thread.\\ndata HieDbWriter\\n = HieDbWriter\\n { indexQueue :: IndexQueue\\n , indexPending :: TVar (HMap.HashMap NormalizedFilePath Fingerprint) -- ^ Avoid unnecessary/out of date indexing\\n , indexCompleted :: TVar Int -- ^ to report progress\\n , indexProgressReporting :: ProgressReporting\\n }\\n\\n-- | Actions to queue up on the index worker thread\\n-- The inner `(HieDb -> IO ()) -> IO ()` wraps `HieDb -> IO ()`\\n-- with (currently) retry functionality\\ntype IndexQueue = TQueue (((HieDb -> IO ()) -> IO ()) -> IO ())\\n\\ndata ThreadQueue = ThreadQueue {\\n tIndexQueue :: IndexQueue\\n , tRestartQueue :: TQueue (IO ())\\n , tLoaderQueue :: TQueue (IO ())\\n}\\n\\n-- Note [Semantic Tokens Cache Location]\\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\\n-- storing semantic tokens cache for each file in shakeExtras might\\n-- not be ideal, since it most used in LSP request handlers\\n-- instead of rules. We should consider moving it to a more\\n-- appropriate place in the future if we find one, store it for now.\\n\\n-- information we stash inside the shakeExtra field\\ndata ShakeExtras = ShakeExtras\\n { --eventer :: LSP.FromServerMessage -> IO ()\\n lspEnv :: Maybe (LSP.LanguageContextEnv Config)\\n ,debouncer :: Debouncer NormalizedUri\\n ,shakeRecorder :: Recorder (WithPriority Log)\\n ,idePlugins :: IdePlugins IdeState\\n ,globals :: TVar (HMap.HashMap TypeRep Dynamic)\\n -- ^ Registry of global state used by rules.\\n -- Small and immutable after startup, so not worth using an STM.Map.\\n ,state :: Values\\n ,diagnostics :: STMDiagnosticStore\\n ,hiddenDiagnostics :: STMDiagnosticStore\\n ,publishedDiagnostics :: STM.Map NormalizedUri [FileDiagnostic]\\n -- ^ This represents the set of diagnostics that we have published.\\n -- Due to debouncing not every change might get published.\\n\\n ,semanticTokensCache:: STM.Map NormalizedFilePath SemanticTokens\\n -- ^ Cache of last response of semantic tokens for each file,\\n -- so we can compute deltas for semantic tokens(SMethod_TextDocumentSemanticTokensFullDelta).\\n -- putting semantic tokens cache and id in shakeExtras might not be ideal\\n -- see Note [Semantic Tokens Cache Location]\\n ,semanticTokensId :: TVar Int\\n -- ^ semanticTokensId is used to generate unique ids for each lsp response of semantic tokens.\\n ,positionMapping :: STM.Map NormalizedUri (EnumMap Int32 (PositionDelta, PositionMapping))\\n -- ^ Map from a text document version to a PositionMapping that describes how to map\\n -- positions in a version of that document to positions in the latest version\\n -- First mapping is delta from previous version and second one is an\\n -- accumulation to the current version.\\n ,progress :: PerFileProgressReporting\\n ,ideTesting :: IdeTesting\\n -- ^ Whether to enable additional lsp messages used by the test suite for checking invariants\\n ,restartShakeSession\\n :: VFSModified\\n -> String\\n -> [DelayedAction ()]\\n -> IO [Key]\\n -> IO ()\\n ,ideNc :: NameCache\\n -- | A mapping of module name to known target (or candidate targets, if missing)\\n ,knownTargetsVar :: TVar (Hashed KnownTargets)\\n -- | A mapping of exported identifiers for local modules. Updated on kick\\n ,exportsMap :: TVar ExportsMap\\n -- | A work queue for actions added via \'runInShakeSession\'\\n ,actionQueue :: ActionQueue\\n ,clientCapabilities :: ClientCapabilities\\n , withHieDb :: WithHieDb -- ^ Use only to read.\\n , hiedbWriter :: HieDbWriter -- ^ use to write\\n , persistentKeys :: TVar (KeyMap GetStalePersistent)\\n -- ^ Registry for functions that compute/get \\"stale\\" results for the rule\\n -- (possibly from disk)\\n , vfsVar :: TVar VFS\\n -- ^ A snapshot of the current state of the virtual file system. Updated on shakeRestart\\n -- VFS state is managed by LSP. However, the state according to the lsp library may be newer than the state of the current session,\\n -- leaving us vulnerable to subtle race conditions. To avoid this, we take a snapshot of the state of the VFS on every\\n -- restart, so that the whole session sees a single consistent view of the VFS.\\n -- We don\'t need a STM.Map because we never update individual keys ourselves.\\n , defaultConfig :: Config\\n -- ^ Default HLS config, only relevant if the client does not provide any Config\\n , dirtyKeys :: TVar KeySet\\n -- ^ Set of dirty rule keys since the last Shake run\\n , restartQueue :: TQueue (IO ())\\n -- ^ Queue of restart actions to be run.\\n , loaderQueue :: TQueue (IO ())\\n -- ^ Queue of loader actions to be run.\\n }\\n\\ntype WithProgressFunc = forall a.\\n T.Text -> LSP.ProgressCancellable -> ((LSP.ProgressAmount -> IO ()) -> IO a) -> IO a\\ntype WithIndefiniteProgressFunc = forall a.\\n T.Text -> LSP.ProgressCancellable -> IO a -> IO a\\n\\ntype GetStalePersistent = NormalizedFilePath -> IdeAction (Maybe (Dynamic,PositionDelta,Maybe Int32))\\n\\ngetShakeExtras :: Action ShakeExtras\\ngetShakeExtras = do\\n -- Will fail the action with a pattern match failure, but be caught\\n Just x <- getShakeExtra @ShakeExtras\\n return x\\n\\ngetShakeExtrasRules :: Rules ShakeExtras\\ngetShakeExtrasRules = do\\n mExtras <- getShakeExtraRules @ShakeExtras\\n case mExtras of\\n Just x -> return x\\n -- This will actually crash HLS\\n Nothing -> liftIO $ fail \\"missing ShakeExtras\\"\\n\\n-- See Note [Client configuration in Rules]\\n-- | Returns the client configuration, creating a build dependency.\\n-- You should always use this function when accessing client configuration\\n-- from build rules.\\ngetClientConfigAction :: Action Config\\ngetClientConfigAction = do\\n ShakeExtras{lspEnv, idePlugins} <- getShakeExtras\\n currentConfig <- (`LSP.runLspT` LSP.getConfig) `traverse` lspEnv\\n mbVal <- unhashed <$> useNoFile_ GetClientSettings\\n let defValue = fromMaybe def currentConfig\\n case A.parse (parseConfig idePlugins defValue) <$> mbVal of\\n Just (Success c) -> return c\\n _ -> return defValue\\n\\ngetPluginConfigAction :: PluginId -> Action PluginConfig\\ngetPluginConfigAction plId = do\\n config <- getClientConfigAction\\n ShakeExtras{idePlugins = IdePlugins plugins} <- getShakeExtras\\n let plugin = fromMaybe (error $ \\"Plugin not found: \\" <> show plId) $\\n find (\\\\p -> pluginId p == plId) plugins\\n return $ HLS.configForPlugin config plugin\\n\\n-- | Register a function that will be called to get the \\"stale\\" result of a rule, possibly from disk\\n-- This is called when we don\'t already have a result, or computing the rule failed.\\n-- The result of this function will always be marked as \'stale\', and a \'proper\' rebuild of the rule will\\n-- be queued if the rule hasn\'t run before.\\naddPersistentRule :: IdeRule k v => k -> (NormalizedFilePath -> IdeAction (Maybe (v,PositionDelta,Maybe Int32))) -> Rules ()\\naddPersistentRule k getVal = do\\n ShakeExtras{persistentKeys} <- getShakeExtrasRules\\n void $ liftIO $ atomically $ modifyTVar\' persistentKeys $ insertKeyMap (newKey k) (fmap (fmap (first3 toDyn)) . getVal)\\n\\nclass Typeable a => IsIdeGlobal a where\\n\\n-- | Read a virtual file from the current snapshot\\ngetVirtualFile :: NormalizedFilePath -> Action (Maybe VirtualFile)\\ngetVirtualFile nf = do\\n vfs <- fmap _vfsMap . liftIO . readTVarIO . vfsVar =<< getShakeExtras\\n pure $! Map.lookup (filePathToUri\' nf) vfs -- Don\'t leak a reference to the entire map\\n\\n-- Take a snapshot of the current LSP VFS\\nvfsSnapshot :: Maybe (LSP.LanguageContextEnv a) -> IO VFS\\nvfsSnapshot Nothing = pure $ VFS mempty\\nvfsSnapshot (Just lspEnv) = LSP.runLspT lspEnv LSP.getVirtualFiles\\n\\n\\naddIdeGlobal :: IsIdeGlobal a => a -> Rules ()\\naddIdeGlobal x = do\\n extras <- getShakeExtrasRules\\n liftIO $ addIdeGlobalExtras extras x\\n\\naddIdeGlobalExtras :: IsIdeGlobal a => ShakeExtras -> a -> IO ()\\naddIdeGlobalExtras ShakeExtras{globals} x@(typeOf -> ty) =\\n void $ liftIO $ atomically $ modifyTVar\' globals $ \\\\mp -> case HMap.lookup ty mp of\\n Just _ -> error $ \\"Internal error, addIdeGlobalExtras, got the same type twice for \\" ++ show ty\\n Nothing -> HMap.insert ty (toDyn x) mp\\n\\ngetIdeGlobalExtras :: forall a . (HasCallStack, IsIdeGlobal a) => ShakeExtras -> IO a\\ngetIdeGlobalExtras ShakeExtras{globals} = do\\n let typ = typeRep (Proxy :: Proxy a)\\n x <- HMap.lookup (typeRep (Proxy :: Proxy a)) <$> readTVarIO globals\\n case x of\\n Just y\\n | Just z <- fromDynamic y -> pure z\\n | otherwise -> errorIO $ \\"Internal error, getIdeGlobalExtras, wrong type for \\" ++ show typ ++ \\" (got \\" ++ show (dynTypeRep y) ++ \\")\\"\\n Nothing -> errorIO $ \\"Internal error, getIdeGlobalExtras, no entry for \\" ++ show typ\\n\\ngetIdeGlobalAction :: forall a . (HasCallStack, IsIdeGlobal a) => Action a\\ngetIdeGlobalAction = liftIO . getIdeGlobalExtras =<< getShakeExtras\\n\\ngetIdeGlobalState :: forall a . IsIdeGlobal a => IdeState -> IO a\\ngetIdeGlobalState = getIdeGlobalExtras . shakeExtras\\n\\nnewtype GlobalIdeOptions = GlobalIdeOptions IdeOptions\\ninstance IsIdeGlobal GlobalIdeOptions\\n\\ngetIdeOptions :: Action IdeOptions\\ngetIdeOptions = do\\n GlobalIdeOptions x <- getIdeGlobalAction\\n mbEnv <- lspEnv <$> getShakeExtras\\n case mbEnv of\\n Nothing -> return x\\n Just env -> do\\n config <- liftIO $ LSP.runLspT env HLS.getClientConfig\\n return x{optCheckProject = pure $ checkProject config,\\n optCheckParents = pure $ checkParents config\\n }\\n\\ngetIdeOptionsIO :: ShakeExtras -> IO IdeOptions\\ngetIdeOptionsIO ide = do\\n GlobalIdeOptions x <- getIdeGlobalExtras ide\\n return x\\n\\n-- | Return the most recent, potentially stale, value and a PositionMapping\\n-- for the version of that value.\\nlastValueIO :: IdeRule k v => ShakeExtras -> k -> NormalizedFilePath -> IO (Maybe (v, PositionMapping))\\nlastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do\\n\\n let readPersistent\\n | IdeTesting testing <- ideTesting s -- Don\'t read stale persistent values in tests\\n , testing = pure Nothing\\n | otherwise = do\\n pmap <- readTVarIO persistentKeys\\n mv <- runMaybeT $ do\\n liftIO $ logWith (shakeRecorder s) Debug $ LogLookupPersistentKey (T.pack $ show k)\\n f <- MaybeT $ pure $ lookupKeyMap (newKey k) pmap\\n (dv,del,ver) <- MaybeT $ runIdeAction \\"lastValueIO\\" s $ f file\\n MaybeT $ pure $ (,del,ver) <$> fromDynamic dv\\n case mv of\\n Nothing -> atomicallyNamed \\"lastValueIO 1\\" $ do\\n STM.focus (Focus.alter (alterValue $ Failed True)) (toKey k file) state\\n return Nothing\\n Just (v,del,mbVer) -> do\\n actual_version <- case mbVer of\\n Just ver -> pure (Just $ VFSVersion ver)\\n Nothing -> (Just . ModificationTime <$> getModTime (fromNormalizedFilePath file))\\n `catch` (\\\\(_ :: IOException) -> pure Nothing)\\n atomicallyNamed \\"lastValueIO 2\\" $ do\\n STM.focus (Focus.alter (alterValue $ Stale (Just del) actual_version (toDyn v))) (toKey k file) state\\n Just . (v,) . addOldDelta del <$> mappingForVersion positionMapping file actual_version\\n\\n -- We got a new stale value from the persistent rule, insert it in the map without affecting diagnostics\\n alterValue new Nothing = Just (ValueWithDiagnostics new mempty) -- If it wasn\'t in the map, give it empty diagnostics\\n alterValue new (Just old@(ValueWithDiagnostics val diags)) = Just $ case val of\\n -- Old failed, we can update it preserving diagnostics\\n Failed{} -> ValueWithDiagnostics new diags\\n -- Something already succeeded before, leave it alone\\n _ -> old\\n\\n atomicallyNamed \\"lastValueIO 4\\" (STM.lookup (toKey k file) state) >>= \\\\case\\n Nothing -> readPersistent\\n Just (ValueWithDiagnostics value _) -> case value of\\n Succeeded ver (fromDynamic -> Just v) ->\\n atomicallyNamed \\"lastValueIO 5\\" $ Just . (v,) <$> mappingForVersion positionMapping file ver\\n Stale del ver (fromDynamic -> Just v) ->\\n atomicallyNamed \\"lastValueIO 6\\" $ Just . (v,) . maybe id addOldDelta del <$> mappingForVersion positionMapping file ver\\n Failed p | not p -> readPersistent\\n _ -> pure Nothing\\n\\n-- | Return the most recent, potentially stale, value and a PositionMapping\\n-- for the version of that value.\\nlastValue :: IdeRule k v => k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))\\nlastValue key file = do\\n s <- getShakeExtras\\n liftIO $ lastValueIO s key file\\n\\nmappingForVersion\\n :: STM.Map NormalizedUri (EnumMap Int32 (a, PositionMapping))\\n -> NormalizedFilePath\\n -> Maybe FileVersion\\n -> STM PositionMapping\\nmappingForVersion allMappings file (Just (VFSVersion ver)) = do\\n mapping <- STM.lookup (filePathToUri\' file) allMappings\\n return $ maybe zeroMapping snd $ EM.lookup ver =<< mapping\\nmappingForVersion _ _ _ = pure zeroMapping\\n\\ntype IdeRule k v =\\n ( Shake.RuleResult k ~ v\\n , Shake.ShakeValue k\\n , Show v\\n , Typeable v\\n , NFData v\\n )\\n\\n-- | A live Shake session with the ability to enqueue Actions for running.\\n-- Keeps the \'ShakeDatabase\' open, so at most one \'ShakeSession\' per database.\\nnewtype ShakeSession = ShakeSession\\n { cancelShakeSession :: IO ()\\n -- ^ Closes the Shake session\\n }\\n\\n-- Note [Root Directory]\\n-- ~~~~~~~~~~~~~~~~~~~~~\\n-- We keep track of the root directory explicitly, which is the directory of the project root.\\n-- We might be setting it via these options with decreasing priority:\\n--\\n-- 1. from LSP workspace root, `resRootPath` in `LanguageContextEnv`.\\n-- 2. command line (--cwd)\\n-- 3. default to the current directory.\\n--\\n-- Using `getCurrentDirectory` makes it more difficult to run the tests, as we spawn one thread of HLS per test case.\\n-- If we modify the global Variable CWD, via `setCurrentDirectory`, all other test threads are suddenly affected,\\n-- forcing us to run all integration tests sequentially.\\n--\\n-- Also, there might be a race condition if we depend on the current directory, as some plugin might change it.\\n-- e.g. stylish\'s `loadConfig`. https://github.com/haskell/haskell-language-server/issues/4234\\n--\\n-- But according to https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#workspace_workspaceFolders\\n-- The root dir is deprecated, that means we should cleanup dependency on the project root(Or $CWD) thing gradually,\\n-- so multi-workspaces can actually be supported when we use absolute path everywhere(might also need some high level design).\\n-- That might not be possible unless we have everything adapted to it, like \'hlint\' and \'evaluation of template haskell\'.\\n-- But we should still be working towards the goal.\\n--\\n-- We can drop it in the future once:\\n-- 1. We can get rid all the usages of root directory in the codebase.\\n-- 2. LSP version we support actually removes the root directory from the protocol.\\n--\\n\\n-- | A Shake database plus persistent store. Can be thought of as storing\\n-- mappings from @(FilePath, k)@ to @RuleResult k@.\\ndata IdeState = IdeState\\n {shakeDb :: ShakeDatabase\\n ,shakeSession :: MVar ShakeSession\\n ,shakeExtras :: ShakeExtras\\n ,shakeDatabaseProfile :: ShakeDatabase -> IO (Maybe FilePath)\\n ,stopMonitoring :: IO ()\\n -- | See Note [Root Directory]\\n ,rootDir :: FilePath\\n }\\n\\n\\n\\n-- This is debugging code that generates a series of profiles, if the Boolean is true\\nshakeDatabaseProfileIO :: Maybe FilePath -> IO(ShakeDatabase -> IO (Maybe FilePath))\\nshakeDatabaseProfileIO mbProfileDir = do\\n profileStartTime <- formatTime defaultTimeLocale \\"%Y%m%d-%H%M%S\\" <$> getCurrentTime\\n profileCounter <- newVar (0::Int)\\n return $ \\\\shakeDb ->\\n for mbProfileDir $ \\\\dir -> do\\n count <- modifyVar profileCounter $ \\\\x -> let !y = x+1 in return (y,y)\\n let file = \\"ide-\\" ++ profileStartTime ++ \\"-\\" ++ takeEnd 5 (\\"0000\\" ++ show count) <.> \\"html\\"\\n shakeProfileDatabase shakeDb $ dir </> file\\n return (dir </> file)\\n\\nsetValues :: IdeRule k v\\n => Values\\n -> k\\n -> NormalizedFilePath\\n -> Value v\\n -> Vector FileDiagnostic\\n -> STM ()\\nsetValues state key file val diags =\\n STM.insert (ValueWithDiagnostics (fmap toDyn val) diags) (toKey key file) state\\n\\n\\n-- | Delete the value stored for a given ide build key\\n-- and return the key that was deleted.\\ndeleteValue\\n :: Shake.ShakeValue k\\n => ShakeExtras\\n -> k\\n -> NormalizedFilePath\\n -> STM [Key]\\ndeleteValue ShakeExtras{state} key file = do\\n STM.delete (toKey key file) state\\n return [toKey key file]\\n\\n\\n-- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value.\\ngetValues ::\\n forall k v.\\n IdeRule k v =>\\n Values ->\\n k ->\\n NormalizedFilePath ->\\n STM (Maybe (Value v, Vector FileDiagnostic))\\ngetValues state key file = do\\n STM.lookup (toKey key file) state >>= \\\\case\\n Nothing -> pure Nothing\\n Just (ValueWithDiagnostics v diagsV) -> do\\n let !r = seqValue $ fmap (fromJust . fromDynamic @v) v\\n !res = (r,diagsV)\\n -- Force to make sure we do not retain a reference to the HashMap\\n -- and we blow up immediately if the fromJust should fail\\n -- (which would be an internal error).\\n return $ Just res\\n\\n-- | Get all the files in the project\\nknownTargets :: Action (Hashed KnownTargets)\\nknownTargets = do\\n ShakeExtras{knownTargetsVar} <- getShakeExtras\\n liftIO $ readTVarIO knownTargetsVar\\n\\n-- | Seq the result stored in the Shake value. This only\\n-- evaluates the value to WHNF not NF. We take care of the latter\\n-- elsewhere and doing it twice is expensive.\\nseqValue :: Value v -> Value v\\nseqValue val = case val of\\n Succeeded ver v -> rnf ver `seq` v `seq` val\\n Stale d ver v -> rnf d `seq` rnf ver `seq` v `seq` val\\n Failed _ -> val\\n\\n-- | Open a \'IdeState\', should be shut using \'shakeShut\'.\\nshakeOpen :: Recorder (WithPriority Log)\\n -> Maybe (LSP.LanguageContextEnv Config)\\n -> Config\\n -> IdePlugins IdeState\\n -> Debouncer NormalizedUri\\n -> Maybe FilePath\\n -> IdeReportProgress\\n -> IdeTesting\\n -> WithHieDb\\n -> ThreadQueue\\n -> ShakeOptions\\n -> Monitoring\\n -> Rules ()\\n -> FilePath\\n -- ^ Root directory, this one might be picking up from `LanguageContextEnv`\'s `resRootPath`\\n -- , see Note [Root Directory]\\n -> IO IdeState\\nshakeOpen recorder lspEnv defaultConfig idePlugins debouncer\\n shakeProfileDir (IdeReportProgress reportProgress)\\n ideTesting\\n withHieDb threadQueue opts monitoring rules rootDir = mdo\\n -- see Note [Serializing runs in separate thread]\\n let indexQueue = tIndexQueue threadQueue\\n restartQueue = tRestartQueue threadQueue\\n loaderQueue = tLoaderQueue threadQueue\\n\\n ideNc <- initNameCache \'r\' knownKeyNames\\n shakeExtras <- do\\n globals <- newTVarIO HMap.empty\\n state <- STM.newIO\\n diagnostics <- STM.newIO\\n hiddenDiagnostics <- STM.newIO\\n publishedDiagnostics <- STM.newIO\\n semanticTokensCache <- STM.newIO\\n positionMapping <- STM.newIO\\n knownTargetsVar <- newTVarIO $ hashed emptyKnownTargets\\n let restartShakeSession = shakeRestart recorder ideState\\n persistentKeys <- newTVarIO mempty\\n indexPending <- newTVarIO HMap.empty\\n indexCompleted <- newTVarIO 0\\n semanticTokensId <- newTVarIO 0\\n indexProgressReporting <- progressReportingNoTrace\\n (liftM2 (+) (length <$> readTVar indexPending) (readTVar indexCompleted))\\n (readTVar indexCompleted)\\n lspEnv \\"Indexing\\" optProgressStyle\\n let hiedbWriter = HieDbWriter{..}\\n exportsMap <- newTVarIO mempty\\n -- lazily initialize the exports map with the contents of the hiedb\\n -- TODO: exceptions can be swallowed here?\\n _ <- async $ do\\n logWith recorder Debug LogCreateHieDbExportsMapStart\\n em <- createExportsMapHieDb withHieDb\\n atomically $ modifyTVar\' exportsMap (<> em)\\n logWith recorder Debug $ LogCreateHieDbExportsMapFinish (ExportsMap.size em)\\n\\n progress <-\\n if reportProgress\\n then progressReporting lspEnv \\"Processing\\" optProgressStyle\\n else noPerFileProgressReporting\\n actionQueue <- newQueue\\n\\n let clientCapabilities = maybe def LSP.resClientCapabilities lspEnv\\n dirtyKeys <- newTVarIO mempty\\n -- Take one VFS snapshot at the start\\n vfsVar <- newTVarIO =<< vfsSnapshot lspEnv\\n pure ShakeExtras{shakeRecorder = recorder, ..}\\n shakeDb <-\\n shakeNewDatabase\\n opts { shakeExtra = newShakeExtra shakeExtras }\\n rules\\n shakeSession <- newEmptyMVar\\n shakeDatabaseProfile <- shakeDatabaseProfileIO shakeProfileDir\\n\\n IdeOptions\\n { optProgressStyle\\n , optCheckParents\\n } <- getIdeOptionsIO shakeExtras\\n\\n checkParents <- optCheckParents\\n\\n -- monitoring\\n let readValuesCounter = fromIntegral . countRelevantKeys checkParents <$> getStateKeys shakeExtras\\n readDirtyKeys = fromIntegral . countRelevantKeys checkParents . toListKeySet <$> readTVarIO(dirtyKeys shakeExtras)\\n readIndexPending = fromIntegral . HMap.size <$> readTVarIO (indexPending $ hiedbWriter shakeExtras)\\n readExportsMap = fromIntegral . ExportsMap.exportsMapSize <$> readTVarIO (exportsMap shakeExtras)\\n readDatabaseCount = fromIntegral . countRelevantKeys checkParents . map fst <$> shakeGetDatabaseKeys shakeDb\\n readDatabaseStep = fromIntegral <$> shakeGetBuildStep shakeDb\\n\\n registerGauge monitoring \\"ghcide.values_count\\" readValuesCounter\\n registerGauge monitoring \\"ghcide.dirty_keys_count\\" readDirtyKeys\\n registerGauge monitoring \\"ghcide.indexing_pending_count\\" readIndexPending\\n registerGauge monitoring \\"ghcide.exports_map_count\\" readExportsMap\\n registerGauge monitoring \\"ghcide.database_count\\" readDatabaseCount\\n registerCounter monitoring \\"ghcide.num_builds\\" readDatabaseStep\\n\\n stopMonitoring <- start monitoring\\n\\n let ideState = IdeState{..}\\n return ideState\\n\\n\\ngetStateKeys :: ShakeExtras -> IO [Key]\\ngetStateKeys = (fmap.fmap) fst . atomically . ListT.toList . STM.listT . state\\n\\n-- | Must be called in the \'Initialized\' handler and only once\\nshakeSessionInit :: Recorder (WithPriority Log) -> IdeState -> IO ()\\nshakeSessionInit recorder IdeState{..} = do\\n -- Take a snapshot of the VFS - it should be empty as we\'ve received no notifications\\n -- till now, but it can\'t hurt to be in sync with the `lsp` library.\\n vfs <- vfsSnapshot (lspEnv shakeExtras)\\n initSession <- newSession recorder shakeExtras (VFSModified vfs) shakeDb [] \\"shakeSessionInit\\"\\n putMVar shakeSession initSession\\n logWith recorder Debug LogSessionInitialised\\n\\nshakeShut :: IdeState -> IO ()\\nshakeShut IdeState{..} = do\\n runner <- tryReadMVar shakeSession\\n -- Shake gets unhappy if you try to close when there is a running\\n -- request so we first abort that.\\n for_ runner cancelShakeSession\\n void $ shakeDatabaseProfile shakeDb\\n progressStop $ progress shakeExtras\\n progressStop $ indexProgressReporting $ hiedbWriter shakeExtras\\n stopMonitoring\\n\\n\\n-- | This is a variant of withMVar where the first argument is run unmasked and if it throws\\n-- an exception, the previous value is restored while the second argument is executed masked.\\nwithMVar\' :: MVar a -> (a -> IO b) -> (b -> IO (a, c)) -> IO c\\nwithMVar\' var unmasked masked = uninterruptibleMask $ \\\\restore -> do\\n a <- takeMVar var\\n b <- restore (unmasked a) `onException` putMVar var a\\n (a\', c) <- masked b\\n putMVar var a\'\\n pure c\\n\\n\\nmkDelayedAction :: String -> Logger.Priority -> Action a -> DelayedAction a\\nmkDelayedAction = DelayedAction Nothing\\n\\n-- | These actions are run asynchronously after the current action is\\n-- finished running. For example, to trigger a key build after a rule\\n-- has already finished as is the case with useWithStaleFast\\ndelayedAction :: DelayedAction a -> IdeAction (IO a)\\ndelayedAction a = do\\n extras <- ask\\n liftIO $ shakeEnqueue extras a\\n\\n\\n-- | Restart the current \'ShakeSession\' with the given system actions.\\n-- Any actions running in the current session will be aborted,\\n-- but actions added via \'shakeEnqueue\' will be requeued.\\nshakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> IO [Key] -> IO ()\\nshakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession =\\n void $ awaitRunInThread (restartQueue shakeExtras) $ do\\n withMVar\'\\n shakeSession\\n (\\\\runner -> do\\n (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner\\n keys <- ioActionBetweenShakeSession\\n -- it is every important to update the dirty keys after we enter the critical section\\n -- see Note [Housekeeping rule cache and dirty key outside of hls-graph]\\n atomically $ modifyTVar\' (dirtyKeys shakeExtras) $ \\\\x -> foldl\' (flip insertKeySet) x keys\\n res <- shakeDatabaseProfile shakeDb\\n backlog <- readTVarIO $ dirtyKeys shakeExtras\\n queue <- atomicallyNamed \\"actionQueue - peek\\" $ peekInProgress $ actionQueue shakeExtras\\n\\n -- this log is required by tests\\n logWith recorder Debug $ LogBuildSessionRestart reason queue backlog stopTime res\\n )\\n -- It is crucial to be masked here, otherwise we can get killed\\n -- between spawning the new thread and updating shakeSession.\\n -- See https://github.com/haskell/ghcide/issues/79\\n (\\\\() -> do\\n (,()) <$> newSession recorder shakeExtras vfs shakeDb acts reason)\\n where\\n logErrorAfter :: Seconds -> IO () -> IO ()\\n logErrorAfter seconds action = flip withAsync (const action) $ do\\n sleep seconds\\n logWith recorder Error (LogBuildSessionRestartTakingTooLong seconds)\\n\\n-- | Enqueue an action in the existing \'ShakeSession\'.\\n-- Returns a computation to block until the action is run, propagating exceptions.\\n-- Assumes a \'ShakeSession\' is available.\\n--\\n-- Appropriate for user actions other than edits.\\nshakeEnqueue :: ShakeExtras -> DelayedAction a -> IO (IO a)\\nshakeEnqueue ShakeExtras{actionQueue, shakeRecorder} act = do\\n (b, dai) <- instantiateDelayedAction act\\n atomicallyNamed \\"actionQueue - push\\" $ pushQueue dai actionQueue\\n let wait\' barrier =\\n waitBarrier barrier `catches`\\n [ Handler(\\\\BlockedIndefinitelyOnMVar ->\\n fail $ \\"internal bug: forever blocked on MVar for \\" <>\\n actionName act)\\n , Handler (\\\\e@AsyncCancelled -> do\\n logWith shakeRecorder Debug $ LogCancelledAction (T.pack $ actionName act)\\n\\n atomicallyNamed \\"actionQueue - abort\\" $ abortQueue dai actionQueue\\n throw e)\\n ]\\n return (wait\' b >>= either throwIO return)\\n\\ndata VFSModified = VFSUnmodified | VFSModified !VFS\\n\\n-- | Set up a new \'ShakeSession\' with a set of initial actions\\n-- Will crash if there is an existing \'ShakeSession\' running.\\nnewSession\\n :: Recorder (WithPriority Log)\\n -> ShakeExtras\\n -> VFSModified\\n -> ShakeDatabase\\n -> [DelayedActionInternal]\\n -> String\\n -> IO ShakeSession\\nnewSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do\\n\\n -- Take a new VFS snapshot\\n case vfsMod of\\n VFSUnmodified -> pure ()\\n VFSModified vfs -> atomically $ writeTVar vfsVar vfs\\n\\n IdeOptions{optRunSubset} <- getIdeOptionsIO extras\\n reenqueued <- atomicallyNamed \\"actionQueue - peek\\" $ peekInProgress actionQueue\\n allPendingKeys <-\\n if optRunSubset\\n then Just <$> readTVarIO dirtyKeys\\n else return Nothing\\n let\\n -- A daemon-like action used to inject additional work\\n -- Runs actions from the work queue sequentially\\n pumpActionThread otSpan = do\\n d <- liftIO $ atomicallyNamed \\"action queue - pop\\" $ popQueue actionQueue\\n actionFork (run otSpan d) $ \\\\_ -> pumpActionThread otSpan\\n\\n -- TODO figure out how to thread the otSpan into defineEarlyCutoff\\n run _otSpan d = do\\n start <- liftIO offsetTime\\n getAction d\\n liftIO $ atomicallyNamed \\"actionQueue - done\\" $ doneQueue d actionQueue\\n runTime <- liftIO start\\n logWith recorder (actionPriority d) $ LogDelayedAction d runTime\\n\\n -- The inferred type signature doesn\'t work in ghc >= 9.0.1\\n workRun :: (forall b. IO b -> IO b) -> IO (IO ())\\n workRun restore = withSpan \\"Shake session\\" $ \\\\otSpan -> do\\n setTag otSpan \\"reason\\" (fromString reason)\\n setTag otSpan \\"queue\\" (fromString $ unlines $ map actionName reenqueued)\\n whenJust allPendingKeys $ \\\\kk -> setTag otSpan \\"keys\\" (BS8.pack $ unlines $ map show $ toListKeySet kk)\\n let keysActs = pumpActionThread otSpan : map (run otSpan) (reenqueued ++ acts)\\n res <- try @SomeException $\\n restore $ shakeRunDatabaseForKeys (toListKeySet <$> allPendingKeys) shakeDb keysActs\\n return $ do\\n let exception =\\n case res of\\n Left e -> Just e\\n _ -> Nothing\\n logWith recorder Debug $ LogBuildSessionFinish exception\\n\\n -- Do the work in a background thread\\n workThread <- asyncWithUnmask workRun\\n\\n -- run the wrap up in a separate thread since it contains interruptible\\n -- commands (and we are not using uninterruptible mask)\\n -- TODO: can possibly swallow exceptions?\\n _ <- async $ join $ wait workThread\\n\\n -- Cancelling is required to flush the Shake database when either\\n -- the filesystem or the Ghc configuration have changed\\n let cancelShakeSession :: IO ()\\n cancelShakeSession = cancel workThread\\n\\n pure (ShakeSession{..})\\n\\ninstantiateDelayedAction\\n :: DelayedAction a\\n -> IO (Barrier (Either SomeException a), DelayedActionInternal)\\ninstantiateDelayedAction (DelayedAction _ s p a) = do\\n u <- newUnique\\n b <- newBarrier\\n let a\' = do\\n -- work gets reenqueued when the Shake session is restarted\\n -- it can happen that a work item finished just as it was reenqueued\\n -- in that case, skipping the work is fine\\n alreadyDone <- liftIO $ isJust <$> waitBarrierMaybe b\\n unless alreadyDone $ do\\n x <- actionCatch @SomeException (Right <$> a) (pure . Left)\\n -- ignore exceptions if the barrier has been filled concurrently\\n liftIO $ void $ try @SomeException $ signalBarrier b x\\n d\' = DelayedAction (Just u) s p a\'\\n return (b, d\')\\n\\ngetDiagnostics :: IdeState -> STM [FileDiagnostic]\\ngetDiagnostics IdeState{shakeExtras = ShakeExtras{diagnostics}} = do\\n getAllDiagnostics diagnostics\\n\\ngetHiddenDiagnostics :: IdeState -> STM [FileDiagnostic]\\ngetHiddenDiagnostics IdeState{shakeExtras = ShakeExtras{hiddenDiagnostics}} = do\\n getAllDiagnostics hiddenDiagnostics\\n\\n-- | Find and release old keys from the state Hashmap\\n-- For the record, there are other state sources that this process does not release:\\n-- * diagnostics store (normal, hidden and published)\\n-- * position mapping store\\n-- * indexing queue\\n-- * exports map\\ngarbageCollectDirtyKeys :: Action [Key]\\ngarbageCollectDirtyKeys = do\\n IdeOptions{optCheckParents} <- getIdeOptions\\n checkParents <- liftIO optCheckParents\\n garbageCollectDirtyKeysOlderThan 0 checkParents\\n\\ngarbageCollectDirtyKeysOlderThan :: Int -> CheckParents -> Action [Key]\\ngarbageCollectDirtyKeysOlderThan maxAge checkParents = otTracedGarbageCollection \\"dirty GC\\" $ do\\n dirtySet <- getDirtySet\\n garbageCollectKeys \\"dirty GC\\" maxAge checkParents dirtySet\\n\\ngarbageCollectKeys :: String -> Int -> CheckParents -> [(Key, Int)] -> Action [Key]\\ngarbageCollectKeys label maxAge checkParents agedKeys = do\\n start <- liftIO offsetTime\\n ShakeExtras{state, dirtyKeys, lspEnv, shakeRecorder, ideTesting} <- getShakeExtras\\n (n::Int, garbage) <- liftIO $\\n foldM (removeDirtyKey dirtyKeys state) (0,[]) agedKeys\\n t <- liftIO start\\n when (n>0) $ liftIO $ do\\n logWith shakeRecorder Debug $ LogShakeGarbageCollection (T.pack label) n t\\n when (coerce ideTesting) $ liftIO $ mRunLspT lspEnv $\\n LSP.sendNotification (SMethod_CustomMethod (Proxy @\\"ghcide/GC\\"))\\n (toJSON $ mapMaybe (fmap showKey . fromKeyType) garbage)\\n return garbage\\n\\n where\\n showKey = show . Q\\n removeDirtyKey dk values st@(!counter, keys) (k, age)\\n | age > maxAge\\n , Just (kt,_) <- fromKeyType k\\n , not(kt `HSet.member` preservedKeys checkParents)\\n = atomicallyNamed \\"GC\\" $ do\\n gotIt <- STM.focus (Focus.member <* Focus.delete) k values\\n when gotIt $\\n modifyTVar\' dk (insertKeySet k)\\n return $ if gotIt then (counter+1, k:keys) else st\\n | otherwise = pure st\\n\\ncountRelevantKeys :: CheckParents -> [Key] -> Int\\ncountRelevantKeys checkParents =\\n Prelude.length . filter (maybe False (not . (`HSet.member` preservedKeys checkParents) . fst) . fromKeyType)\\n\\npreservedKeys :: CheckParents -> HashSet TypeRep\\npreservedKeys checkParents = HSet.fromList $\\n -- always preserved\\n [ typeOf GetFileExists\\n , typeOf GetModificationTime\\n , typeOf IsFileOfInterest\\n , typeOf GhcSessionIO\\n , typeOf GetClientSettings\\n , typeOf AddWatchedFile\\n , typeOf GetKnownTargets\\n ]\\n ++ concat\\n -- preserved if CheckParents is enabled since we need to rebuild the ModuleGraph\\n [ [ typeOf GetModSummary\\n , typeOf GetModSummaryWithoutTimestamps\\n , typeOf GetLocatedImports\\n ]\\n | checkParents /= NeverCheck\\n ]\\n\\n-- | Define a new Rule without early cutoff\\ndefine\\n :: IdeRule k v\\n => Recorder (WithPriority Log) -> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()\\ndefine recorder op = defineEarlyCutoff recorder $ Rule $ \\\\k v -> (Nothing,) <$> op k v\\n\\ndefineNoDiagnostics\\n :: IdeRule k v\\n => Recorder (WithPriority Log) -> (k -> NormalizedFilePath -> Action (Maybe v)) -> Rules ()\\ndefineNoDiagnostics recorder op = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \\\\k v -> (Nothing,) <$> op k v\\n\\n-- | Request a Rule result if available\\nuse :: IdeRule k v\\n => k -> NormalizedFilePath -> Action (Maybe v)\\nuse key file = runIdentity <$> uses key (Identity file)\\n\\n-- | Request a Rule result, it not available return the last computed result, if any, which may be stale\\nuseWithStale :: IdeRule k v\\n => k -> NormalizedFilePath -> Action (Maybe (v, PositionMapping))\\nuseWithStale key file = runIdentity <$> usesWithStale key (Identity file)\\n\\n-- |Request a Rule result, it not available return the last computed result\\n-- which may be stale.\\n--\\n-- Throws an `BadDependency` exception which is caught by the rule system if\\n-- none available.\\n--\\n-- WARNING: Not suitable for PluginHandlers. Use `useWithStaleE` instead.\\nuseWithStale_ :: IdeRule k v\\n => k -> NormalizedFilePath -> Action (v, PositionMapping)\\nuseWithStale_ key file = runIdentity <$> usesWithStale_ key (Identity file)\\n\\n-- |Plural version of \'useWithStale_\'\\n--\\n-- Throws an `BadDependency` exception which is caught by the rule system if\\n-- none available.\\n--\\n-- WARNING: Not suitable for PluginHandlers.\\nusesWithStale_ :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> Action (f (v, PositionMapping))\\nusesWithStale_ key files = do\\n res <- usesWithStale key files\\n case sequence res of\\n Nothing -> liftIO $ throwIO $ BadDependency (show key)\\n Just v -> return v\\n\\n-- | IdeActions are used when we want to return a result immediately, even if it\\n-- is stale Useful for UI actions like hover, completion where we don\'t want to\\n-- block.\\n--\\n-- Run via \'runIdeAction\'.\\nnewtype IdeAction a = IdeAction { runIdeActionT :: (ReaderT ShakeExtras IO) a }\\n deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad, Semigroup)\\n\\nrunIdeAction :: String -> ShakeExtras -> IdeAction a -> IO a\\nrunIdeAction _herald s i = runReaderT (runIdeActionT i) s\\n\\naskShake :: IdeAction ShakeExtras\\naskShake = ask\\n\\n\\nmkUpdater :: NameCache -> NameCacheUpdater\\nmkUpdater = id\\n\\n-- | A (maybe) stale result now, and an up to date one later\\ndata FastResult a = FastResult { stale :: Maybe (a,PositionMapping), uptoDate :: IO (Maybe a) }\\n\\n-- | Lookup value in the database and return with the stale value immediately\\n-- Will queue an action to refresh the value.\\n-- Might block the first time the rule runs, but never blocks after that.\\nuseWithStaleFast :: IdeRule k v => k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))\\nuseWithStaleFast key file = stale <$> useWithStaleFast\' key file\\n\\n-- | Same as useWithStaleFast but lets you wait for an up to date result\\nuseWithStaleFast\' :: IdeRule k v => k -> NormalizedFilePath -> IdeAction (FastResult v)\\nuseWithStaleFast\' key file = do\\n -- This lookup directly looks up the key in the shake database and\\n -- returns the last value that was computed for this key without\\n -- checking freshness.\\n\\n -- Async trigger the key to be built anyway because we want to\\n -- keep updating the value in the key.\\n waitValue <- delayedAction $ mkDelayedAction (\\"C:\\" ++ show key ++ \\":\\" ++ fromNormalizedFilePath file) Debug $ use key file\\n\\n s@ShakeExtras{state} <- askShake\\n r <- liftIO $ atomicallyNamed \\"useStateFast\\" $ getValues state key file\\n liftIO $ case r of\\n -- block for the result if we haven\'t computed before\\n Nothing -> do\\n -- Check if we can get a stale value from disk\\n res <- lastValueIO s key file\\n case res of\\n Nothing -> do\\n a <- waitValue\\n pure $ FastResult ((,zeroMapping) <$> a) (pure a)\\n Just _ -> pure $ FastResult res waitValue\\n -- Otherwise, use the computed value even if it\'s out of date.\\n Just _ -> do\\n res <- lastValueIO s key file\\n pure $ FastResult res waitValue\\n\\nuseNoFile :: IdeRule k v => k -> Action (Maybe v)\\nuseNoFile key = use key emptyFilePath\\n\\n-- Requests a rule if available.\\n--\\n-- Throws an `BadDependency` exception which is caught by the rule system if\\n-- none available.\\n--\\n-- WARNING: Not suitable for PluginHandlers. Use `useE` instead.\\nuse_ :: IdeRule k v => k -> NormalizedFilePath -> Action v\\nuse_ key file = runIdentity <$> uses_ key (Identity file)\\n\\nuseNoFile_ :: IdeRule k v => k -> Action v\\nuseNoFile_ key = use_ key emptyFilePath\\n\\n-- |Plural version of `use_`\\n--\\n-- Throws an `BadDependency` exception which is caught by the rule system if\\n-- none available.\\n--\\n-- WARNING: Not suitable for PluginHandlers. Use `usesE` instead.\\nuses_ :: (Traversable f, IdeRule k v) => k -> f NormalizedFilePath -> Action (f v)\\nuses_ key files = do\\n res <- uses key files\\n case sequence res of\\n Nothing -> liftIO $ throwIO $ BadDependency (show key)\\n Just v -> return v\\n\\n-- | Plural version of \'use\'\\nuses :: (Traversable f, IdeRule k v)\\n => k -> f NormalizedFilePath -> Action (f (Maybe v))\\nuses key files = fmap (\\\\(A value) -> currentValue value) <$> apply (fmap (Q . (key,)) files)\\n\\n-- | Return the last computed result which might be stale.\\nusesWithStale :: (Traversable f, IdeRule k v)\\n => k -> f NormalizedFilePath -> Action (f (Maybe (v, PositionMapping)))\\nusesWithStale key files = do\\n _ <- apply (fmap (Q . (key,)) files)\\n -- We don\'t look at the result of the \'apply\' since \'lastValue\' will\\n -- return the most recent successfully computed value regardless of\\n -- whether the rule succeeded or not.\\n traverse (lastValue key) files\\n\\n-- we use separate fingerprint rules to trigger the rebuild of the rule\\nuseWithSeparateFingerprintRule\\n :: (IdeRule k v, IdeRule k1 Fingerprint)\\n => k1 -> k -> NormalizedFilePath -> Action (Maybe v)\\nuseWithSeparateFingerprintRule fingerKey key file = do\\n _ <- use fingerKey file\\n useWithoutDependency key emptyFilePath\\n\\n-- we use separate fingerprint rules to trigger the rebuild of the rule\\nuseWithSeparateFingerprintRule_\\n :: (IdeRule k v, IdeRule k1 Fingerprint)\\n => k1 -> k -> NormalizedFilePath -> Action v\\nuseWithSeparateFingerprintRule_ fingerKey key file = do\\n useWithSeparateFingerprintRule fingerKey key file >>= \\\\case\\n Just v -> return v\\n Nothing -> liftIO $ throwIO $ BadDependency (show key)\\n\\nuseWithoutDependency :: IdeRule k v\\n => k -> NormalizedFilePath -> Action (Maybe v)\\nuseWithoutDependency key file =\\n (\\\\(Identity (A value)) -> currentValue value) <$> applyWithoutDependency (Identity (Q (key, file)))\\n\\ndata RuleBody k v\\n = Rule (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, IdeResult v))\\n | RuleNoDiagnostics (k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v))\\n | RuleWithCustomNewnessCheck\\n { newnessCheck :: BS.ByteString -> BS.ByteString -> Bool\\n , build :: k -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe v)\\n }\\n | RuleWithOldValue (k -> NormalizedFilePath -> Value v -> Action (Maybe BS.ByteString, IdeResult v))\\n\\n-- | Define a new Rule with early cutoff\\ndefineEarlyCutoff\\n :: IdeRule k v\\n => Recorder (WithPriority Log)\\n -> RuleBody k v\\n -> Rules ()\\ndefineEarlyCutoff recorder (Rule op) = addRule $ \\\\(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ \\\\traceDiagnostics -> do\\n extras <- getShakeExtras\\n let diagnostics ver diags = do\\n traceDiagnostics diags\\n updateFileDiagnostics recorder file ver (newKey key) extras diags\\n defineEarlyCutoff\' diagnostics (==) key file old mode $ const $ op key file\\ndefineEarlyCutoff recorder (RuleNoDiagnostics op) = addRule $ \\\\(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ \\\\traceDiagnostics -> do\\n let diagnostics _ver diags = do\\n traceDiagnostics diags\\n mapM_ (logWith recorder Warning . LogDefineEarlyCutoffRuleNoDiagHasDiag) diags\\n defineEarlyCutoff\' diagnostics (==) key file old mode $ const $ second (mempty,) <$> op key file\\ndefineEarlyCutoff recorder RuleWithCustomNewnessCheck{..} =\\n addRule $ \\\\(Q (key, file)) (old :: Maybe BS.ByteString) mode ->\\n otTracedAction key file mode traceA $ \\\\ traceDiagnostics -> do\\n let diagnostics _ver diags = do\\n traceDiagnostics diags\\n mapM_ (logWith recorder Warning . LogDefineEarlyCutoffRuleCustomNewnessHasDiag) diags\\n defineEarlyCutoff\' diagnostics newnessCheck key file old mode $\\n const $ second (mempty,) <$> build key file\\ndefineEarlyCutoff recorder (RuleWithOldValue op) = addRule $ \\\\(Q (key, file)) (old :: Maybe BS.ByteString) mode -> otTracedAction key file mode traceA $ \\\\traceDiagnostics -> do\\n extras <- getShakeExtras\\n let diagnostics ver diags = do\\n traceDiagnostics diags\\n updateFileDiagnostics recorder file ver (newKey key) extras diags\\n defineEarlyCutoff\' diagnostics (==) key file old mode $ op key file\\n\\ndefineNoFile :: IdeRule k v => Recorder (WithPriority Log) -> (k -> Action v) -> Rules ()\\ndefineNoFile recorder f = defineNoDiagnostics recorder $ \\\\k file -> do\\n if file == emptyFilePath then do res <- f k; return (Just res) else\\n fail $ \\"Rule \\" ++ show k ++ \\" should always be called with the empty string for a file\\"\\n\\ndefineEarlyCutOffNoFile :: IdeRule k v => Recorder (WithPriority Log) -> (k -> Action (BS.ByteString, v)) -> Rules ()\\ndefineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \\\\k file -> do\\n if file == emptyFilePath then do (hashString, res) <- f k; return (Just hashString, Just res) else\\n fail $ \\"Rule \\" ++ show k ++ \\" should always be called with the empty string for a file\\"\\n\\ndefineEarlyCutoff\'\\n :: forall k v. IdeRule k v\\n => (Maybe Int32 -> [FileDiagnostic] -> Action ()) -- ^ update diagnostics\\n -- | compare current and previous for freshness\\n -> (BS.ByteString -> BS.ByteString -> Bool)\\n -> k\\n -> NormalizedFilePath\\n -> Maybe BS.ByteString\\n -> RunMode\\n -> (Value v -> Action (Maybe BS.ByteString, IdeResult v))\\n -> Action (RunResult (A (RuleResult k)))\\ndefineEarlyCutoff\' doDiagnostics cmp key file mbOld mode action = do\\n ShakeExtras{state, progress, dirtyKeys} <- getShakeExtras\\n options <- getIdeOptions\\n let trans g x = withRunInIO $ \\\\run -> g (run x)\\n (if optSkipProgress options key then id else trans (inProgress progress file)) $ do\\n val <- case mbOld of\\n Just old | mode == RunDependenciesSame -> do\\n mbValue <- liftIO $ atomicallyNamed \\"define - read 1\\" $ getValues state key file\\n case mbValue of\\n -- No changes in the dependencies and we have\\n -- an existing successful result.\\n Just (v@(Succeeded _ x), diags) -> do\\n ver <- estimateFileVersionUnsafely key (Just x) file\\n doDiagnostics (vfsVersion =<< ver) $ Vector.toList diags\\n return $ Just $ RunResult ChangedNothing old (A v) $ return ()\\n _ -> return Nothing\\n _ ->\\n -- assert that a \\"clean\\" rule is never a cache miss\\n -- as this is likely a bug in the dirty key tracking\\n assert (mode /= RunDependenciesSame) $ return Nothing\\n res <- case val of\\n Just res -> return res\\n Nothing -> do\\n staleV <- liftIO $ atomicallyNamed \\"define -read 3\\" $ getValues state key file <&> \\\\case\\n Nothing -> Failed False\\n Just (Succeeded ver v, _) -> Stale Nothing ver v\\n Just (Stale d ver v, _) -> Stale d ver v\\n Just (Failed b, _) -> Failed b\\n (mbBs, (diags, mbRes)) <- actionCatch\\n (do v <- action staleV; liftIO $ evaluate $ force v) $\\n \\\\(e :: SomeException) -> do\\n pure (Nothing, ([ideErrorText file (T.pack $ show (key, file) ++ show e) | not $ isBadDependency e],Nothing))\\n\\n ver <- estimateFileVersionUnsafely key mbRes file\\n (bs, res) <- case mbRes of\\n Nothing -> do\\n pure (toShakeValue ShakeStale mbBs, staleV)\\n Just v -> pure (maybe ShakeNoCutoff ShakeResult mbBs, Succeeded ver v)\\n doDiagnostics (vfsVersion =<< ver) diags\\n let eq = case (bs, fmap decodeShakeValue mbOld) of\\n (ShakeResult a, Just (ShakeResult b)) -> cmp a b\\n (ShakeStale a, Just (ShakeStale b)) -> cmp a b\\n -- If we do not have a previous result\\n -- or we got ShakeNoCutoff we always return False.\\n _ -> False\\n return $ RunResult\\n (if eq then ChangedRecomputeSame else ChangedRecomputeDiff)\\n (encodeShakeValue bs)\\n (A res) $ do\\n -- this hook needs to be run in the same transaction as the key is marked clean\\n -- see Note [Housekeeping rule cache and dirty key outside of hls-graph]\\n setValues state key file res (Vector.fromList diags)\\n modifyTVar\' dirtyKeys (deleteKeySet $ toKey key file)\\n return res\\n where\\n -- Highly unsafe helper to compute the version of a file\\n -- without creating a dependency on the GetModificationTime rule\\n -- (and without creating cycles in the build graph).\\n estimateFileVersionUnsafely\\n :: k\\n -> Maybe v\\n -> NormalizedFilePath\\n -> Action (Maybe FileVersion)\\n estimateFileVersionUnsafely _k v fp\\n | fp == emptyFilePath = pure Nothing\\n | Just Refl <- eqT @k @GetModificationTime = pure v\\n -- GetModificationTime depends on these rules, so avoid creating a cycle\\n | Just Refl <- eqT @k @AddWatchedFile = pure Nothing\\n | Just Refl <- eqT @k @IsFileOfInterest = pure Nothing\\n -- GetFileExists gets called for missing files\\n | Just Refl <- eqT @k @GetFileExists = pure Nothing\\n -- For all other rules - compute the version properly without:\\n -- * creating a dependency: If everything depends on GetModificationTime, we lose early cutoff\\n -- * creating bogus \\"file does not exists\\" diagnostics\\n | otherwise = useWithoutDependency (GetModificationTime_ False) fp\\n\\n-- Note [Housekeeping rule cache and dirty key outside of hls-graph]\\n-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\\n-- Hls-graph contains its own internal running state for each key in the shakeDatabase.\\n-- ShakeExtras contains `state` field (rule result cache) and `dirtyKeys` (keys that became\\n-- dirty in between build sessions) that is not visible to the hls-graph\\n-- Essentially, we need to keep the rule cache and dirty key and hls-graph\'s internal state\\n-- in sync.\\n\\n-- 1. A dirty key collected in a session should not be removed from dirty keys in the same session.\\n-- Since if we clean out the dirty key in the same session,\\n-- 1.1. we will lose the chance to dirty its reverse dependencies. Since it only happens during session restart.\\n-- 1.2. a key might be marked as dirty in ShakeExtras while it\'s being recomputed by hls-graph which could lead to it\'s premature removal from dirtyKeys.\\n-- See issue https://github.com/haskell/haskell-language-server/issues/4093 for more details.\\n\\n-- 2. When a key is marked clean in the hls-graph\'s internal running\\n-- state, the rule cache and dirty keys are updated in the same transaction.\\n-- otherwise, some situations like the following can happen:\\n-- thread 1: hls-graph session run a key\\n-- thread 1: defineEarlyCutoff\' run the action for the key\\n-- thread 1: the action is done, rule cache and dirty key are updated\\n-- thread 2: we restart the hls-graph session, thread 1 is killed, the\\n-- hls-graph\'s internal state is not updated.\\n-- This is problematic with early cut off because we are having a new rule cache matching the\\n-- old hls-graph\'s internal state, which might case it\'s reverse dependency to skip the recomputation.\\n-- See https://github.com/haskell/haskell-language-server/issues/4194 for more details.\\n\\ntraceA :: A v -> String\\ntraceA (A Failed{}) = \\"Failed\\"\\ntraceA (A Stale{}) = \\"Stale\\"\\ntraceA (A Succeeded{}) = \\"Success\\"\\n\\nupdateFileDiagnostics :: MonadIO m\\n => Recorder (WithPriority Log)\\n -> NormalizedFilePath\\n -> Maybe Int32\\n -> Key\\n -> ShakeExtras\\n -> [FileDiagnostic] -- ^ current results\\n -> m ()\\nupdateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnostics, publishedDiagnostics, debouncer, lspEnv, ideTesting} current0 = do\\n liftIO $ withTrace (\\"update diagnostics \\" <> fromString(fromNormalizedFilePath fp)) $ \\\\ addTag -> do\\n addTag \\"key\\" (show k)\\n let (currentShown, currentHidden) = partition ((== ShowDiag) . fdShouldShowDiagnostic) current\\n uri = filePathToUri\' fp\\n addTagUnsafe :: String -> String -> String -> a -> a\\n addTagUnsafe msg t x v = unsafePerformIO(addTag (msg <> t) x) `seq` v\\n update :: (forall a. String -> String -> a -> a) -> [FileDiagnostic] -> STMDiagnosticStore -> STM [FileDiagnostic]\\n update addTagUnsafeMethod new store = addTagUnsafeMethod \\"count\\" (show $ Prelude.length new) $ setStageDiagnostics addTagUnsafeMethod uri ver (renderKey k) new store\\n current = map (fdLspDiagnosticL %~ diagsFromRule) current0\\n addTag \\"version\\" (show ver)\\n mask_ $ do\\n -- Mask async exceptions to ensure that updated diagnostics are always\\n -- published. Otherwise, we might never publish certain diagnostics if\\n -- an exception strikes between modifyVar but before\\n -- publishDiagnosticsNotification.\\n newDiags <- liftIO $ atomicallyNamed \\"diagnostics - update\\" $ update (addTagUnsafe \\"shown \\") currentShown diagnostics\\n _ <- liftIO $ atomicallyNamed \\"diagnostics - hidden\\" $ update (addTagUnsafe \\"hidden \\") currentHidden hiddenDiagnostics\\n let uri\' = filePathToUri\' fp\\n let delay = if null newDiags then 0.1 else 0\\n registerEvent debouncer delay uri\' $ withTrace (\\"report diagnostics \\" <> fromString (fromNormalizedFilePath fp)) $ \\\\tag -> do\\n join $ mask_ $ do\\n lastPublish <- atomicallyNamed \\"diagnostics - publish\\" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri\' publishedDiagnostics\\n let action = when (lastPublish /= newDiags) $ case lspEnv of\\n Nothing -> -- Print an LSP event.\\n logWith recorder Info $ LogDiagsDiffButNoLspEnv newDiags\\n Just env -> LSP.runLspT env $ do\\n liftIO $ tag \\"count\\" (show $ Prelude.length newDiags)\\n liftIO $ tag \\"key\\" (show k)\\n LSP.sendNotification SMethod_TextDocumentPublishDiagnostics $\\n LSP.PublishDiagnosticsParams (fromNormalizedUri uri\') (fmap fromIntegral ver) (map fdLspDiagnostic newDiags)\\n return action\\n where\\n diagsFromRule :: Diagnostic -> Diagnostic\\n diagsFromRule c@Diagnostic{_range}\\n | coerce ideTesting = c & L.relatedInformation ?~\\n [ DiagnosticRelatedInformation\\n (Location\\n (filePathToUri $ fromNormalizedFilePath fp)\\n _range\\n )\\n (T.pack $ show k)\\n ]\\n | otherwise = c\\n\\n\\nideLogger :: IdeState -> Recorder (WithPriority Log)\\nideLogger IdeState{shakeExtras=ShakeExtras{shakeRecorder}} = shakeRecorder\\n\\nactionLogger :: Action (Recorder (WithPriority Log))\\nactionLogger = shakeRecorder <$> getShakeExtras\\n\\n--------------------------------------------------------------------------------\\ntype STMDiagnosticStore = STM.Map NormalizedUri StoreItem\'\\ndata StoreItem\' = StoreItem\' (Maybe Int32) FileDiagnosticsBySource\\ntype FileDiagnosticsBySource = Map.Map (Maybe T.Text) (SL.SortedList FileDiagnostic)\\n\\ngetDiagnosticsFromStore :: StoreItem\' -> [FileDiagnostic]\\ngetDiagnosticsFromStore (StoreItem\' _ diags) = concatMap SL.fromSortedList $ Map.elems diags\\n\\nupdateSTMDiagnostics ::\\n (forall a. String -> String -> a -> a) ->\\n STMDiagnosticStore ->\\n NormalizedUri ->\\n Maybe Int32 ->\\n FileDiagnosticsBySource ->\\n STM [FileDiagnostic]\\nupdateSTMDiagnostics addTag store uri mv newDiagsBySource =\\n getDiagnosticsFromStore . fromJust <$> STM.focus (Focus.alter update *> Focus.lookup) uri store\\n where\\n update (Just(StoreItem\' mvs dbs))\\n | addTag \\"previous version\\" (show mvs) $\\n addTag \\"previous count\\" (show $ Prelude.length $ filter (not.null) $ Map.elems dbs) False = undefined\\n | mvs == mv = Just (StoreItem\' mv (newDiagsBySource <> dbs))\\n update _ = Just (StoreItem\' mv newDiagsBySource)\\n\\n-- | Sets the diagnostics for a file and compilation step\\n-- if you want to clear the diagnostics call this with an empty list\\nsetStageDiagnostics\\n :: (forall a. String -> String -> a -> a)\\n -> NormalizedUri\\n -> Maybe Int32 -- ^ the time that the file these diagnostics originate from was last edited\\n -> T.Text\\n -> [FileDiagnostic]\\n -> STMDiagnosticStore\\n -> STM [FileDiagnostic]\\nsetStageDiagnostics addTag uri ver stage diags ds = updateSTMDiagnostics addTag ds uri ver updatedDiags\\n where\\n !updatedDiags = Map.singleton (Just stage) $! SL.toSortedList diags\\n\\ngetAllDiagnostics ::\\n STMDiagnosticStore ->\\n STM [FileDiagnostic]\\ngetAllDiagnostics =\\n fmap (concatMap (\\\\(_,v) -> getDiagnosticsFromStore v)) . ListT.toList . STM.listT\\n\\nupdatePositionMapping :: IdeState -> VersionedTextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> STM ()\\nupdatePositionMapping IdeState{shakeExtras = ShakeExtras{positionMapping}} VersionedTextDocumentIdentifier{..} changes =\\n STM.focus (Focus.alter f) uri positionMapping\\n where\\n uri = toNormalizedUri _uri\\n f = Just . updatePositionMappingHelper _version changes . fromMaybe mempty\\n\\n\\nupdatePositionMappingHelper ::\\n Int32\\n -> [TextDocumentContentChangeEvent]\\n -> EnumMap Int32 (PositionDelta, PositionMapping)\\n -> EnumMap Int32 (PositionDelta, PositionMapping)\\nupdatePositionMappingHelper ver changes mappingForUri = snd $\\n -- Very important to use mapAccum here so that the tails of\\n -- each mapping can be shared, otherwise quadratic space is\\n -- used which is evident in long running sessions.\\n EM.mapAccumRWithKey (\\\\acc _k (delta, _) -> let new = addOldDelta delta acc in (new, (delta, acc)))\\n zeroMapping\\n (EM.insert ver (mkDelta changes, zeroMapping) mappingForUri)\\n\\n-- | sends a signal whenever shake session is run/restarted\\n-- being used in cabal and hlint plugin tests to know when its time\\n-- to look for file diagnostics\\nkickSignal :: KnownSymbol s => Bool -> Maybe (LSP.LanguageContextEnv c) -> [NormalizedFilePath] -> Proxy s -> Action ()\\nkickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $\\n LSP.sendNotification (LSP.SMethod_CustomMethod msg) $\\n toJSON $ map fromNormalizedFilePath files\\n\\n-- | Add kick start/done signal to rule\\nrunWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action ()\\nrunWithSignal msgStart msgEnd files rule = do\\n ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras\\n kickSignal testing lspEnv files msgStart\\n void $ uses rule files\\n kickSignal testing lspEnv files msgEnd\\n", "filetypes": ["haskell"]}}, "ultisnips_snippets": [{"trigger": "specf", "description": ""}, {"trigger": "fn0", "description": ""}, {"trigger": "fn1", "description": ""}, {"trigger": "fn2", "description": ""}, {"trigger": "fn3", "description": ""}, {"trigger": "LGPL2", "description": ""}, {"trigger": "LGPL3", "description": ""}, {"trigger": "let", "description": ""}, {"trigger": "GMGPL", "description": "linking exception"}, {"trigger": "todo", "description": "TODO comment"}, {"trigger": "foldp", "description": "Insert a vim fold marker pair"}, {"trigger": "diso", "description": "ISO format datetime"}, {"trigger": "(\\\\", "description": ""}, {"trigger": "imp2", "description": "Selective import"}, {"trigger": "spec", "description": ""}, {"trigger": "inline", "description": ""}, {"trigger": "itp", "description": ""}, {"trigger": "MPL2", "description": ""}, {"trigger": "c)", "description": ""}, {"trigger": "tup3", "description": ""}, {"trigger": "importq", "description": ""}, {"trigger": "ty", "description": ""}, {"trigger": "modeline", "description": "Vim modeline"}, {"trigger": "lang", "description": ""}, {"trigger": "it", "description": ""}, {"trigger": "type", "description": ""}, {"trigger": "tup2", "description": ""}, {"trigger": "=>", "description": "Type constraint"}, {"trigger": "info", "description": ""}, {"trigger": "box", "description": "A nice box with the current comment symbol"}, {"trigger": "const", "description": ""}, {"trigger": "\\\\", "description": ""}, {"trigger": "MIT", "description": ""}, {"trigger": "impq", "description": "Qualified import"}, {"trigger": "bbox", "description": "A nice box over the full width"}, {"trigger": "imp", "description": "Simple import"}, {"trigger": "BEERWARE", "description": ""}, {"trigger": "inst", "description": ""}, {"trigger": "class", "description": ""}, {"trigger": "foldc", "description": "Insert a vim fold close marker"}, {"trigger": "GPL2", "description": ""}, {"trigger": "GPL3", "description": ""}, {"trigger": "time", "description": "hh:mm"}, {"trigger": "tup", "description": ""}, {"trigger": "mod", "description": ""}, {"trigger": "import", "description": ""}, {"trigger": "WTFPL", "description": ""}, {"trigger": "fold", "description": "Insert a vim fold marker"}, {"trigger": "haddock", "description": ""}, {"trigger": "lorem", "description": ""}, {"trigger": "fn", "description": ""}, {"trigger": "module", "description": ""}, {"trigger": "data", "description": ""}, {"trigger": "desc", "description": ""}, {"trigger": "case", "description": ""}, {"trigger": "ap", "description": ""}, {"trigger": "date", "description": "YYYY-MM-DD"}, {"trigger": "ghc", "description": ""}, {"trigger": "AGPL3", "description": ""}, {"trigger": "uuid", "description": "Random UUID"}, {"trigger": "sb", "description": ""}, {"trigger": "where", "description": ""}, {"trigger": "da", "description": ""}, {"trigger": "<-", "description": ""}, {"trigger": "ddate", "description": "Month DD, YYYY"}, {"trigger": "BSD2", "description": ""}, {"trigger": "BSD3", "description": ""}, {"trigger": "BSD4", "description": ""}, {"trigger": "rec", "description": ""}, {"trigger": "datetime", "description": "YYYY-MM-DD hh:mm"}, {"trigger": "ISC", "description": ""}, {"trigger": "AGPL", "description": ""}, {"trigger": "main", "description": ""}, {"trigger": "doc", "description": ""}, {"trigger": "newtype", "description": ""}, {"trigger": "APACHE", "description": ""}, {"trigger": "import2", "description": ""}, {"trigger": "->", "description": ""}], "event_name": "BufferVisit"}' | |
| 2025-09-26 11:25:09,222 - DEBUG - POST b'http://127.0.0.1:40435/event_notification' | |
| {'content-type': 'application/json', 'x-ycm-hmac': b'zgU+In2b8Y2R9wsOMJy8c1VOQCWnGpq23dULIHTSc9c='} | |
| b'{"filepath": "/home/enrico/haskell-language-server/ghcide/src/Development/IDE/Core/Shake.hs", "line_num": 1, "column_num": 1, "working_dir": "/home/enrico/haskell-language-server", "file_data": {"/home/enrico/haskell-language-server/ghcide/src/Development/IDE/Core/Shake.hs": {"contents": "-- Copyright (c) 2019 The DAML Authors. All rights reserved.\\n-- SPDX-License-Identifier: Apache-2.0\\n\\n{-# LANGUAGE CPP #-}\\n{-# LANGUAGE DerivingStrategies #-}\\n{-# LANGUAGE DuplicateRecordFields #-}\\n{-# LANGUAGE PackageImports #-}\\n{-# LANGUAGE RecursiveDo #-}\\n{-# LANGUAGE TypeFamilies #-}\\n\\n-- | A Shake implementation of the compiler service.\\n--\\n-- There are two primary locations where data lives, and both of\\n-- these contain much the same data:\\n--\\n-- * The Shake database (inside \'shakeDb\') stores a map of shake keys\\n-- to shake values. In our case, these are all of type \'Q\' to \'A\'.\\n-- During a single run all the values in the Shake database are consistent\\n-- so are used in conjunction with each other, e.g. in \'uses\'.\\n--\\n-- * The \'Values\' type stores a map of keys to values. These values are\\n-- always stored as real Haskell values, whereas Shake serialises all \'A\' values\\n-- between runs. To deserialise a Shake value, we just consult Values.\\nmodule Development.IDE.Core.Shake(\\n IdeState, shakeSessionInit, shakeExtras, shakeDb, rootDir,\\n ShakeExtras(..), getShakeExtras, getShakeExtrasRules,\\n KnownTargets(..), Target(..), toKnownFiles, unionKnownTargets, mkKnownTargets,\\n IdeRule, IdeResult,\\n GetModificationTime(GetModificationTime, GetModificationTime_, missingFileDiagnostics),\\n shakeOpen, shakeShut,\\n shakeEnqueue,\\n newSession,\\n use, useNoFile, uses, useWithStaleFast, useWithStaleFast\', delayedAction,\\n useWithSeparateFingerprintRule,\\n useWithSeparateFingerprintRule_,\\n FastResult(..),\\n use_, useNoFile_, uses_,\\n useWithStale, usesWithStale,\\n useWithStale_, usesWithStale_,\\n BadDependency(..),\\n RuleBody(..),\\n define, defineNoDiagnostics,\\n defineEarlyCutoff,\\n defineNoFile, defineEarlyCutOffNoFile,\\n getDiagnostics,\\n mRunLspT, mRunLspTCallback,\\n getHiddenDiagnostics,\\n IsIdeGlobal, addIdeGlobal, addIdeGlobalExtras, getIdeGlobalState, getIdeGlobalAction,\\n getIdeGlobalExtras,\\n getIdeOptions,\\n getIdeOptionsIO,\\n GlobalIdeOptions(..),\\n HLS.getClientConfig,\\n getPluginConfigAction,\\n knownTargets,\\n ideLogger,\\n actionLogger,\\n getVirtualFile,\\n FileVersion(..),\\n updatePositionMapping,\\n updatePositionMappingHelper,\\n deleteValue,\\n WithProgressFunc, WithIndefiniteProgressFunc,\\n ProgressEvent(..),\\n DelayedAction, mkDelayedAction,\\n IdeAction(..), runIdeAction,\\n mkUpdater,\\n -- Exposed for testing.\\n Q(..),\\n IndexQueue,\\n HieDb,\\n HieDbWriter(..),\\n addPersistentRule,\\n garbageCollectDirtyKeys,\\n garbageCollectDirtyKeysOlderThan,\\n Log(..),\\n VFSModified(..), getClientConfigAction,\\n ThreadQueue(..),\\n runWithSignal\\n ) where\\n\\nimport Control.Concurrent.Async\\nimport Control.Concurrent.STM\\nimport Control.Concurrent.STM.Stats (atomicallyNamed)\\nimport Control.Concurrent.Strict\\nimport Control.DeepSeq\\nimport Control.Exception.Extra hiding (bracket_)\\nimport Control.Lens ((%~), (&), (?~))\\nimport Control.Monad.Extra\\nimport Control.Monad.IO.Class\\nimport Control.Monad.Reader\\nimport Control.Monad.Trans.Maybe\\nimport Data.Aeson (Result (Success),\\n toJSON)\\nimport qualified Data.Aeson.Types as A\\nimport qualified Da |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment