Skip to content

Commit

Permalink
Refactor completion code to its own module
Browse files Browse the repository at this point in the history
  • Loading branch information
@VeryMilkyJoe
VeryMilkyJoe committed May 31, 2023
1 parent 9b2f3fc commit 611da62
Show file tree
Hide file tree
Showing 3 changed files with 313 additions and 278 deletions.
1 change: 1 addition & 0 deletions plugins/hls-cabal-plugin/hls-cabal-plugin.cabal
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
280 changes: 2 additions & 278 deletions plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)]
Expand All @@ -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
Loading

0 comments on commit 611da62

Please sign in to comment.