Implement completion of possible keywords for field values in cabal files

Author: Jana Chadt

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

@@ -43,6 +43,10 @@ import qualified Data.Map as Map
 import Language.LSP.VFS (VirtualFile)
 import qualified Data.Text.Utf16.Rope as Rope
 import qualified Data.List as List
+import qualified Language.LSP.Types.Lens as Map
+import Development.IDE.GHC.Compat (getContext)
+import Debug.Trace
+import qualified Data.List.Extra as Extra
 data Log
   = LogModificationTime NormalizedFilePath (Maybe FileVersion)
   | LogDiagnostics NormalizedFilePath [FileDiagnostic]
@@ -72,7 +76,7 @@ instance Pretty Log where
 descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
 descriptor recorder plId = (defaultCabalPluginDescriptor plId)
   { pluginRules = cabalRules recorder
-  , pluginHandlers = mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction 
+  , pluginHandlers = mkPluginHandler STextDocumentCodeAction licenseSuggestCodeAction
                       <> mkPluginHandler J.STextDocumentCompletion completion
   , pluginNotificationHandlers = mconcat
   [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $
@@ -166,6 +170,7 @@ licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri)
 -- ----------------------------------------------------------------
 -- Completion
 -- ----------------------------------------------------------------
+
 completion :: PluginMethodHandler IdeState 'J.TextDocumentCompletion
 completion _ide _ complParams = do
   let (J.TextDocumentIdentifier uri) = complParams ^. JL.textDocument
@@ -180,103 +185,150 @@ completion _ide _ complParams = do
     result :: Maybe VFS.PosPrefixInfo -> VirtualFile -> J.List CompletionItem
     result Nothing _ = J.List []
     result (Just pfix) cnts
-      | (VFS.cursorPos pfix) ^. JL.line == 0 = J.List [buildCompletion cabalVersionKeyword]
-      | Stanza s <- findCurrentLevel (getPreviousLines pfix cnts) = 
-          case (Map.lookup s stanzaKeywordMap) of
-            Nothing ->
-              J.List $
-                makeCompletionItems pfix topLevelKeywords
-            Just l -> J.List $ (makeCompletionItems pfix l) ++ (makeCompletionItems pfix $ Map.keys stanzaKeywordMap)
-      | otherwise =
-        J.List $
-          makeCompletionItems pfix topLevelKeywords
-          where 
-            topLevelKeywords = cabalKeywords ++ Map.keys stanzaKeywordMap
-
--- | Takes info about the current cursor position and a set of possible keywords 
+      | pos ^. JL.line == 0 = J.List [buildCompletion (fst cabalVersionKeyword)]
+      | Just ctx@(Stanza s kwContext) <- context =
+        case (Map.lookup s stanzaKeywordMap) of
+          Nothing ->
+            case kwContext of
+              None ->
+                J.List $
+                  makeCompletionItems pfix topLevelKeywords
+              KeyWord kw -> J.List $ makeCompletionItems pfix (getPossibleValuesForKeyWord kw ctx)
+          Just m ->
+            case kwContext of
+              None -> J.List $ (makeCompletionItems pfix (Map.keys m)) ++ (makeCompletionItems pfix $ Map.keys stanzaKeywordMap)
+              KeyWord kw -> J.List $ makeCompletionItems pfix (getPossibleValuesForKeyWord kw ctx)
+      | Just ctx@(TopLevel kwContext) <- context =
+        case kwContext of
+          None -> J.List $ makeCompletionItems pfix topLevelKeywords
+          KeyWord kw -> J.List $ makeCompletionItems pfix (getPossibleValuesForKeyWord kw ctx)
+      | otherwise = J.List []
+      where
+        pos = VFS.cursorPos pfix
+        topLevelKeywords = Map.keys cabalKeywords ++ Map.keys stanzaKeywordMap
+        context = findCurrentContext pos (cnts ^. VFS.file_text)
+
+getPossibleValuesForKeyWord :: T.Text -> Context -> [T.Text]
+getPossibleValuesForKeyWord kw (TopLevel _) =
+  case Map.lookup kw cabalKeywords of
+    Nothing -> []
+    Just l -> l
+getPossibleValuesForKeyWord kw (Stanza s _) =
+  case Map.lookup s stanzaKeywordMap of
+    Nothing -> []
+    Just m -> case Map.lookup kw m of
+      Nothing -> []
+      Just l -> l
+
+findCurrentContext :: Position -> Rope.Rope -> Maybe Context
+findCurrentContext pos rope =
+  case outerContext of
+    TopLevel _ -> TopLevel <$> getKeyWordContext cabalKeywords
+    Stanza s _ ->
+      case traceShowId (Map.lookup (traceShowId s) stanzaKeywordMap) of
+        Nothing -> pure $ Stanza s None
+        Just m -> traceShowId $ Stanza s <$> getKeyWordContext m
+  where
+    outerContext = findCurrentLevel (getPreviousLines pos rope) None
+    currentLine = traceShowId $ (Rope.lines rope) Extra.!? (fromIntegral $ pos ^. JL.line)
+    getKeyWordContext keywords = do
+      curLine <- fmap T.stripStart currentLine
+      case List.find (\kw -> traceShowId kw `T.isPrefixOf` curLine) (traceShowId $ Map.keys keywords) of
+        Nothing -> Just None
+        Just kw -> Just $ KeyWord kw
+
+-- | 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, 
+-- | 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] -> Context
-findCurrentLevel [] = TopLevel
-findCurrentLevel (cur : xs)
-  | Just s <- stanza = Stanza s
-  | otherwise = findCurrentLevel xs
+findCurrentLevel :: [T.Text] -> KeyWordContext -> Context
+findCurrentLevel [] kwContext = TopLevel kwContext
+findCurrentLevel (cur : xs) kwContext
+  | Just s <- stanza = Stanza s kwContext
+  | otherwise = findCurrentLevel xs kwContext
   where
     stanza = List.find (`T.isPrefixOf` cur) (Map.keys stanzaKeywordMap)
 
--- | Get all lines before the given cursor position in the given file 
+-- | 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 :: VFS.PosPrefixInfo -> VirtualFile -> [T.Text]
-getPreviousLines pos cont = reverse $ take (fromIntegral currentLine) allLines
+getPreviousLines :: Position -> Rope.Rope -> [T.Text]
+getPreviousLines pos rope = reverse $ take (fromIntegral currentLine) allLines
   where
-    allLines = Rope.lines $ cont ^. VFS.file_text
-    currentLine = (VFS.cursorPos pos) ^. JL.line
+    allLines = Rope.lines rope
+    currentLine = pos ^. JL.line
 
-
-data Context 
-  = TopLevel 
+data Context
+  = TopLevel KeyWordContext
   -- ^ top level context in a cabal file such as 'author'
-  | Stanza T.Text
+  | Stanza T.Text KeyWordContext
   -- ^ nested context in a cabal file, such as 'library', which has nested keywords, specific to the stanza
-  deriving (Eq)
+  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
-cabalVersionKeyword = "cabal-version:"
+cabalVersionKeyword :: (T.Text,[T.Text])
+cabalVersionKeyword = ("cabal-version:", [])
 
 -- | Top level keywords of a cabal file
-cabalKeywords :: [T.Text]
-cabalKeywords = 
-  [
-    "name:",
-    "version:",
-    "build-type:",
-    "license:",
-    "license-file:",
-    "license-files:",
-    "copyright:",
-    "author:",
-    "maintainer:",
-    "stability:",
-    "homepage:",
-    "bug-reports:",
-    "package-url:",
-    "synopsis:",
-    "description:",
-    "category:",
-    "tested-with:",
-    "data-files:",
-    "data-dir:",
-    "data-dir:",
-    "extra-doc-files:",
-    "extra-tmp-files:"
+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:",
+    -- "data-files:",
+    -- "data-dir:",
+    -- "data-dir:",
+    -- "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 [T.Text]
-stanzaKeywordMap = Map.fromList [("library", [   
-    "exposed-modules:",
-    "virtual-modules:",
-    "exposed:",
-    "visibility:",
-    "reexported-modules:",
-    "signatures:"
-  ])]
-  
+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:", [])
+  ]),
+  ("test-suite", Map.fromList[])
+  ]
+
 
 -- TODO move out toplevel commands i.e. test-suite
 -- cabalTestKeywords :: [T.Text]
--- cabalTestKeywords = 
+-- cabalTestKeywords =
 --   [
---     "test-suite",
 --     "type:",
 --     "main-is:",
 --     "test-module:",
@@ -336,7 +388,7 @@ stanzaKeywordMap = Map.fromList [("library", [
 --   ]
 
 -- cabalFlagKeywords :: [(T.Text, T.Text)]
--- cabalFlagKeywords = 
+-- cabalFlagKeywords =
 --   [
 --     ("flag", "name"),
 --     ("description:", "freeform"),
@@ -345,14 +397,14 @@ stanzaKeywordMap = Map.fromList [("library", [
 --   ]
 
 -- cabalStanzaKeywords :: [(T.Text, T.Text)]
--- cabalStanzaKeywords = 
+-- cabalStanzaKeywords =
 --   [
 --     ("common", "name"),
 --     ("import:", "token-list")
 --   ]
 
 -- cabalSourceRepoKeywords :: [(T.Text, T.Text)]
--- cabalSourceRepoKeywords = 
+-- cabalSourceRepoKeywords =
 --   [
 --     ("source-repository", ""),
 --     ("type:", "token"),