Skip to content

Commit a85b7e9

Browse files
nwolversonpaf31
nwolverson
authored and
paf31
committed
[purs ide] return documentation comments (purescript#3138)
1 parent 64d6c5a commit a85b7e9

6 files changed

Lines changed: 118 additions & 20 deletions

File tree

‎src/Language/PureScript/Docs/Convert/Single.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
module Language.PureScript.Docs.Convert.Single
22
( convertSingleModule
3+
, convertComments
34
) where
45

56
import Protolude hiding (moduleName)

‎src/Language/PureScript/Ide/Completion.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -130,7 +130,7 @@ completionFromMatch (Match (m, IdeDeclarationAnn ann decl), mns) =
130130

131131
complLocation = _annLocation ann
132132

133-
complDocumentation = Nothing
133+
complDocumentation = _annDocumentation ann
134134

135135
showFixity p a r o =
136136
let asso = case a of

‎src/Language/PureScript/Ide/State.hs‎

Lines changed: 68 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,7 @@ import Control.Lens hiding (op, (&))
4444
import "monad-logger" Control.Monad.Logger
4545
import qualified Data.Map.Lazy as Map
4646
import qualified Language.PureScript as P
47+
import Language.PureScript.Docs.Convert.Single (convertComments)
4748
import Language.PureScript.Externs
4849
import Language.PureScript.Ide.Externs
4950
import Language.PureScript.Ide.Reexports
@@ -199,6 +200,7 @@ populateVolatileStateSTM ref = do
199200
moduleDeclarations
200201
& map resolveDataConstructorsForModule
201202
& resolveLocations asts
203+
& resolveDocumentation (map fst modules)
202204
& resolveInstances externs
203205
& resolveOperators
204206
& resolveReexports reexportRefs
@@ -221,23 +223,7 @@ resolveLocationsForModule (defs, types) decls =
221223
map convertDeclaration decls
222224
where
223225
convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn
224-
convertDeclaration (IdeDeclarationAnn ann d) = case d of
225-
IdeDeclValue v ->
226-
annotateFunction (v ^. ideValueIdent) (IdeDeclValue v)
227-
IdeDeclType t ->
228-
annotateType (t ^. ideTypeName . properNameT) (IdeDeclType t)
229-
IdeDeclTypeSynonym s ->
230-
annotateType (s ^. ideSynonymName . properNameT) (IdeDeclTypeSynonym s)
231-
IdeDeclDataConstructor dtor ->
232-
annotateValue (dtor ^. ideDtorName . properNameT) (IdeDeclDataConstructor dtor)
233-
IdeDeclTypeClass tc ->
234-
annotateType (tc ^. ideTCName . properNameT) (IdeDeclTypeClass tc)
235-
IdeDeclValueOperator operator ->
236-
annotateValue (operator ^. ideValueOpName . opNameT) (IdeDeclValueOperator operator)
237-
IdeDeclTypeOperator operator ->
238-
annotateType (operator ^. ideTypeOpName . opNameT) (IdeDeclTypeOperator operator)
239-
IdeDeclKind i ->
240-
annotateKind (i ^. properNameT) (IdeDeclKind i)
226+
convertDeclaration (IdeDeclarationAnn ann d) = convertDeclaration' annotateFunction annotateValue annotateType annotateKind d
241227
where
242228
annotateFunction x = IdeDeclarationAnn (ann { _annLocation = Map.lookup (IdeNamespaced IdeNSValue (P.runIdent x)) defs
243229
, _annTypeAnnotation = Map.lookup x types
@@ -246,6 +232,71 @@ resolveLocationsForModule (defs, types) decls =
246232
annotateType x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSType x) defs})
247233
annotateKind x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSKind x) defs})
248234

235+
convertDeclaration'
236+
:: (P.Ident -> IdeDeclaration -> IdeDeclarationAnn)
237+
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
238+
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
239+
-> (Text -> IdeDeclaration -> IdeDeclarationAnn)
240+
-> IdeDeclaration
241+
-> IdeDeclarationAnn
242+
convertDeclaration' annotateFunction annotateValue annotateType annotateKind d =
243+
case d of
244+
IdeDeclValue v ->
245+
annotateFunction (v ^. ideValueIdent) d
246+
IdeDeclType t ->
247+
annotateType (t ^. ideTypeName . properNameT) d
248+
IdeDeclTypeSynonym s ->
249+
annotateType (s ^. ideSynonymName . properNameT) d
250+
IdeDeclDataConstructor dtor ->
251+
annotateValue (dtor ^. ideDtorName . properNameT) d
252+
IdeDeclTypeClass tc ->
253+
annotateType (tc ^. ideTCName . properNameT) d
254+
IdeDeclValueOperator operator ->
255+
annotateValue (operator ^. ideValueOpName . opNameT) d
256+
IdeDeclTypeOperator operator ->
257+
annotateType (operator ^. ideTypeOpName . opNameT) d
258+
IdeDeclKind i ->
259+
annotateKind (i ^. properNameT) d
260+
261+
resolveDocumentation
262+
:: ModuleMap P.Module
263+
-> ModuleMap [IdeDeclarationAnn]
264+
-> ModuleMap [IdeDeclarationAnn]
265+
resolveDocumentation modules =
266+
Map.mapWithKey (\mn decls ->
267+
maybe decls (flip resolveDocumentationForModule decls) (Map.lookup mn modules))
268+
269+
resolveDocumentationForModule
270+
:: P.Module
271+
-> [IdeDeclarationAnn]
272+
-> [IdeDeclarationAnn]
273+
resolveDocumentationForModule (P.Module _ _ _ sdecls _) decls = map convertDecl decls
274+
where
275+
comments :: Map P.Name [P.Comment]
276+
comments = Map.fromListWith (flip (<>)) $ mapMaybe (\d ->
277+
case name d of
278+
Just name' -> Just (name', snd $ P.declSourceAnn d)
279+
_ -> Nothing)
280+
sdecls
281+
282+
name :: P.Declaration -> Maybe P.Name
283+
name (P.TypeDeclaration d) = Just $ P.IdentName $ P.tydeclIdent d
284+
name decl = P.declName decl
285+
286+
convertDecl :: IdeDeclarationAnn -> IdeDeclarationAnn
287+
convertDecl (IdeDeclarationAnn ann d) =
288+
convertDeclaration'
289+
(annotateValue . P.IdentName)
290+
(annotateValue . P.IdentName . P.Ident)
291+
(annotateValue . P.TyName . P.ProperName)
292+
(annotateValue . P.KiName . P.ProperName)
293+
d
294+
where
295+
docs :: P.Name -> Text
296+
docs ident = fromMaybe "" $ convertComments =<< Map.lookup ident comments
297+
298+
annotateValue ident = IdeDeclarationAnn (ann { _annDocumentation = Just $ docs ident })
299+
249300
resolveInstances
250301
:: ModuleMap P.ExternsFile
251302
-> ModuleMap [IdeDeclarationAnn]

‎src/Language/PureScript/Ide/Types.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -114,13 +114,14 @@ data Annotation
114114
{ _annLocation :: Maybe P.SourceSpan
115115
, _annExportedFrom :: Maybe P.ModuleName
116116
, _annTypeAnnotation :: Maybe P.Type
117+
, _annDocumentation :: Maybe Text
117118
} deriving (Show, Eq, Ord, Generic, NFData)
118119

119120
makeLenses ''Annotation
120121
makeLenses ''IdeDeclarationAnn
121122

122123
emptyAnn :: Annotation
123-
emptyAnn = Annotation Nothing Nothing Nothing
124+
emptyAnn = Annotation Nothing Nothing Nothing Nothing
124125

125126
type DefinitionSites a = Map IdeNamespaced a
126127
type TypeAnnotations = Map P.Ident P.Type

‎tests/Language/PureScript/Ide/CompletionSpec.hs‎

Lines changed: 33 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,10 +5,12 @@ module Language.PureScript.Ide.CompletionSpec where
55
import Protolude
66

77
import Language.PureScript as P
8+
import Language.PureScript.Ide.Test as Test
9+
import Language.PureScript.Ide.Command as Command
810
import Language.PureScript.Ide.Completion
9-
import Language.PureScript.Ide.Test
1011
import Language.PureScript.Ide.Types
1112
import Test.Hspec
13+
import System.FilePath
1214

1315
reexportMatches :: [Match IdeDeclarationAnn]
1416
reexportMatches =
@@ -21,6 +23,15 @@ reexportMatches =
2123
matches :: [(Match IdeDeclarationAnn, [P.ModuleName])]
2224
matches = map (\d -> (Match (mn "Main", d), [mn "Main"])) [ ideKind "Kind", ideType "Type" Nothing [] ]
2325

26+
typ :: Text -> Command
27+
typ txt = Type txt [] Nothing
28+
29+
load :: [Text] -> Command
30+
load = LoadSync . map Test.mn
31+
32+
rebuildSync :: FilePath -> Command
33+
rebuildSync fp = RebuildSync ("src" </> fp) Nothing
34+
2435
spec :: Spec
2536
spec = describe "Applying completion options" $ do
2637
it "keeps all matches if maxResults is not specified" $ do
@@ -32,3 +43,24 @@ spec = describe "Applying completion options" $ do
3243
it "groups reexports for a single identifier" $ do
3344
applyCompletionOptions (defaultCompletionOptions { coGroupReexports = True })
3445
reexportMatches `shouldBe` [(Match (mn "A", ideKind "Kind"), [mn "A", mn "B"])]
46+
47+
it "gets simple docs on definition itself" $ do
48+
([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $
49+
Test.runIde [ load ["CompletionSpecDocs"]
50+
, typ "something"
51+
]
52+
result `shouldSatisfy` \res -> complDocumentation res == Just "Doc x\n"
53+
54+
it "gets multiline docs" $ do
55+
([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $
56+
Test.runIde [ load ["CompletionSpecDocs"]
57+
, typ "multiline"
58+
]
59+
result `shouldSatisfy` \res -> complDocumentation res == Just "This is\na multi-line\ncomment\n"
60+
61+
it "gets simple docs on type annotation" $ do
62+
([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $
63+
Test.runIde [ load ["CompletionSpecDocs"]
64+
, typ "withType"
65+
]
66+
result `shouldSatisfy` \res -> complDocumentation res == Just "Doc *123*\n"

‎tests/support/pscide/src/CompletionSpecDocs.purs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
module CompletionSpecDocs where
2+
3+
-- | Doc x
4+
something = "something"
5+
6+
-- | Doc *123*
7+
withType :: Int
8+
withType = 42
9+
10+
-- | This is
11+
-- | a multi-line
12+
-- | comment
13+
multiline = "multiline"

0 commit comments

Comments
 (0)