From 611da62d2ea236cc1eaaf7d2b510cc31a9ad92ad Mon Sep 17 00:00:00 2001 From: Jana Chadt Date: Wed, 31 May 2023 09:13:56 +0200 Subject: [PATCH] Refactor completion code to its own module --- .../hls-cabal-plugin/hls-cabal-plugin.cabal | 1 + .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 280 +--------------- .../src/Ide/Plugin/Cabal/Completions.hs | 310 ++++++++++++++++++ 3 files changed, 313 insertions(+), 278 deletions(-) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 7e33dd0036e..37b5f48869e 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -27,6 +27,7 @@ library exposed-modules: Ide.Plugin.Cabal Ide.Plugin.Cabal.Diagnostics + Ide.Plugin.Cabal.Completions Ide.Plugin.Cabal.LicenseSuggest Ide.Plugin.Cabal.Parse diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 58f03e1424a..21df429f015 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -20,26 +20,20 @@ import qualified Data.ByteString as BS import Data.Hashable import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import qualified Data.List as List -import qualified Data.List.Extra as Extra import qualified Data.List.NonEmpty as NE -import Data.Map (Map) -import qualified Data.Map as Map -import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding import qualified Data.Text.Utf16.Rope as Rope import Data.Typeable -import Debug.Trace import Development.IDE as D import Development.IDE.Core.Shake (restartShakeSession) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.Graph (alwaysRerun) import Distribution.Compat.Lens ((^.)) import GHC.Generics +import Ide.Plugin.Cabal.Completions import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest import qualified Ide.Plugin.Cabal.Parse as Parse -import Ide.Plugin.Config (Config) import Ide.Types import qualified Language.LSP.Server as LSP import Language.LSP.Types @@ -48,7 +42,6 @@ import qualified Language.LSP.Types as LSP import qualified Language.LSP.Types.Lens as JL import Language.LSP.VFS (VirtualFile) import qualified Language.LSP.VFS as VFS -import qualified Text.Fuzzy.Parallel as Fuzzy data Log @@ -288,7 +281,7 @@ completion _ide _ complParams = do result :: Maybe VFS.PosPrefixInfo -> VirtualFile -> J.List CompletionItem result Nothing _ = J.List [] result (Just pfix) cnts - | pos ^. JL.line == 0 = case traceShowId $ context of + | pos ^. JL.line == 0 = case context of Just (_, kw) | KeyWord _ <- kw -> J.List $ map buildCompletion $ snd cabalVersionKeyword _ -> J.List [buildCompletion (fst cabalVersionKeyword)] @@ -297,272 +290,3 @@ completion _ide _ complParams = do where pos = VFS.cursorPos pfix context = getContext pos (Rope.lines $ cnts ^. VFS.file_text) - --- | Takes a context and returns all possible completions within that context -getCompletionsForContext :: Context -> [T.Text] --- if we are in the top level of the cabal file and not in a keyword context, --- we can write any toplevel keywords or a stanza declaration -getCompletionsForContext (TopLevel, None) = - Map.keys cabalKeywords ++ Map.keys stanzaKeywordMap --- if we are in a keyword context in the toplevel, --- we look up that keyword in the toplevel context and can complete its possible values -getCompletionsForContext (TopLevel, KeyWord kw) = - case Map.lookup kw cabalKeywords of - Nothing -> [] - Just l -> l --- if we are in a stanza and not in a keyword context, --- we can write any of the stanza's keywords or a stanza declaration -getCompletionsForContext (Stanza s, None) = - case Map.lookup s stanzaKeywordMap of - Nothing -> [] - Just l -> Map.keys l ++ Map.keys stanzaKeywordMap --- if we are in a stanza's keyword's context we can complete possible values of that keyword -getCompletionsForContext (Stanza s, KeyWord kw) = - case Map.lookup s stanzaKeywordMap of - Nothing -> [] - Just m -> case Map.lookup kw m of - Nothing -> [] - Just l -> l - --- | Takes a position and a list of lines (representing a file) --- and returns the context of the current position --- can return Nothing if an error occurs -getContext :: Position -> [T.Text] -> Maybe Context -getContext pos ls = - case lvlContext of - TopLevel -> do - kwContext <- getKeyWordContext pos ls (uncurry Map.insert cabalVersionKeyword cabalKeywords) - pure (TopLevel, kwContext) - Stanza s -> - case Map.lookup (traceShowId s) stanzaKeywordMap of - Nothing -> do - pure (Stanza s, None) - Just m -> do - kwContext <- getKeyWordContext pos ls m - pure (Stanza s, kwContext) - where - lvlContext = findCurrentLevel (getPreviousLines pos ls) - --- | Takes a position, a list of lines (representing a file) and a map of keywords as keys --- and returns a keyword context if there is a keyword from the map before the current position --- in the given line list -getKeyWordContext :: Position -> [T.Text] -> Map T.Text a -> Maybe KeyWordContext -getKeyWordContext pos ls keywords = do - curLine <- fmap T.stripStart currentLine - case List.find (`T.isPrefixOf` curLine) (Map.keys keywords) of - Nothing -> Just None - Just kw -> Just $ KeyWord kw - where - currentLine = ls Extra.!? (fromIntegral $ pos ^. JL.line) - --- | Takes info about the current cursor position and a set of possible keywords --- and creates completion suggestions that fit the current input from the given list -makeCompletionItems :: VFS.PosPrefixInfo -> [T.Text] -> [CompletionItem] -makeCompletionItems pfix l = - map - (buildCompletion . Fuzzy.original) - (Fuzzy.simpleFilter 1000 10 (VFS.prefixText pfix) l) - --- | Parse the given set of lines (starting before current cursor position --- up to the start of the file) to find the nearest stanza declaration, --- if none is found we are in the top level -findCurrentLevel :: [T.Text] -> LevelContext -findCurrentLevel [] = TopLevel -findCurrentLevel (cur : xs) - | Just s <- stanza = Stanza s - | otherwise = findCurrentLevel xs - where - stanza = List.find (`T.isPrefixOf` cur) (Map.keys stanzaKeywordMap) - --- | Get all lines before the given cursor position in the given file --- and reverse them since we want to traverse starting from our current position -getPreviousLines :: Position -> [T.Text] -> [T.Text] -getPreviousLines pos ls = reverse $ take (fromIntegral currentLine) ls - where - currentLine = pos ^. JL.line - --- | The context a cursor can be in within a cabal file, --- we can be in stanzas or the toplevel, --- and additionally we can be in a context where we have already written a keyword --- but no value for it yet -type Context = (LevelContext, KeyWordContext) - -data LevelContext - = TopLevel - -- ^ Top level context in a cabal file such as 'author' - | Stanza T.Text - -- ^ Nested context in a cabal file, such as 'library', which has nested keywords, specific to the stanza - deriving (Eq, Show) - --- | Keyword context in cabal file -data KeyWordContext - = KeyWord T.Text - -- ^ We are in a line with the given keyword before our cursor - | None - -- ^ We are in a line with no keyword context - deriving (Eq, Show) - --- | Keyword for cabal version required to be the top line in a cabal file -cabalVersionKeyword :: (T.Text,[T.Text]) -cabalVersionKeyword = ("cabal-version:", ["2.0", "2.2", "2.4", "3.0"]) - - --- todo: we could add file path completion for file path fields --- we could add descriptions of field values and then show them when inside the field's context --- | Top level keywords of a cabal file -cabalKeywords :: Map T.Text [T.Text] -cabalKeywords = - Map.fromList [ - ("name:", []), - ("version:", []), - ("build-type:", ["Simple", "Custom"]), - ("license:", ["NONE"]), - ("license-file:", []), - ("license-files:",[]), - ("copyright:", []), - ("author:", []), - ("maintainer:",[]), - ("stability:",[]), - ("homepage:",[]), - ("bug-reports:",[]), - ("package-url:",[]), - ("synopsis:",[]), - ("description:",[]), - ("category:",[]), - ("tested-with:",["GHC"]), - ("data-files:", []), - ("data-dir:", []), - ("data-dir:", []), - ("extra-source-files:", []), - ("extra-doc-files:", []), - ("extra-tmp-files:", []) - ] - --- | Map, containing all stanzas in a cabal file as keys and lists of their possible nested keywords as values -stanzaKeywordMap :: Map T.Text (Map T.Text [T.Text]) -stanzaKeywordMap = - Map.fromList - [ ( "library", - Map.fromList $ - [ ("exposed-modules:", []), - ("virtual-modules:", []), - ("exposed:", ["True", "False"]), - ("visibility:", ["private", "public"]), - ("reexported-modules:", []), - ("signatures:", []) - ] - ++ libExecTestBenchCommons - ), - ( "executable", - Map.fromList $ - [ ("main-is:", []), - ("scope:", ["public", "private"]) - ] - ++ libExecTestBenchCommons - ), - ( "test-suite", - Map.fromList $ - [ ("type:", ["exitcode-stdio-1.0"]), - ("main-is:", []) - ] - ++ libExecTestBenchCommons - ), - ( "benchmark", - Map.fromList $ - [ ("type:", []), - ("main-is:", []) - ] - ++ libExecTestBenchCommons - ), - ( "foreign-library", - Map.fromList - [ ("type:", []), - ("options:", []), - ("mod-def-file:", []), - ("lib-def-file:", []), - ("lib-version-info:", []), - ("lib-version-linux:", []) - ] - ), - ( "flag", - Map.fromList - [ ("description:", []), - ("default:", ["True", "False"]), - ("manual:", ["False", "True"]), - ("lib-def-file:", []), - ("lib-version-info:", []), - ("lib-version-linux:", []) - ] - ) - ] - where - libExecTestBenchCommons = - [ ("build-depends:", []), - ("other-modules:", []), - ("hs-source-dir:", ["."]), - ("hs-source-dirs:", ["."]), - ("default-extensions:", []), - ("other-extensions:", []), - ("default-language:", []), - ("build-tool-depends:", []), - ("buildable:", ["True", "False"]), - -- todo maybe there is a list of possible ghc options somewhere - ("ghc-options:", []), - ("ghc-prof-options:", []), - ("ghc-shared-options:", []), - ("ghcjs-options:", []), - ("ghcjs-prof-options:", []), - ("ghcjs-shared-options:", []), - ("includes:", []), - ("install-includes:", []), - ("include-dirs:", []), - ("c-sources:", []), - ("cxx-sources:", []), - ("asm-sources:", []), - ("cmm-sources:", []), - ("js-sources:", []), - ("extra-libraries:", []), - ("extra-ghci-libraries:", []), - ("extra-bundled-libraries:", []), - ("extra-lib-dirs:", []), - ("cc-options:", []), - ("cpp-options:", []), - ("cxx-options:", []), - ("cmm-options:", []), - ("asm-options:", []), - ("ld-options:", []), - ("pkgconfig-depends:", []), - ("frameworks:", []), - ("extra-framework-dirs:", []), - ("mixins:", []) - ] - --- cabalFlagKeywords :: [(T.Text, T.Text)] --- cabalFlagKeywords = --- [ --- ("flag", "name"), --- ("description:", "freeform"), --- ("default:", "boolean"), --- ("manual:", "boolean") --- ] - --- cabalStanzaKeywords :: [(T.Text, T.Text)] --- cabalStanzaKeywords = --- [ --- ("common", "name"), --- ("import:", "token-list") --- ] - --- cabalSourceRepoKeywords :: [(T.Text, T.Text)] --- cabalSourceRepoKeywords = --- [ --- ("source-repository", ""), --- ("type:", "token"), --- ("location:", "URL") --- ] - -buildCompletion :: T.Text -> J.CompletionItem -buildCompletion label = - J.CompletionItem label (Just J.CiKeyword) Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing Nothing - Nothing Nothing Nothing Nothing Nothing Nothing diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs new file mode 100644 index 00000000000..0f18771dd07 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs @@ -0,0 +1,310 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.Cabal.Completions where + +import qualified Data.List as List +import qualified Data.List.Extra as Extra +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Text as T +import Development.IDE as D +import Distribution.Compat.Lens ((^.)) +import Language.LSP.Types +import qualified Language.LSP.Types as J +import qualified Language.LSP.Types.Lens as JL +import qualified Language.LSP.VFS as VFS +import qualified Text.Fuzzy.Parallel as Fuzzy + +-- | Takes a context and returns all possible completions within that context +getCompletionsForContext :: Context -> [T.Text] +-- if we are in the top level of the cabal file and not in a keyword context, +-- we can write any toplevel keywords or a stanza declaration +getCompletionsForContext (TopLevel, None) = + Map.keys cabalKeywords ++ Map.keys stanzaKeywordMap +-- if we are in a keyword context in the toplevel, +-- we look up that keyword in the toplevel context and can complete its possible values +getCompletionsForContext (TopLevel, KeyWord kw) = + case Map.lookup kw cabalKeywords of + Nothing -> [] + Just l -> l +-- if we are in a stanza and not in a keyword context, +-- we can write any of the stanza's keywords or a stanza declaration +getCompletionsForContext (Stanza s, None) = + case Map.lookup s stanzaKeywordMap of + Nothing -> [] + Just l -> Map.keys l ++ Map.keys stanzaKeywordMap +-- if we are in a stanza's keyword's context we can complete possible values of that keyword +getCompletionsForContext (Stanza s, KeyWord kw) = + case Map.lookup s stanzaKeywordMap of + Nothing -> [] + Just m -> case Map.lookup kw m of + Nothing -> [] + Just l -> l + +-- | Takes a position and a list of lines (representing a file) +-- and returns the context of the current position +-- can return Nothing if an error occurs +getContext :: Position -> [T.Text] -> Maybe Context +getContext pos ls = + case lvlContext of + TopLevel -> do + kwContext <- getKeyWordContext pos ls (uncurry Map.insert cabalVersionKeyword cabalKeywords) + pure (TopLevel, kwContext) + Stanza s -> + case Map.lookup s stanzaKeywordMap of + Nothing -> do + pure (Stanza s, None) + Just m -> do + kwContext <- getKeyWordContext pos ls m + pure (Stanza s, kwContext) + where + lvlContext = findCurrentLevel (getPreviousLines pos ls) + +-- | Takes a position, a list of lines (representing a file) and a map of keywords as keys +-- and returns a keyword context if there is a keyword from the map before the current position +-- in the given line list +getKeyWordContext :: Position -> [T.Text] -> Map T.Text a -> Maybe KeyWordContext +getKeyWordContext pos ls keywords = do + curLine <- fmap T.stripStart currentLine + case List.find (`T.isPrefixOf` curLine) (Map.keys keywords) of + Nothing -> Just None + Just kw -> Just $ KeyWord kw + where + currentLine = ls Extra.!? (fromIntegral $ pos ^. JL.line) + +-- | Takes info about the current cursor position and a set of possible keywords +-- and creates completion suggestions that fit the current input from the given list +makeCompletionItems :: VFS.PosPrefixInfo -> [T.Text] -> [CompletionItem] +makeCompletionItems pfix l = + map + (buildCompletion . Fuzzy.original) + (Fuzzy.simpleFilter 1000 10 (VFS.prefixText pfix) l) + +-- | Parse the given set of lines (starting before current cursor position +-- up to the start of the file) to find the nearest stanza declaration, +-- if none is found we are in the top level +findCurrentLevel :: [T.Text] -> LevelContext +findCurrentLevel [] = TopLevel +findCurrentLevel (cur : xs) + | Just s <- stanza = Stanza s + | otherwise = findCurrentLevel xs + where + stanza = List.find (`T.isPrefixOf` cur) (Map.keys stanzaKeywordMap) + +-- | Get all lines before the given cursor position in the given file +-- and reverse them since we want to traverse starting from our current position +getPreviousLines :: Position -> [T.Text] -> [T.Text] +getPreviousLines pos ls = reverse $ take (fromIntegral currentLine) ls + where + currentLine = pos ^. JL.line + +-- | The context a cursor can be in within a cabal file, +-- we can be in stanzas or the toplevel, +-- and additionally we can be in a context where we have already written a keyword +-- but no value for it yet +type Context = (LevelContext, KeyWordContext) + +-- is used to decide which keywords to suggest +data LevelContext + = TopLevel + -- ^ Top level context in a cabal file such as 'author' + | Stanza T.Text + -- ^ Nested context in a cabal file, such as 'library', which has nested keywords, specific to the stanza + deriving (Eq, Show) + +-- | Keyword context in cabal file +-- is used to decide whether to suggest values or keywords +data KeyWordContext + = KeyWord T.Text + -- ^ Key word context, where a keyword + -- occurs right before the current position + -- with no value associated to it + | None + -- ^ Keyword context where no keyword occurs + -- right before the current position + deriving (Eq, Show) + + +-- | Describes the line at the current cursor position +data PosPrefixInfo = PosPrefixInfo + { fullLine :: !T.Text + -- ^ The full contents of the line the cursor is at + + , prefixScope :: !T.Text + -- ^ If any, the module name that was typed right before the cursor position. + -- For example, if the user has typed "Data.Maybe.from", then this property + -- will be "Data.Maybe" + -- If OverloadedRecordDot is enabled, "Shape.rect.width" will be + -- "Shape.rect" + + , prefixText :: !T.Text + -- ^ The word right before the cursor position, after removing the module part. + -- For example if the user has typed "Data.Maybe.from", + -- then this property will be "from" + , cursorPos :: !J.Position + -- ^ The cursor position + } deriving (Show,Eq) + +-- | Keyword for cabal version; required to be the top line in a cabal file +cabalVersionKeyword :: (T.Text,[T.Text]) +cabalVersionKeyword = ("cabal-version:", ["2.0", "2.2", "2.4", "3.0"]) + +-- todo: we could add file path completion for file path fields +-- we could add descriptions of field values and then show them when inside the field's context +-- | Top level keywords of a cabal file +cabalKeywords :: Map T.Text [T.Text] +cabalKeywords = + Map.fromList [ + ("name:", []), + ("version:", []), + ("build-type:", ["Simple", "Custom"]), + ("license:", ["NONE"]), + ("license-file:", []), + ("license-files:",[]), + ("copyright:", []), + ("author:", []), + ("maintainer:",[]), + ("stability:",[]), + ("homepage:",[]), + ("bug-reports:",[]), + ("package-url:",[]), + ("synopsis:",[]), + ("description:",[]), + ("category:",[]), + ("tested-with:",["GHC"]), + ("data-files:", []), + ("data-dir:", []), + ("data-dir:", []), + ("extra-source-files:", []), + ("extra-doc-files:", []), + ("extra-tmp-files:", []) + ] + +-- | Map, containing all stanzas in a cabal file as keys and lists of their possible nested keywords as values +stanzaKeywordMap :: Map T.Text (Map T.Text [T.Text]) +stanzaKeywordMap = + Map.fromList + [ ( "library", + Map.fromList $ + [ ("exposed-modules:", []), + ("virtual-modules:", []), + ("exposed:", ["True", "False"]), + ("visibility:", ["private", "public"]), + ("reexported-modules:", []), + ("signatures:", []) + ] + ++ libExecTestBenchCommons + ), + ( "executable", + Map.fromList $ + [ ("main-is:", []), + ("scope:", ["public", "private"]) + ] + ++ libExecTestBenchCommons + ), + ( "test-suite", + Map.fromList $ + [ ("type:", ["exitcode-stdio-1.0"]), + ("main-is:", []) + ] + ++ libExecTestBenchCommons + ), + ( "benchmark", + Map.fromList $ + [ ("type:", []), + ("main-is:", []) + ] + ++ libExecTestBenchCommons + ), + ( "foreign-library", + Map.fromList + [ ("type:", []), + ("options:", []), + ("mod-def-file:", []), + ("lib-def-file:", []), + ("lib-version-info:", []), + ("lib-version-linux:", []) + ] + ), + ( "flag", + Map.fromList + [ ("description:", []), + ("default:", ["True", "False"]), + ("manual:", ["False", "True"]), + ("lib-def-file:", []), + ("lib-version-info:", []), + ("lib-version-linux:", []) + ] + ) + ] + where + libExecTestBenchCommons = + [ ("build-depends:", []), + ("other-modules:", []), + ("hs-source-dir:", ["."]), + ("hs-source-dirs:", ["."]), + ("default-extensions:", []), + ("other-extensions:", []), + ("default-language:", []), + ("build-tool-depends:", []), + ("buildable:", ["True", "False"]), + -- todo maybe there is a list of possible ghc options somewhere + ("ghc-options:", []), + ("ghc-prof-options:", []), + ("ghc-shared-options:", []), + ("ghcjs-options:", []), + ("ghcjs-prof-options:", []), + ("ghcjs-shared-options:", []), + ("includes:", []), + ("install-includes:", []), + ("include-dirs:", []), + ("c-sources:", []), + ("cxx-sources:", []), + ("asm-sources:", []), + ("cmm-sources:", []), + ("js-sources:", []), + ("extra-libraries:", []), + ("extra-ghci-libraries:", []), + ("extra-bundled-libraries:", []), + ("extra-lib-dirs:", []), + ("cc-options:", []), + ("cpp-options:", []), + ("cxx-options:", []), + ("cmm-options:", []), + ("asm-options:", []), + ("ld-options:", []), + ("pkgconfig-depends:", []), + ("frameworks:", []), + ("extra-framework-dirs:", []), + ("mixins:", []) + ] + +-- cabalFlagKeywords :: [(T.Text, T.Text)] +-- cabalFlagKeywords = +-- [ +-- ("flag", "name"), +-- ("description:", "freeform"), +-- ("default:", "boolean"), +-- ("manual:", "boolean") +-- ] + +-- cabalStanzaKeywords :: [(T.Text, T.Text)] +-- cabalStanzaKeywords = +-- [ +-- ("common", "name"), +-- ("import:", "token-list") +-- ] + +-- cabalSourceRepoKeywords :: [(T.Text, T.Text)] +-- cabalSourceRepoKeywords = +-- [ +-- ("source-repository", ""), +-- ("type:", "token"), +-- ("location:", "URL") +-- ] + +buildCompletion :: T.Text -> J.CompletionItem +buildCompletion label = + J.CompletionItem label (Just J.CiKeyword) Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing Nothing Nothing Nothing Nothing Nothing