diff --git a/CHANGELOG.md b/CHANGELOG.md index 52fa188..45e0146 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Changelog +### 0.17.1 + +- Fix workspace symbol provider + ### 0.17.0 - Diagnostics on type courtesy of @wclr. diff --git a/packages.dhall b/packages.dhall index 4593138..81ac7f6 100644 --- a/packages.dhall +++ b/packages.dhall @@ -46,4 +46,4 @@ in upstream with literals.repo = "https://github.com/ilyakooo0/purescript-literals.git" with literals.version = "6875fb28026595cfb780318305a77e79b098bb01" - + with psc-ide.version = "7c331b33cedebb636d72ab5fd325821e304b9833" \ No newline at end of file diff --git a/src/IdePurescript/PscIde.purs b/src/IdePurescript/PscIde.purs index 16e91d6..a678028 100644 --- a/src/IdePurescript/PscIde.purs +++ b/src/IdePurescript/PscIde.purs @@ -1,20 +1,22 @@ module IdePurescript.PscIde - ( getCompletion - , getCompletion' - , typesInModule + ( ModuleSearchResult + , SearchResult , cwd - , loadDeps - , getType , eitherToErr - , getPursuitModuleCompletion - , getPursuitCompletion , getAvailableModules + , getCompletion + , getCompletion' , getLoadedModules - , SearchResult - , ModuleSearchResult - , getTypeInfo , getModuleInfo - ) where + , getPursuitCompletion + , getPursuitModuleCompletion + , getType + , getTypeInfo + , getTypeInfoWithImportFilter + , loadDeps + , typesInModule + ) + where import Prelude @@ -92,6 +94,19 @@ getTypeInfo moduleFilters = [ C.ModuleFilter $ maybe unqualModules getQualifiedModule modulePrefix ] +-- new version of getTypeInfo for newer `purs` +getTypeInfoWithImportFilter :: + Int -> + String -> + Maybe String -> + Maybe String -> + (Array String) -> + Aff (Maybe C.TypeInfo) +getTypeInfoWithImportFilter port text currentModule qualifier importLines = + result head $ P.type' port text moduleFilters currentModule + where + moduleFilters = [ C.DependencyFilter qualifier importLines ] + getModuleInfo :: Int -> String -> Aff (Maybe C.TypeInfo) getModuleInfo port text = result head $ P.type' port text filters Nothing diff --git a/src/IdePurescript/PscIdeServer.purs b/src/IdePurescript/PscIdeServer.purs index f536bf2..9354d04 100644 --- a/src/IdePurescript/PscIdeServer.purs +++ b/src/IdePurescript/PscIdeServer.purs @@ -1,12 +1,15 @@ module IdePurescript.PscIdeServer - ( startServer + ( ErrorLevel(..) + , Notify(..) + , Port + , ServerStartResult(..) + , Version(..) + , parseVersion + , startServer , startServer' , stopServer - , ServerStartResult(..) - , Port - , ErrorLevel(..) - , Notify(..) - ) where + ) + where import Prelude @@ -89,7 +92,7 @@ startServer' :: Boolean -> Notify -> Notify -> - Aff { quit :: Aff Unit, port :: Maybe Int } + Aff { quit :: Aff Unit, port :: Maybe Int, purs :: Maybe Executable } startServer' settings@({ exe: server }) path addNpmBin cb logCb = do pathVar <- liftEffect $ getPathVar addNpmBin path serverBins <- findBins pathVar server @@ -108,19 +111,20 @@ startServer' settings@({ exe: server }) path addNpmBin cb logCb = do $ "Couldn't find IDE server, looked for: " <> server <> " using PATH env variable." - pure { quit: pure unit, port: Nothing } - Just srvExec@(Executable bin _version) -> do + pure { quit: pure unit, port: Nothing, purs: Nothing } + Just purs@(Executable bin _version) -> do liftEffect $ logCb Info $ "Using found IDE server bin (npm-bin: " <> show addNpmBin <> "): " - <> printSrvExec srvExec + <> printSrvExec purs res <- startServer logCb (settings { exe = bin }) path - let noRes = { quit: pure unit, port: Nothing } + let noRes = { quit: pure unit, port: Nothing, purs: Just purs } liftEffect $ case res of - CorrectPath usedPort -> { quit: pure unit, port: Just usedPort } <$ + -- Unfortunately don't have the purs version here, with any luck it's the same as the one we found in path + CorrectPath usedPort -> { quit: pure unit, port: Just usedPort, purs: Just purs } <$ cb Info ( "Found existing IDE server with correct path on port " <> show usedPort @@ -142,6 +146,7 @@ startServer' settings@({ exe: server }) path addNpmBin cb logCb = do pure { quit: stopServer usedPort path cp , port: Just usedPort + , purs: Just purs } Closed -> noRes <$ cb Info "IDE server exited with success code" StartError err -> noRes <$ diff --git a/src/LanguageServer/IdePurescript/Main.purs b/src/LanguageServer/IdePurescript/Main.purs index fee167f..e3ca045 100644 --- a/src/LanguageServer/IdePurescript/Main.purs +++ b/src/LanguageServer/IdePurescript/Main.purs @@ -79,6 +79,7 @@ defaultServerState = { port: Nothing , deactivate: pure unit , root: Nothing + , purs: Nothing , conn: Nothing , modules: initialModulesState , modulesFile: Nothing @@ -275,7 +276,7 @@ mkStartPscIdeServer config conn state notify = do settings <- liftEffect $ Ref.read config startRes <- Server.startServer' settings rootPath notify notify Server.retry notify 6 case startRes of - { port: Just port, quit } -> do + { port: Just port, quit, purs } -> do Server.loadAll port >>= case _ of Left msg @@ -446,9 +447,7 @@ handleEvents config conn state documents notify = do (getReferences documents) onHover conn $ runHandler - "onHover" - getTextDocUri - (getTooltips documents) + "onHover" getTextDocUri (getTooltips notify documents) onCodeAction conn $ runHandler "onCodeAction" diff --git a/src/LanguageServer/IdePurescript/Server.purs b/src/LanguageServer/IdePurescript/Server.purs index a737ca1..04d2a39 100644 --- a/src/LanguageServer/IdePurescript/Server.purs +++ b/src/LanguageServer/IdePurescript/Server.purs @@ -56,7 +56,7 @@ startServer' :: String -> Notify -> Notify -> - Aff { port :: Maybe Int, quit :: Aff Unit } + Aff { port :: Maybe Int, quit :: Aff Unit, purs :: Maybe Executable } startServer' settings root cb logCb = do envIdeSources <- getEnvPursIdeSources packageGlobs <- case envIdeSources of diff --git a/src/LanguageServer/IdePurescript/Tooltips.purs b/src/LanguageServer/IdePurescript/Tooltips.purs index 15435c5..443d497 100644 --- a/src/LanguageServer/IdePurescript/Tooltips.purs +++ b/src/LanguageServer/IdePurescript/Tooltips.purs @@ -5,7 +5,9 @@ module LanguageServer.IdePurescript.Tooltips import Prelude import Data.Array (uncons) -import Data.Maybe (Maybe(..), fromMaybe, isJust) +import Data.Foldable (foldMap) +import Data.Map as Map +import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe) import Data.Newtype (un) import Data.Nullable (Nullable, toNullable) import Data.Nullable as Nullable @@ -13,32 +15,41 @@ import Data.String as String import Effect.Aff (Aff) import Effect.Class (liftEffect) import IdePurescript.Modules (getQualModule, getUnqualActiveModules) -import IdePurescript.PscIde (getTypeInfo) +import IdePurescript.PscIde (getTypeInfo, getTypeInfoWithImportFilter) +import IdePurescript.PscIdeServer (ErrorLevel(..), Notify, Version(..), parseVersion) import IdePurescript.Tokens (identifierAtPoint) import LanguageServer.IdePurescript.Types (ServerState(..)) +import LanguageServer.IdePurescript.Util (maybeParseResult) import LanguageServer.Protocol.DocumentStore (getDocument) import LanguageServer.Protocol.Handlers (TextDocumentPositionParams) import LanguageServer.Protocol.TextDocument (getTextAtRange) import LanguageServer.Protocol.Types (DocumentStore, Hover(Hover), Position(Position), Range(Range), Settings, TextDocumentIdentifier(TextDocumentIdentifier), markupContent) import Literals.Undefined (undefined) import PscIde.Command as C +import PscIde.Server (Executable(..)) +import PureScript.CST.Print as CST.Print +import PureScript.CST.Range (class TokensOf) as CST +import PureScript.CST.Range (tokensOf) +import PureScript.CST.Range.TokenList as TokenList +import PureScript.CST.Types (Module(..), ModuleHeader(..)) as CST import Untagged.Union (asOneOf) -getTooltips :: - DocumentStore -> - Settings -> - ServerState -> - TextDocumentPositionParams -> - Aff (Nullable Hover) -getTooltips docs _ state ({ textDocument, position }) = toNullable <$> do - maybeDoc <- liftEffect $ getDocument docs - (_.uri $ un TextDocumentIdentifier textDocument) +dependencyFilterAvailable :: ServerState -> Boolean +dependencyFilterAvailable (ServerState { purs }) = case purs of + Just (Executable _bin (Just vStr)) | Just version <- parseVersion vStr -> + version >= Version 0 15 7 + _ -> false + +getTooltips :: Notify -> DocumentStore -> Settings -> ServerState -> TextDocumentPositionParams -> Aff (Nullable Hover) +getTooltips notify docs _ state ({ textDocument, position }) = toNullable <$> do + let uri = (_.uri $ un TextDocumentIdentifier textDocument) + maybeDoc <- liftEffect $ getDocument docs uri case Nullable.toMaybe maybeDoc of Nothing -> pure Nothing Just doc -> do text <- liftEffect $ getTextAtRange doc $ lineRange position let - { port, modules } = un ServerState state + { port, modules, parsedModules } = un ServerState state char = _.character $ un Position $ position case port, identifierAtPoint text char of Just port', Just { word, qualifier, range: range@{ left } } -> do @@ -57,12 +68,31 @@ getTooltips docs _ state ({ textDocument, position }) = toNullable <$> do } _ -> Nothing _ -> do - ty <- getTypeInfo port' word modules.main qualifier - (getUnqualActiveModules modules $ Just word) - (flip getQualModule modules) - pure $ map (convertInfo word) ty + map (convertInfo word) <$> + if dependencyFilterAvailable state then do + imports <- getImports uri parsedModules + getTypeInfoWithImportFilter port' word modules.main qualifier imports + else + getTypeInfo port' word modules.main qualifier (getUnqualActiveModules modules $ Just word) (flip getQualModule modules) + _, _ -> pure Nothing where + + getImports uri parsedModules = + case Map.lookup uri parsedModules of + Just { parsed } -> + pure $ maybeParseResult [] parseImports parsed + Nothing -> do + liftEffect $ notify Warning $ "tooltips - no parsed CST for " <> show uri + pure [] + + parseImports :: forall a. CST.TokensOf a => CST.Module a -> Array String + parseImports (CST.Module { header: CST.ModuleHeader { imports } }) = + let + printImport imp = + String.trim $ foldMap CST.Print.printSourceToken (TokenList.toArray (tokensOf imp)) + in + printImport <$> imports convertInfo word (C.TypeInfo { type', expandedType, documentation }) = Hover diff --git a/src/LanguageServer/IdePurescript/Types.purs b/src/LanguageServer/IdePurescript/Types.purs index a4799d3..8700d25 100644 --- a/src/LanguageServer/IdePurescript/Types.purs +++ b/src/LanguageServer/IdePurescript/Types.purs @@ -19,6 +19,7 @@ import IdePurescript.Modules (State) as Modules import LanguageServer.Protocol.TextDocument (TextDocument) import LanguageServer.Protocol.Types (ClientCapabilities, Connection, Diagnostic, DocumentStore, DocumentUri, Settings) import PscIde.Command (RebuildError) +import PscIde.Server (Executable(..)) import PureScript.CST (RecoveredParserResult) import PureScript.CST.Types (Module) @@ -35,15 +36,18 @@ data RebuildRunning | FastRebuild (Map DocumentUri TextDocument) | DiagnosticsRebuild (Map DocumentUri TextDocument) -type ServerStateRec = - { port :: Maybe Int +type ServerStateRec + = { -- purs ide state + -- TODO merge this into one Maybe + port :: Maybe Int , root :: Maybe String + , deactivate :: Aff Unit + , purs :: Maybe Executable + -- LSP state , conn :: Maybe Connection , clientCapabilities :: Maybe ClientCapabilities - , deactivate :: Aff Unit -- - , runningRebuild :: - Maybe { fiber :: Fiber Unit, uri :: DocumentUri, version :: Number } + , runningRebuild :: Maybe { fiber :: Fiber Unit, uri :: DocumentUri, version :: Number } -- , rebuildRunning :: Maybe RebuildRunning , fastRebuildQueue :: Map DocumentUri TextDocument @@ -53,6 +57,7 @@ type ServerStateRec = , savedCacheDb :: Maybe CacheDb , revertCacheDbTimeout :: Maybe TimeoutId -- + -- state updated on document change , modules :: Modules.State , modulesFile :: Maybe DocumentUri , diagnostics :: DiagnosticState @@ -69,4 +74,4 @@ newtype ServerState = ServerState ServerStateRec derive instance newtypeServerState :: Newtype ServerState _ type CommandHandler a = - DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff a \ No newline at end of file + DocumentStore -> Settings -> ServerState -> Array Foreign -> Aff a diff --git a/src/LanguageServer/IdePurescript/Util.purs b/src/LanguageServer/IdePurescript/Util.purs index ed94700..0fe8192 100644 --- a/src/LanguageServer/IdePurescript/Util.purs +++ b/src/LanguageServer/IdePurescript/Util.purs @@ -10,7 +10,7 @@ import Effect (Effect) import Effect.Aff (Aff, Fiber, runAff) import IdePurescript.PscIdeServer (ErrorLevel(..), Notify) import PureScript.CST (RecoveredParserResult(..)) -import PureScript.CST.Range (class RangeOf) +import PureScript.CST.Range (class RangeOf, class TokensOf) import PureScript.CST.Types (Module) launchAffLog :: forall a. Notify -> Aff a -> Effect (Fiber Unit) @@ -20,7 +20,7 @@ launchAffLog notify = maybeParseResult :: forall a. a -> - (forall b. RangeOf b => Module b -> a) -> + (forall b. RangeOf b => TokensOf b => Module b -> a) -> RecoveredParserResult Module -> a maybeParseResult default f =