Merge branch 'master' into type-signature

haskell · May 25, 2022 · 212f4ad · 212f4ad
2 parents 8e856d0 + 1a0d4a7
commit 212f4ad
Show file tree

Hide file tree

Showing 4 changed files with 25 additions and 10 deletions.
diff --git a/docs/features.md b/docs/features.md
@@ -274,6 +274,13 @@ Evaluates code blocks in comments with a click. [Tutorial](https://github.com/ha
 
 ![Eval Demo](https://raw.githubusercontent.com/haskell/haskell-language-server/master/plugins/hls-eval-plugin/demo.gif)
 
+Known limitations:
+
+- Standard input is shared with HLS, so e.g. [`getLine` breaks the connection to server](https://github.com/haskell/haskell-language-server/issues/2913).
+- Standard (error) output [is not captured](https://github.com/haskell/haskell-language-server/issues/1977).
+- While similar to [doctest](https://hackage.haskell.org/package/doctest), some of its features are unsupported,
+  see [Differences with doctest](https://github.com/haskell/haskell-language-server/blob/master/plugins/hls-eval-plugin/README.md#differences-with-doctest).
+
 ### Make import lists fully explicit code lens
 
 Provided by: `hls-explicit-imports-plugin`

diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs
@@ -32,9 +32,9 @@ import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.GHC.Compat
 import qualified Development.IDE.GHC.Compat.Util      as Util
+import           Development.IDE.GHC.Util             (printOutputable)
 import           Development.IDE.Spans.Common
 import           Development.IDE.Types.Options
-import           Development.IDE.GHC.Util             (printOutputable)
 
 import           Control.Applicative
 import           Control.Monad.Extra
@@ -231,11 +231,14 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
         prettyNames = map prettyName names
         prettyName (Right n, dets) = T.unlines $
           wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))
-          : definedAt n
-          ++ maybeToList (prettyPackageName n)
+          : maybeToList (pretty (definedAt n) (prettyPackageName n))
           ++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n
                        ]
           where maybeKind = fmap printOutputable $ safeTyThingType =<< lookupNameEnv km n
+                pretty Nothing Nothing = Nothing
+                pretty (Just define) Nothing = Just $ define <> "\n"
+                pretty Nothing (Just pkgName) = Just $ pkgName <> "\n"
+                pretty (Just define) (Just pkgName) = Just $ define <> " " <> pkgName <> "\n"
         prettyName (Left m,_) = printOutputable m
 
         prettyPackageName n = do
@@ -244,7 +247,7 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
           conf <- lookupUnit env pid
           let pkgName = T.pack $ unitPackageNameString conf
               version = T.pack $ showVersion (unitPackageVersion conf)
-          pure $ " *(" <> pkgName <> "-" <> version <> ")*"
+          pure $ "*(" <> pkgName <> "-" <> version <> ")*"
 
         prettyTypes = map (("_ :: "<>) . prettyType) types
         prettyType t = case kind of
@@ -255,8 +258,8 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p
           -- do not show "at <no location info>" and similar messages
           -- see the code of 'pprNameDefnLoc' for more information
           case nameSrcLoc name of
-            UnhelpfulLoc {} | isInternalName name || isSystemName name -> []
-            _ -> ["*Defined " <> printOutputable (pprNameDefnLoc name) <> "*"]
+            UnhelpfulLoc {} | isInternalName name || isSystemName name -> Nothing
+            _ -> Just $ "*Defined " <> printOutputable (pprNameDefnLoc name) <> "*"
 
 typeLocationsAtPoint
   :: forall m

diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs
@@ -51,9 +51,7 @@ safeTyThingId _                                = Nothing
 -- Possible documentation for an element in the code
 data SpanDoc
   = SpanDocString HsDocString SpanDocUris
-    -- ^ Extern module doc
   | SpanDocText   [T.Text] SpanDocUris
-    -- ^ Local module doc
   deriving stock (Eq, Show, Generic)
   deriving anyclass NFData
 
@@ -80,6 +78,11 @@ emptySpanDoc = SpanDocText [] (SpanDocUris Nothing Nothing)
 -- it will result "xxxx---\nyyyy" and can't be rendered as a normal doc.
 -- Therefore we check every item in the value to make sure they all end with '\\n',
 -- this makes "xxxx\n---\nyyy\n" and can be rendered correctly.
+--
+-- Notes:
+--
+-- To insert a new line in Markdown, we need two '\\n', like ("\\n\\n"), __or__ a section
+-- symbol with one '\\n', like ("***\\n").
 spanDocToMarkdown :: SpanDoc -> [T.Text]
 spanDocToMarkdown = \case
     (SpanDocString docs uris) ->

diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs
@@ -4254,6 +4254,7 @@ findDefinitionAndHoverTests = let
             ExpectRange  expectedRange -> checkHoverRange expectedRange rangeInHover msg
             ExpectHoverRange expectedRange -> checkHoverRange expectedRange rangeInHover msg
             ExpectHoverText snippets -> liftIO $ traverse_ (`assertFoundIn` msg) snippets
+            ExpectHoverTextRegex re -> liftIO $ assertBool ("Regex not found in " <> T.unpack msg) (msg =~ re :: Bool)
             ExpectNoHover -> liftIO $ assertFailure $ "Expected no hover but got " <> show hover
             _ -> pure () -- all other expectations not relevant to hover
         _ -> liftIO $ assertFailure $ "test not expecting this kind of hover info" <> show hover
@@ -4344,7 +4345,7 @@ findDefinitionAndHoverTests = let
   innL48 = Position 52  5  ;  innSig = [ExpectHoverText ["inner", "Char"], mkR 49 2 49 7]
   holeL60 = Position 62 7  ;  hleInfo = [ExpectHoverText ["_ ::"]]
   holeL65 = Position 65 8  ;  hleInfo2 = [ExpectHoverText ["_ :: a -> Maybe a"]]
-  cccL17 = Position 17 16  ;  docLink = [ExpectHoverText ["[Documentation](file:///"]]
+  cccL17 = Position 17 16  ;  docLink = [ExpectHoverTextRegex "\\*Defined in 'GHC.Types'\\* \\*\\(ghc-prim-[0-9.]+\\)\\*\n\n"]
   imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3]
   reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 0 3 14]
   thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]]
@@ -4399,7 +4400,7 @@ findDefinitionAndHoverTests = let
   , test  broken broken innL48     innSig        "inner     signature              #767"
   , test  no     yes    holeL60    hleInfo       "hole without internal name       #831"
   , test  no     yes    holeL65    hleInfo2      "hole with variable"
-  , test  no     skip   cccL17     docLink       "Haddock html links"
+  , test  no     yes    cccL17     docLink       "Haddock html links"
   , testM yes    yes    imported   importedSig   "Imported symbol"
   , testM yes    yes    reexported reexportedSig "Imported symbol (reexported)"
   , if | ghcVersion == GHC90 && isWindows ->
@@ -5743,6 +5744,7 @@ data Expect
 --  | ExpectDefRange Range -- Only gotoDef should report this range
   | ExpectHoverRange Range -- Only hover should report this range
   | ExpectHoverText [T.Text] -- the hover message must contain these snippets
+  | ExpectHoverTextRegex T.Text -- the hover message must match this pattern
   | ExpectExternFail -- definition lookup in other file expected to fail
   | ExpectNoDefinitions
   | ExpectNoHover