From e6ec661b898ec347bb6d3f92d2dc38a7aaa2738d Mon Sep 17 00:00:00 2001 From: Nicholas Wolverson Date: Fri, 27 Oct 2017 15:35:27 +0100 Subject: [PATCH] [purs ide] return documentation comments --- .../PureScript/Docs/Convert/Single.hs | 1 + src/Language/PureScript/Ide/Completion.hs | 2 +- src/Language/PureScript/Ide/State.hs | 85 +++++++++++++++---- src/Language/PureScript/Ide/Types.hs | 3 +- .../Language/PureScript/Ide/CompletionSpec.hs | 34 +++++++- .../pscide/src/CompletionSpecDocs.purs | 13 +++ 6 files changed, 118 insertions(+), 20 deletions(-) create mode 100644 tests/support/pscide/src/CompletionSpecDocs.purs diff --git a/src/Language/PureScript/Docs/Convert/Single.hs b/src/Language/PureScript/Docs/Convert/Single.hs index 98c8c90cca..deaccf2db5 100644 --- a/src/Language/PureScript/Docs/Convert/Single.hs +++ b/src/Language/PureScript/Docs/Convert/Single.hs @@ -1,5 +1,6 @@ module Language.PureScript.Docs.Convert.Single ( convertSingleModule + , convertComments ) where import Protolude hiding (moduleName) diff --git a/src/Language/PureScript/Ide/Completion.hs b/src/Language/PureScript/Ide/Completion.hs index b4e9f2ed66..eace77b3fa 100644 --- a/src/Language/PureScript/Ide/Completion.hs +++ b/src/Language/PureScript/Ide/Completion.hs @@ -130,7 +130,7 @@ completionFromMatch (Match (m, IdeDeclarationAnn ann decl), mns) = complLocation = _annLocation ann - complDocumentation = Nothing + complDocumentation = _annDocumentation ann showFixity p a r o = let asso = case a of diff --git a/src/Language/PureScript/Ide/State.hs b/src/Language/PureScript/Ide/State.hs index f7d7a57a6c..28211f9423 100644 --- a/src/Language/PureScript/Ide/State.hs +++ b/src/Language/PureScript/Ide/State.hs @@ -44,6 +44,7 @@ import Control.Lens hiding (op, (&)) import "monad-logger" Control.Monad.Logger import qualified Data.Map.Lazy as Map import qualified Language.PureScript as P +import Language.PureScript.Docs.Convert.Single (convertComments) import Language.PureScript.Externs import Language.PureScript.Ide.Externs import Language.PureScript.Ide.Reexports @@ -199,6 +200,7 @@ populateVolatileStateSTM ref = do moduleDeclarations & map resolveDataConstructorsForModule & resolveLocations asts + & resolveDocumentation (map fst modules) & resolveInstances externs & resolveOperators & resolveReexports reexportRefs @@ -221,23 +223,7 @@ resolveLocationsForModule (defs, types) decls = map convertDeclaration decls where convertDeclaration :: IdeDeclarationAnn -> IdeDeclarationAnn - convertDeclaration (IdeDeclarationAnn ann d) = case d of - IdeDeclValue v -> - annotateFunction (v ^. ideValueIdent) (IdeDeclValue v) - IdeDeclType t -> - annotateType (t ^. ideTypeName . properNameT) (IdeDeclType t) - IdeDeclTypeSynonym s -> - annotateType (s ^. ideSynonymName . properNameT) (IdeDeclTypeSynonym s) - IdeDeclDataConstructor dtor -> - annotateValue (dtor ^. ideDtorName . properNameT) (IdeDeclDataConstructor dtor) - IdeDeclTypeClass tc -> - annotateType (tc ^. ideTCName . properNameT) (IdeDeclTypeClass tc) - IdeDeclValueOperator operator -> - annotateValue (operator ^. ideValueOpName . opNameT) (IdeDeclValueOperator operator) - IdeDeclTypeOperator operator -> - annotateType (operator ^. ideTypeOpName . opNameT) (IdeDeclTypeOperator operator) - IdeDeclKind i -> - annotateKind (i ^. properNameT) (IdeDeclKind i) + convertDeclaration (IdeDeclarationAnn ann d) = convertDeclaration' annotateFunction annotateValue annotateType annotateKind d where annotateFunction x = IdeDeclarationAnn (ann { _annLocation = Map.lookup (IdeNamespaced IdeNSValue (P.runIdent x)) defs , _annTypeAnnotation = Map.lookup x types @@ -246,6 +232,71 @@ resolveLocationsForModule (defs, types) decls = annotateType x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSType x) defs}) annotateKind x = IdeDeclarationAnn (ann {_annLocation = Map.lookup (IdeNamespaced IdeNSKind x) defs}) +convertDeclaration' + :: (P.Ident -> IdeDeclaration -> IdeDeclarationAnn) + -> (Text -> IdeDeclaration -> IdeDeclarationAnn) + -> (Text -> IdeDeclaration -> IdeDeclarationAnn) + -> (Text -> IdeDeclaration -> IdeDeclarationAnn) + -> IdeDeclaration + -> IdeDeclarationAnn +convertDeclaration' annotateFunction annotateValue annotateType annotateKind d = + case d of + IdeDeclValue v -> + annotateFunction (v ^. ideValueIdent) d + IdeDeclType t -> + annotateType (t ^. ideTypeName . properNameT) d + IdeDeclTypeSynonym s -> + annotateType (s ^. ideSynonymName . properNameT) d + IdeDeclDataConstructor dtor -> + annotateValue (dtor ^. ideDtorName . properNameT) d + IdeDeclTypeClass tc -> + annotateType (tc ^. ideTCName . properNameT) d + IdeDeclValueOperator operator -> + annotateValue (operator ^. ideValueOpName . opNameT) d + IdeDeclTypeOperator operator -> + annotateType (operator ^. ideTypeOpName . opNameT) d + IdeDeclKind i -> + annotateKind (i ^. properNameT) d + +resolveDocumentation + :: ModuleMap P.Module + -> ModuleMap [IdeDeclarationAnn] + -> ModuleMap [IdeDeclarationAnn] +resolveDocumentation modules = + Map.mapWithKey (\mn decls -> + maybe decls (flip resolveDocumentationForModule decls) (Map.lookup mn modules)) + +resolveDocumentationForModule + :: P.Module + -> [IdeDeclarationAnn] + -> [IdeDeclarationAnn] +resolveDocumentationForModule (P.Module _ _ _ sdecls _) decls = map convertDecl decls + where + comments :: Map P.Name [P.Comment] + comments = Map.fromListWith (flip (<>)) $ mapMaybe (\d -> + case name d of + Just name' -> Just (name', snd $ P.declSourceAnn d) + _ -> Nothing) + sdecls + + name :: P.Declaration -> Maybe P.Name + name (P.TypeDeclaration d) = Just $ P.IdentName $ P.tydeclIdent d + name decl = P.declName decl + + convertDecl :: IdeDeclarationAnn -> IdeDeclarationAnn + convertDecl (IdeDeclarationAnn ann d) = + convertDeclaration' + (annotateValue . P.IdentName) + (annotateValue . P.IdentName . P.Ident) + (annotateValue . P.TyName . P.ProperName) + (annotateValue . P.KiName . P.ProperName) + d + where + docs :: P.Name -> Text + docs ident = fromMaybe "" $ convertComments =<< Map.lookup ident comments + + annotateValue ident = IdeDeclarationAnn (ann { _annDocumentation = Just $ docs ident }) + resolveInstances :: ModuleMap P.ExternsFile -> ModuleMap [IdeDeclarationAnn] diff --git a/src/Language/PureScript/Ide/Types.hs b/src/Language/PureScript/Ide/Types.hs index a19a2d72da..f013ace268 100644 --- a/src/Language/PureScript/Ide/Types.hs +++ b/src/Language/PureScript/Ide/Types.hs @@ -114,13 +114,14 @@ data Annotation { _annLocation :: Maybe P.SourceSpan , _annExportedFrom :: Maybe P.ModuleName , _annTypeAnnotation :: Maybe P.Type + , _annDocumentation :: Maybe Text } deriving (Show, Eq, Ord, Generic, NFData) makeLenses ''Annotation makeLenses ''IdeDeclarationAnn emptyAnn :: Annotation -emptyAnn = Annotation Nothing Nothing Nothing +emptyAnn = Annotation Nothing Nothing Nothing Nothing type DefinitionSites a = Map IdeNamespaced a type TypeAnnotations = Map P.Ident P.Type diff --git a/tests/Language/PureScript/Ide/CompletionSpec.hs b/tests/Language/PureScript/Ide/CompletionSpec.hs index 255d6974c6..4df331aad4 100644 --- a/tests/Language/PureScript/Ide/CompletionSpec.hs +++ b/tests/Language/PureScript/Ide/CompletionSpec.hs @@ -5,10 +5,12 @@ module Language.PureScript.Ide.CompletionSpec where import Protolude import Language.PureScript as P +import Language.PureScript.Ide.Test as Test +import Language.PureScript.Ide.Command as Command import Language.PureScript.Ide.Completion -import Language.PureScript.Ide.Test import Language.PureScript.Ide.Types import Test.Hspec +import System.FilePath reexportMatches :: [Match IdeDeclarationAnn] reexportMatches = @@ -21,6 +23,15 @@ reexportMatches = matches :: [(Match IdeDeclarationAnn, [P.ModuleName])] matches = map (\d -> (Match (mn "Main", d), [mn "Main"])) [ ideKind "Kind", ideType "Type" Nothing [] ] +typ :: Text -> Command +typ txt = Type txt [] Nothing + +load :: [Text] -> Command +load = LoadSync . map Test.mn + +rebuildSync :: FilePath -> Command +rebuildSync fp = RebuildSync ("src" fp) Nothing + spec :: Spec spec = describe "Applying completion options" $ do it "keeps all matches if maxResults is not specified" $ do @@ -32,3 +43,24 @@ spec = describe "Applying completion options" $ do it "groups reexports for a single identifier" $ do applyCompletionOptions (defaultCompletionOptions { coGroupReexports = True }) reexportMatches `shouldBe` [(Match (mn "A", ideKind "Kind"), [mn "A", mn "B"])] + + it "gets simple docs on definition itself" $ do + ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $ + Test.runIde [ load ["CompletionSpecDocs"] + , typ "something" + ] + result `shouldSatisfy` \res -> complDocumentation res == Just "Doc x\n" + + it "gets multiline docs" $ do + ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $ + Test.runIde [ load ["CompletionSpecDocs"] + , typ "multiline" + ] + result `shouldSatisfy` \res -> complDocumentation res == Just "This is\na multi-line\ncomment\n" + + it "gets simple docs on type annotation" $ do + ([_, (Right (CompletionResult [ result ]))], _) <- Test.inProject $ + Test.runIde [ load ["CompletionSpecDocs"] + , typ "withType" + ] + result `shouldSatisfy` \res -> complDocumentation res == Just "Doc *123*\n" \ No newline at end of file diff --git a/tests/support/pscide/src/CompletionSpecDocs.purs b/tests/support/pscide/src/CompletionSpecDocs.purs new file mode 100644 index 0000000000..1c92a37752 --- /dev/null +++ b/tests/support/pscide/src/CompletionSpecDocs.purs @@ -0,0 +1,13 @@ +module CompletionSpecDocs where + +-- | Doc x +something = "something" + +-- | Doc *123* +withType :: Int +withType = 42 + +-- | This is +-- | a multi-line +-- | comment +multiline = "multiline" \ No newline at end of file