Doctest comment parsing using module annotations in Eval Plugin

ghcide/src/Development/IDE/Core/Rules.hs

@@ -339,6 +339,9 @@ withOptHaddock = withOption Opt_Haddock
 withOption :: GeneralFlag -> ModSummary -> ModSummary
 withOption opt ms = ms{ms_hspp_opts= gopt_set (ms_hspp_opts ms) opt}
 
+withoutOption :: GeneralFlag -> ModSummary -> ModSummary
+withoutOption opt ms = ms{ms_hspp_opts= gopt_unset (ms_hspp_opts ms) opt}
+
 -- | Given some normal parse errors (first) and some from Haddock (second), merge them.
 --   Ignore Haddock errors that are in both. Demote Haddock-only errors to warnings.
 mergeParseErrorsHaddock :: [FileDiagnostic] -> [FileDiagnostic] -> [FileDiagnostic]
@@ -360,7 +363,7 @@ getParsedModuleWithCommentsRule = defineEarlyCutoff $ \GetParsedModuleWithCommen
     sess <- use_ GhcSession file
     opt <- getIdeOptions
 
-    let ms' = withOption Opt_KeepRawTokenStream ms
+    let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms
 
     liftIO $ getParsedModuleDefinition (hscEnv sess) opt file ms'
 

ghcide/src/Development/IDE/GHC/Orphans.hs

@@ -22,6 +22,7 @@ import qualified StringBuffer               as SB
 import Data.Text (Text)
 import Data.String (IsString(fromString))
 import Retrie.ExactPrint (Annotated)
+import Data.List (foldl')
 
 
 -- Orphan instances for types from the GHC API.

plugins/hls-eval-plugin/hls-eval-plugin.cabal

@@ -31,9 +31,7 @@ library
     Ide.Plugin.Eval.CodeLens
     Ide.Plugin.Eval.GHC
     Ide.Plugin.Eval.Parse.Option
-    Ide.Plugin.Eval.Parse.Parser
-    Ide.Plugin.Eval.Parse.Section
-    Ide.Plugin.Eval.Parse.Token
+    Ide.Plugin.Eval.Parse.Comments
     Ide.Plugin.Eval.Types
     Ide.Plugin.Eval.Util
 
@@ -44,6 +42,7 @@ library
     , deepseq
     , Diff
     , directory
+    , dlist
     , extra
     , filepath
     , ghc
@@ -54,6 +53,8 @@ library
     , haskell-lsp
     , haskell-lsp-types
     , hls-plugin-api
+    , lens
+    , megaparsec >= 0.9
     , parser-combinators
     , pretty-simple
     , QuickCheck
@@ -63,6 +64,7 @@ library
     , text
     , time
     , transformers
+    , mtl
     , unordered-containers
 
   ghc-options: -Wall -Wno-name-shadowing

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

@@ -15,20 +15,21 @@ import GhcMonad (Ghc, GhcMonad, liftIO)
 import Ide.Plugin.Eval.Types (
     Language (Plain),
     Loc,
-    Located (Located),
     Section (sectionLanguage),
-    Test (Example, Property, testOutput),
+    Test (..),
     Txt,
     locate,
-    locate0,
+    locate0, Located(..)
  )
 import InteractiveEval (runDecls)
 import Unsafe.Coerce (unsafeCoerce)
+import Control.Lens ((^.))
+import Language.Haskell.LSP.Types.Lens (start, line)
 
 -- | Return the ranges of the expression and result parts of the given test
-testRanges :: Loc Test -> (Range, Range)
-testRanges (Located line tst) =
-    let startLine = line
+testRanges :: Test -> (Range, Range)
+testRanges tst =
+    let startLine = testRange tst ^. start.line
         (exprLines, resultLines) = testLenghts tst
         resLine = startLine + exprLines
      in ( Range
@@ -44,7 +45,7 @@ testRanges (Located line tst) =
 -}
 
 -- |The document range where the result of the test is defined
-resultRange :: Loc Test -> Range
+resultRange :: Test -> Range
 resultRange = snd . testRanges
 
 -- TODO: handle BLANKLINE
@@ -66,18 +67,18 @@ testCheck (section, test) out
     | otherwise = showDiffs $ getDiff (map T.pack $ testOutput test) out
 
 testLenghts :: Test -> (Int, Int)
-testLenghts (Example e r) = (NE.length e, length r)
-testLenghts (Property _ r) = (1, length r)
+testLenghts (Example e r _) = (NE.length e, length r)
+testLenghts (Property _ r _) = (1, length r)
 
 -- |A one-line Haskell statement
 type Statement = Loc String
 
-asStatements :: Loc Test -> [Statement]
-asStatements lt = locate (asStmts <$> lt)
+asStatements :: Test -> [Statement]
+asStatements lt = locate $ Located (testRange lt ^. start.line) (asStmts lt)
 
 asStmts :: Test -> [Txt]
-asStmts (Example e _) = NE.toList e
-asStmts (Property t _) =
+asStmts (Example e _ _) = NE.toList e
+asStmts (Property t _ _) =
     ["prop11 = " ++ t, "(propEvaluation prop11 :: IO String)"]
 
 -- |Evaluate an expression (either a pure expression or an IO a)