Skip to content
New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

#

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Fix Completion document format #2848

Merged
merged 16 commits into from
Apr 26, 2022
Merged

Fix Completion document format #2848

Show file tree
Hide file tree
Changes from 4 commits
Commits
Show all changes
16 commits
Select commit Hold shift + click to select a range
0fb01e1
Fix doc display
July541 Apr 21, 2022
5936154
Fix doc display
July541 Apr 22, 2022
8f9ce65
Add tests
July541 Apr 22, 2022
7b1b262
Fix broken tests
July541 Apr 22, 2022
9175fbe
Remove extra docs
July541 Apr 22, 2022
ac3e4da
Rerun tests
July541 Apr 22, 2022
68cbc2c
Add spanDocToMarkdown doc
July541 Apr 24, 2022
3185091
Fix tests
July541 Apr 24, 2022
28fb83b
Adjust test for broken target
July541 Apr 24, 2022
1a92067
Fix test
July541 Apr 24, 2022
31ac60b
Fix broken tests
July541 Apr 24, 2022
6405c2c
Unify tests
July541 Apr 25, 2022
5977d32
Merge branch 'master' into completion-doc
pepeiborra Apr 25, 2022
016b5b4
Update spanDocToMarkdown doc
July541 Apr 25, 2022
e40a39b
Merge branch 'completion-doc' of https://github.com/July541/haskell-l…
July541 Apr 25, 2022
5debde8
Merge branch 'master' into completion-doc
pepeiborra Apr 26, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -204,7 +204,7 @@ mkCompl
where kind = Just compKind
docs' = imported : spanDocToMarkdown docs
imported = case provenance of
Local pos -> "*Defined at " <> pprLineCol (srcSpanStart pos) <> " in this module*\n'"
Local pos -> "*Defined at " <> pprLineCol (srcSpanStart pos) <> " in this module*\n"
ImportedFrom mod -> "*Imported from '" <> mod <> "'*\n"
DefinedIn mod -> "*Defined in '" <> mod <> "'*\n"
colon = if optNewColonConvention then ": " else ":: "
Expand Down
21 changes: 15 additions & 6 deletions ghcide/src/Development/IDE/Spans/Common.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,7 +62,9 @@ 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

Expand All @@ -77,12 +79,19 @@ emptySpanDoc :: SpanDoc
emptySpanDoc = SpanDocText [] (SpanDocUris Nothing Nothing)

spanDocToMarkdown :: SpanDoc -> [T.Text]
spanDocToMarkdown (SpanDocString docs uris)
= [T.pack $ haddockToMarkdown $ H.toRegular $ H._doc $ H.parseParas Nothing $ unpackHDS docs]
<> ["\n"] <> spanDocUrisToMarkdown uris
-- Append the extra newlines since this is markdown --- to get a visible newline,
-- you need to have two newlines
spanDocToMarkdown (SpanDocText txt uris) = txt <> ["\n"] <> spanDocUrisToMarkdown uris
spanDocToMarkdown = \case
(SpanDocString docs uris) ->
let doc = T.pack $ haddockToMarkdown $ H.toRegular $ H._doc $ H.parseParas Nothing $ unpackHDS docs
in go [doc] uris
(SpanDocText txt uris) -> go txt uris
where
go [] uris = spanDocUrisToMarkdown uris
go txt uris = init txt <> [render (last txt)] <> spanDocUrisToMarkdown uris
-- If the doc is not end with an `'\n'`, we append it.
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This logic is a bit confusing, because we have a collection of lines, some of them ending with newlines. The old comment is correct, we do need two newlines to get a paragraph break in markdown, but that works out here because T.unlines [ "foo\n", "bar" ] will end up with two newlines. Confusing.

In fact, should the lines ever have trailing newlines? That seems odd.

I wonder if it would be simpler if this function just dealt with a single Text representing the whole piece of doc. AFAICT it would be fine if spanDocToMarkdown returned just a Text.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

  1. Two newlines to get a new paragraph is correct, but one \n is enough to get a section separator(xxx\n***\nxxx)
  2. My idea is: we just ensure the last line should end up with \n, so the separator can rendered correctly.

    haskell-language-server/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

    Lines 211 to 213 in da0379b

    documentation = Just $ CompletionDocMarkup $
    MarkupContent MkMarkdown $
    T.intercalate sectionSeparator docs'

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I wonder if it would be simpler if this function just dealt with a single Text representing the whole piece of doc. AFAICT it would be fine if spanDocToMarkdown returned just a Text.

Unfortunately, spanDocToMarkdown is both used in completion and hover, and they have different UI(completion uses section separator, hover uses new line), so we can't return a Text in spanDocToMarkdown. Furthermore, the final documentation is the combination of Defined in, haddock, and source link.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Does it return a list of sections then? Please add a Haddock comment clarifying what spanDocToMarkdown returns

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Done

render txt
| T.null txt = txt
| T.last txt == '\n' = txt
| otherwise = txt <> T.pack "\n"

spanDocUrisToMarkdown :: SpanDocUris -> [T.Text]
spanDocUrisToMarkdown (SpanDocUris mdoc msrc) = catMaybes
Expand Down
88 changes: 85 additions & 3 deletions ghcide/test/exe/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4615,6 +4615,7 @@ completionTests
, testGroup "package" packageCompletionTests
, testGroup "project" projectCompletionTests
, testGroup "other" otherCompletionTests
, testGroup "doc" completionDocTests
]

completionTest :: String -> [T.Text] -> Position -> [(T.Text, CompletionItemKind, T.Text, Bool, Bool, Maybe (List TextEdit))] -> TestTree
Expand Down Expand Up @@ -5067,7 +5068,7 @@ packageCompletionTests =
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 2 12)
let compls' =
[T.drop 1 $ T.dropEnd 10 d
[T.drop 1 $ T.dropEnd 3 d
| CompletionItem {_documentation = Just (CompletionDocMarkup (MarkupContent MkMarkdown d)), _label}
<- compls
, _label == "fromList"
Expand All @@ -5087,7 +5088,7 @@ packageCompletionTests =
_ <- waitForDiagnostics
compls <- getCompletions doc (Position 2 7)
let compls' =
[T.drop 1 $ T.dropEnd 10 d
[T.drop 1 $ T.dropEnd 3 d
| CompletionItem {_documentation = Just (CompletionDocMarkup (MarkupContent MkMarkdown d)), _label}
<- compls
, _label == "Map"
Expand Down Expand Up @@ -5171,7 +5172,7 @@ projectCompletionTests =
]
compls <- getCompletions doc (Position 1 10)
let compls' =
[T.drop 1 $ T.dropEnd 10 d
[T.drop 1 $ T.dropEnd 3 d
| CompletionItem {_documentation = Just (CompletionDocMarkup (MarkupContent MkMarkdown d)), _label}
<- compls
, _label == "anidentifier"
Expand Down Expand Up @@ -5230,6 +5231,87 @@ projectCompletionTests =
item ^. L.label @?= "anidentifier"
]

completionDocTests :: [TestTree]
completionDocTests =
[ testSession "local define" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = ()"
, "bar = fo"
]
let expected = "*Defined at line 2, column 1 in this module*\n"
test doc (Position 2 8) "foo" (Just $ T.length expected) [expected]
, testSession "local empty doc" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = ()"
, "bar = fo"
]
test doc (Position 2 8) "foo" Nothing ["*Defined at line 2, column 1 in this module*\n"]
, broken $ testSession "local single line doc without '\\n'" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "-- |docdoc"
, "foo = ()"
, "bar = fo"
]
test doc (Position 3 8) "foo" Nothing ["*Defined at line 3, column 1 in this module*\n* * *\ndocdoc\n"]
, broken $ testSession "local multi line doc with '\\n'" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "-- | abcabc"
, "--"
, "foo = ()"
, "bar = fo"
]
test doc (Position 4 8) "foo" Nothing ["*Defined at line 4, column 1 in this module*\n* * *\n abcabc\n"]
, broken $ testSession "local multi line doc without '\\n'" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "-- | abcabc"
, "--"
, "--def"
, "foo = ()"
, "bar = fo"
]
test doc (Position 5 8) "foo" Nothing ["*Defined at line 5, column 1 in this module*\n* * *\n abcabc\n\ndef\n"]
, testSession "extern empty doc" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = od"
]
let expected = "*Imported from 'Prelude'*\n* * *\n[Documentation](file:"
test doc (Position 1 8) "odd" (Just $ T.length expected) [expected]
, broken $ testSession "extern single line doc without '\\n'" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = no"
]
let expected = "*Imported from 'Prelude'*\n* * *\n\n\nBoolean \"not\"\n* * *\n[Documentation](file:"
test doc (Position 1 8) "not" (Just $ T.length expected) [expected]
, broken $ testSession "extern mulit line doc" $ do
doc <- createDoc "A.hs" "haskell" $ T.unlines
[ "module A where"
, "foo = i"
]
let expected = "*Imported from 'Prelude'*\n* * *\n\n\nIdentity function. \n```haskell\nid x = x\n```\n* * *\n[Documentation](file:"
test doc (Position 1 7) "id" (Just $ T.length expected) [expected]
]
where
broken = knownBrokenForGhcVersions [GHC90, GHC92] "Completion doc doesn't support ghc9"
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

:o do we have a ticket for this?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No, I just found this

haskell-language-server/ghcide/src/Development/IDE/Spans/Documentation.hs

Lines 104 to 122 in da0379b

getDocumentation
:: HasSrcSpan name
=> [ParsedModule] -- ^ All of the possible modules it could be defined in.
-> name -- ^ The name you want documentation for.
-> [T.Text]
-- This finds any documentation between the name you want
-- documentation for and the one before it. This is only an
-- approximately correct algorithm and there are easily constructed
-- cases where it will be wrong (if so then usually slightly but there
-- may be edge cases where it is very wrong).
-- TODO : Build a version of GHC exactprint to extract this information
-- more accurately.
-- TODO : Implement this for GHC 9.2 with in-tree annotations
-- (alternatively, just remove it and rely soley on GHC's parsing)
getDocumentation sources targetName = fromMaybe [] $ do
#if MIN_VERSION_ghc(9,2,0)
Nothing
#else
-- Find the module the target is defined in.

, ghc9.0 test fails on my machine, so I marked it as broken

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Note that this code path is only used to get documentation for local completions (from the same module). I dont' think that it is being used in your test.

Are you in Mac OS? Some ghc 9.x distributions are shipping without interface haddocks

test doc pos label mn expected = do
_ <- waitForDiagnostics
compls <- getCompletions doc pos
let compls' = [
-- We ignore doc uris since it points to the local path which determined by specific machines
case mn of
Nothing -> txt
Just n -> T.take n txt
| CompletionItem {_documentation = Just (CompletionDocMarkup (MarkupContent MkMarkdown txt)), ..} <- compls
, _label == label
]
liftIO $ compls' @?= expected

highlightTests :: TestTree
highlightTests = testGroup "highlight"
[ testSessionWait "value" $ do
Expand Down