Implement tests and functionality for filepath completion

VeryMilkyJoe · VeryMilkyJoe · commit 4df79fc4f8ef · 2023-06-02T14:22:12.000+02:00
Write function which parses the filepath occuring before the cursor in the cabal file
diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal
@@ -49,6 +49,7 @@ library
     , containers
     , deepseq
     , directory
+    , filepath
     , extra                 >=1.7.4
     , ghcide                == 2.0.0.0
     , hashable
@@ -80,6 +81,7 @@ test-suite tests
     , hls-cabal-plugin
     , hls-test-utils    == 2.0.0.0
     , lens
+    , lsp
     , lsp-types
     , tasty-hunit
     , text
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
@@ -16,32 +16,35 @@ import           Control.Concurrent.Strict
 import           Control.DeepSeq
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
-import qualified Data.ByteString                 as BS
+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.NonEmpty              as NE
-import qualified Data.Text.Encoding              as Encoding
-import qualified Data.Text.Utf16.Rope            as Rope
+import           Data.HashMap.Strict                    (HashMap)
+import qualified Data.HashMap.Strict                    as HashMap
+import qualified Data.List.NonEmpty                     as NE
+import qualified Data.Text.Encoding                     as Encoding
+import qualified Data.Text.Utf16.Rope                   as Rope
 import           Data.Typeable
-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           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           Distribution.Simple.PackageDescription (readGenericPackageDescription)
+import           Distribution.Verbosity                 (silent)
 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 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.Types
-import qualified Language.LSP.Server             as LSP
+import qualified Language.LSP.Server                    as LSP
 import           Language.LSP.Types
-import qualified Language.LSP.Types              as J
-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 Language.LSP.Types                     as J
+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 Debug.Trace (traceShowId)
 
 
 data Log
@@ -273,18 +276,21 @@ completion _ide _ complParams = do
       position = complParams ^. JL.position
   contents <- LSP.getVirtualFile $ toNormalizedUri uri
   fmap (Right . J.InL) $ case (contents, uriToFilePath' uri) of
-    (Just cnts, Just _path) -> do
+    (Just cnts, Just path) -> do
       pref <- VFS.getCompletionPrefix position cnts
-      liftIO $ result pref cnts
+      liftIO $ result pref path cnts
     _ -> return $ J.List []
   where
-    result :: Maybe VFS.PosPrefixInfo -> VirtualFile -> IO (J.List CompletionItem)
-    result Nothing _ = pure $ J.List []
-    result (Just pfix) cnts
+    result :: Maybe VFS.PosPrefixInfo -> FilePath -> VirtualFile -> IO (J.List CompletionItem)
+    result Nothing _ _ = pure $ J.List []
+    result (Just pfix) fp cnts
       | Just ctx <- context  = do
-        completions <- contextToCompleter ctx
-        pure $ J.List $ makeCompletionItems pfix completions
+        let completer = contextToCompleter "" ctx
+        completions <- completer $ VFS.prefixText $ (traceShowId pfix)
+        genPkgDesc <- readGenericPackageDescription silent fp
+        pure $ J.List $ makeCompletionItems pfix genPkgDesc completions
       | otherwise = pure $ J.List []
       where
         pos = VFS.cursorPos pfix
         context = getContext pos (Rope.lines $ cnts ^. VFS.file_text)
+
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs
@@ -2,22 +2,29 @@
 
 module Ide.Plugin.Cabal.Completions where
 
+import           Control.Monad                       (filterM)
 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.CabalSpecVersion       (CabalSpecVersion (CabalSpecV1_2),
+                                                      showCabalSpecVersion)
 import           Distribution.Compat.Lens            ((^.))
+import           Distribution.PackageDescription     (GenericPackageDescription)
 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           System.Console.Haskeline.Completion as Haskeline
+import           System.Directory                    (doesDirectoryExist)
+import           System.FilePath
 import qualified Text.Fuzzy.Parallel                 as Fuzzy
 
 
-type Completer = IO [T.Text]
+
+type Completer = T.Text -> IO [T.Text]
 
 -- | The context a cursor can be in within a cabal file,
 --   we can be in stanzas or the top level,
@@ -45,72 +52,50 @@ data KeyWordContext
   -- 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)
-
 -- ----------------------------------------------------------------
 -- Public API for Completions
 -- ----------------------------------------------------------------
 
-contextToCompleter :: Context -> Completer
+contextToCompleter :: T.Text ->Context -> Completer
 -- if we are in the top level of the cabal file and not in a keyword context,
 -- we can write any top level keywords or a stanza declaration
-contextToCompleter (TopLevel, None) =
-  pure $ Map.keys cabalKeywords ++ Map.keys stanzaKeywordMap
+contextToCompleter dir (TopLevel, None) =
+  constantCompleter $ Map.keys (cabalKeywords dir) ++ Map.keys stanzaKeywordMap
 -- if we are in a keyword context in the top level,
 -- we look up that keyword in the toplevel context and can complete its possible values
-contextToCompleter (TopLevel, KeyWord kw) =
-  case Map.lookup kw cabalKeywords of
+contextToCompleter dir (TopLevel, KeyWord kw) =
+  case Map.lookup kw (cabalKeywords dir) of
     Nothing -> noopCompleter
     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
-contextToCompleter (Stanza s, None) =
+contextToCompleter _dir (Stanza s, None) =
   case Map.lookup s stanzaKeywordMap of
     Nothing -> noopCompleter
-    Just l  -> pure $ Map.keys l ++ Map.keys stanzaKeywordMap
+    Just l  -> constantCompleter $ Map.keys l ++ Map.keys stanzaKeywordMap
 -- if we are in a stanza's keyword's context we can complete possible values of that keyword
-contextToCompleter (Stanza s, KeyWord kw) =
+contextToCompleter _dir (Stanza s, KeyWord kw) =
   case Map.lookup s stanzaKeywordMap of
     Nothing -> noopCompleter
     Just m -> case Map.lookup kw m of
       Nothing -> noopCompleter
       Just l  -> l
 
--- | Takes info about the current cursor position and a set of possible keywords
+-- | Takes info about the current cursor position, information
+--   about the handled cabal file 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)
+makeCompletionItems :: VFS.PosPrefixInfo -> GenericPackageDescription -> [T.Text] -> [CompletionItem]
+makeCompletionItems _pfix _pkgDesc l = map buildCompletion 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
+-- TODO: first line can only have cabal-version: keyword
 getContext :: Position -> [T.Text] -> Maybe Context
 getContext pos ls =
   case lvlContext of
     TopLevel -> do
-      kwContext <- getKeyWordContext pos ls (uncurry Map.insert cabalVersionKeyword cabalKeywords)
+      kwContext <- getKeyWordContext pos ls (cabalVersionKeyword <> cabalKeywords "")
       pure (TopLevel, kwContext)
     Stanza s ->
       case Map.lookup s stanzaKeywordMap of
@@ -169,6 +154,20 @@ getPreviousLines pos ls = reverse $ take (fromIntegral currentLine) ls
   where
     currentLine = pos ^. JL.line
 
+-- | Takes information about the current cursor position in the file
+--   and returns the filepath up to that cursor position
+getFilePathCursorPrefix :: VFS.PosPrefixInfo -> T.Text
+getFilePathCursorPrefix pfixInfo =
+  T.takeWhileEnd (not . (`elem` stopConditionChars)) lineText
+  where
+    lineText = T.take cursorColumn $ VFS.fullLine pfixInfo
+    cursorColumn = fromIntegral $ VFS.cursorPos pfixInfo ^. JL.character
+    -- if the filepath is inside apostrophes, we parse until the apostrophe,
+    -- otherwise space is a separator
+    apostropheOrSpaceSeparator = if T.count "\"" lineText `mod` 2 == 1 then '\"' else ' '
+    stopConditionChars = apostropheOrSpaceSeparator : [',']
+
+
 buildCompletion :: T.Text -> J.CompletionItem
 buildCompletion label =
   J.CompletionItem label (Just J.CiKeyword) Nothing Nothing
@@ -180,39 +179,51 @@ buildCompletion label =
 -- ----------------------------------------------------------------
 
 noopCompleter :: Completer
-noopCompleter = pure []
+noopCompleter _ = pure []
 
 constantCompleter :: [T.Text] -> Completer
-constantCompleter = pure
+constantCompleter completions pfix = do
+  let scored = Fuzzy.simpleFilter 1000 10 pfix completions
+  pure $ map Fuzzy.original scored
 
+-- | returns all possible files and directories reachable
+--   from the given filepath
 filePathCompleter :: FilePath -> Completer
-filePathCompleter fp = do
-  completions <- Haskeline.listFiles fp
+filePathCompleter fp pfix = do
+  completions <- Haskeline.listFiles (fp </> T.unpack pfix)
   pure $ map (T.pack . Haskeline.replacement) completions
 
+-- | returns all possible directories reachable
+--   from the given filepath
 directoryCompleter :: FilePath -> Completer
-directoryCompleter fp = undefined
+directoryCompleter fp pfix = do
+  completions <- Haskeline.listFiles (fp </> T.unpack pfix)
+  let filepathCompletions = fmap Haskeline.replacement completions
+  directoryCompletions <- filterM doesDirectoryExist filepathCompletions
+  pure $ map T.pack directoryCompletions
 
 -- ----------------------------------------------------------------
 -- Completion Data
 -- ----------------------------------------------------------------
 
 -- | Keyword for cabal version; required to be the top line in a cabal file
-cabalVersionKeyword :: (T.Text,Completer)
-cabalVersionKeyword = ("cabal-version:", constantCompleter["2.0", "2.2", "2.4", "3.0"])
+cabalVersionKeyword :: Map  T.Text Completer
+cabalVersionKeyword = Map.singleton "cabal-version:" $
+  constantCompleter $
+    map (T.pack . showCabalSpecVersion) [CabalSpecV1_2 .. maxBound]
 
 -- 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 Completer
-cabalKeywords =
+cabalKeywords :: T.Text -> Map T.Text Completer
+cabalKeywords rootDir' =
   Map.fromList [
     ("name:", noopCompleter), -- TODO: should complete to filename, needs meta info
     ("version:", noopCompleter),
     ("build-type:", constantCompleter ["Simple", "Custom", "Configure", "Make"]),
     ("license:", constantCompleter ["NONE"]), -- TODO: add possible values, spdx
-    ("license-file:", filePathCompleter ""),
-    ("license-files:", noopCompleter), -- list of filenames
+    ("license-file:", filePathCompleter rootDir),
+    ("license-files:", filePathCompleter rootDir), -- list of filenames
     ("copyright:", noopCompleter),
     ("author:", noopCompleter),
     ("maintainer:", noopCompleter), -- email address, use git config
@@ -224,12 +235,14 @@ cabalKeywords =
     ("description:", noopCompleter),
     ("category:", noopCompleter),
     ("tested-with:", constantCompleter ["GHC"]), -- list of compilers, i.e. "GHC == 8.6.3, GHC == 8.4.4"
-    ("data-files:", noopCompleter), -- list of filenames
-    ("data-dir:", noopCompleter), -- directory
-    ("extra-source-files:", noopCompleter), -- filename list
-    ("extra-doc-files:", noopCompleter), -- filename list
-    ("extra-tmp-files:", noopCompleter) -- filename list
+    ("data-files:", filePathCompleter rootDir), -- list of filenames
+    ("data-dir:", directoryCompleter rootDir), -- directory
+    ("extra-source-files:", filePathCompleter rootDir), -- filename list
+    ("extra-doc-files:", filePathCompleter rootDir), -- filename list
+    ("extra-tmp-files:", filePathCompleter rootDir) -- filename list
   ]
+  where
+    rootDir = T.unpack rootDir'
 
 
 -- | Map, containing all stanzas in a cabal file as keys and lists of their possible nested keywords as values
@@ -291,13 +304,12 @@ stanzaKeywordMap =
   where
     libExecTestBenchCommons =
       [ ("build-depends:", noopCompleter),
-        ("other-modules:", noopCompleter), -- list of identifiers
-        ("hs-source-dir:", constantCompleter ["."]), -- list of directories
-        ("hs-source-dirs:", constantCompleter ["."]), -- list of directories
-        ("default-extensions:", noopCompleter), -- list of identifiers
-        ("other-extensions:", noopCompleter), -- list of identifiers
-        ("default-language:", noopCompleter), -- identifier
-        ("other-languages:", noopCompleter), -- list of identifiers
+        ("other-modules:", noopCompleter),
+        ("hs-source-dirs:", directoryCompleter ""),
+        ("default-extensions:", noopCompleter),
+        ("other-extensions:", noopCompleter),
+        ("default-language:", noopCompleter),
+        ("other-languages:", noopCompleter),
         ("build-tool-depends:", noopCompleter),
         ("buildable:", constantCompleter ["True", "False"]),
         ("ghc-options:", noopCompleter), -- todo: maybe there is a list of possible ghc options somewhere
@@ -306,18 +318,18 @@ stanzaKeywordMap =
         ("ghcjs-options:", noopCompleter),
         ("ghcjs-prof-options:", noopCompleter),
         ("ghcjs-shared-options:", noopCompleter),
-        ("includes:", noopCompleter), -- list of filenames
-        ("install-includes:", noopCompleter), -- list of filenames
-        ("include-dirs:", noopCompleter), -- list of directories
-        ("c-sources:", noopCompleter), -- list of filenames
-        ("cxx-sources:", noopCompleter), -- list of filenames
-        ("asm-sources:", noopCompleter), -- list of filenames
-        ("cmm-sources:", noopCompleter), -- list of filenames
-        ("js-sources:", noopCompleter), -- list of filenames
+        ("includes:", filePathCompleter ""), -- list of filenames
+        ("install-includes:", filePathCompleter ""), -- list of filenames
+        ("include-dirs:", directoryCompleter ""), -- list of directories
+        ("c-sources:", filePathCompleter ""), -- list of filenames
+        ("cxx-sources:", filePathCompleter ""), -- list of filenames
+        ("asm-sources:", filePathCompleter ""), -- list of filenames
+        ("cmm-sources:", filePathCompleter ""), -- list of filenames
+        ("js-sources:", filePathCompleter ""), -- list of filenames
         ("extra-libraries:", noopCompleter),
         ("extra-ghci-libraries:", noopCompleter),
         ("extra-bundled-libraries:", noopCompleter),
-        ("extra-lib-dirs:", noopCompleter), -- list of directories
+        ("extra-lib-dirs:", directoryCompleter ""), -- list of directories
         ("cc-options:", noopCompleter),
         ("cpp-options:", noopCompleter),
         ("cxx-options:", noopCompleter),
@@ -326,7 +338,7 @@ stanzaKeywordMap =
         ("ld-options:", noopCompleter),
         ("pkgconfig-depends:", noopCompleter),
         ("frameworks:", noopCompleter),
-        ("extra-framework-dirs:", noopCompleter), -- list of directories
+        ("extra-framework-dirs:", directoryCompleter ""), -- list of directories
         ("mixins:", noopCompleter)
       ]
 
diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs
