Filepath completion now no longer considers './' when matching

Some refactoring
haskell · Jun 16, 2023 · 7a6d82b · 7a6d82b
1 parent d4cdec4
commit 7a6d82b
Show file tree

Hide file tree

Showing 3 changed files with 43 additions and 24 deletions.
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
@@ -292,4 +292,4 @@ completion _ide _ complParams = do
    where
     (Position linePos charPos) = VFS.cursorPos prefix
     context = getContext (Position linePos charPos) (Rope.lines $ cnts ^. VFS.file_text)
-    completionContext = getFilePathCompletionContext fp prefix
+    completionContext = getCabalCompletionContext fp prefix
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs
@@ -27,7 +27,6 @@ import           System.Directory                (doesDirectoryExist,
 import qualified System.FilePath                 as FP
 import qualified System.FilePath.Posix           as Posix
 import qualified Text.Fuzzy.Parallel             as Fuzzy
-import Debug.Trace (traceShowM, traceShowId)
 
 {- | Takes information needed to build possible completion items
 and returns the list of possible completion items
@@ -77,7 +76,17 @@ data KeyWordContext
 type KeyWordName = T.Text
 type StanzaName = T.Text
 
--- Information about the current completion status
+{- | Information about the current completion status
+
+  Example: @"dir1/fi@ having been written to the file
+  would correspond to:
+
+  @
+    completionPrefix = "dir1/fi"
+    completionSuffix  = Just "\\""
+    ...
+  @
+-}
 data CabalCompletionContext = CabalCompletionContext
   { completionPrefix       :: T.Text
   -- ^ text prefix to complete
@@ -166,7 +175,7 @@ getContext pos ls =
 -}
 getKeyWordContext :: Position -> [T.Text] -> Map KeyWordName a -> Maybe KeyWordContext
 getKeyWordContext pos ls keywords = do
-  case traceShowId $ lastNonEmptyLineM of
+  case lastNonEmptyLineM of
     Nothing -> Just None
     Just lastLine' -> do
       let (whiteSpaces, lastLine) = T.span (== ' ') lastLine'
@@ -181,14 +190,13 @@ getKeyWordContext pos ls keywords = do
           Just kw -> Just $ KeyWord kw
         else Just None
  where
+  currentLineM = ls Extra.!? (fromIntegral $ pos ^. JL.line)
+  lastNonEmptyLineM :: Maybe T.Text
   lastNonEmptyLineM = do
     cur' <- currentLineM
-    traceShowM ("cur line", cur')
     let cur = stripPartiallyWritten $ T.take (fromIntegral $ pos ^. JL.character) cur'
-    traceShowM ("cur line before pref", cur)
     List.find (not . T.null . T.stripEnd)
       $ cur : previousLines pos ls
-  currentLineM = ls Extra.!? (fromIntegral $ pos ^. JL.line)
 
 {- | Parse the given set of lines (starting before current cursor position
   up to the start of the file) to find the nearest stanza declaration,
@@ -237,8 +245,8 @@ stripPartiallyWritten = T.dropWhileEnd (\y -> (y /= ' ') && (y /= ':'))
   checks whether a suffix needs to be completed,
   and calculates the range in the document in which to complete
 -}
-getFilePathCompletionContext :: FilePath -> VFS.PosPrefixInfo -> CabalCompletionContext
-getFilePathCompletionContext dir prefixInfo =
+getCabalCompletionContext :: FilePath -> VFS.PosPrefixInfo -> CabalCompletionContext
+getCabalCompletionContext dir prefixInfo =
   CabalCompletionContext
     { completionPrefix = filepathPrefix
     , completionSuffix = Just suffix
@@ -264,7 +272,7 @@ getFilePathCompletionContext dir prefixInfo =
   cursorColumn = fromIntegral $ VFS.cursorPos prefixInfo ^. JL.character
   -- if the filepath is inside apostrophes, we parse until the apostrophe,
   -- otherwise we parse until a space occurs
-  stopConditionChars = apostropheOrSpaceSeparator : [',']
+  stopConditionChars = apostropheOrSpaceSeparator : [',', ':']
 
 buildCompletion :: CabalCompletionItem -> J.CompletionItem
 buildCompletion completionItem =
@@ -317,8 +325,9 @@ filePathCompleter :: Completer
 filePathCompleter ctx = do
   let suffix = fromMaybe "" $ completionSuffix ctx
       complInfo = pathCompletionInfoFromCompletionContext ctx
+      toMatch = fromMaybe "" $ T.stripPrefix "./" $ partialFileName complInfo
   filePathCompletions <- listFileCompletions complInfo
-  let scored = Fuzzy.simpleFilter 1000 10 (partialFileName complInfo) (map T.pack filePathCompletions)
+  let scored = Fuzzy.simpleFilter 1000 10 toMatch (map T.pack filePathCompletions)
   forM
     scored
     ( \compl' -> do
@@ -327,7 +336,7 @@ filePathCompleter ctx = do
         pure $ makeCabalCompletionItem (completionRange ctx) fullFilePath fullFilePath
     )
  where
-  -- \| Takes a suffix, a completed path and a pathCompletionInfo and
+  --   Takes a suffix, a completed path and a pathCompletionInfo and
   --   generates the whole filepath including the already written prefix
   --   and the suffix in case the completed path is a filepath
   makeFullFilePath :: T.Text -> T.Text -> PathCompletionInfo -> IO T.Text
@@ -354,7 +363,7 @@ directoryCompleter ctx = do
         pure $ makeCabalCompletionItem (completionRange ctx) fullDirPath fullDirPath
     )
  where
-  -- \| Takes a directory and PathCompletionInfo and
+  --   Takes a directory and PathCompletionInfo and
   --   returns the whole path including the prefix that was already written
   makeFullDirPath :: T.Text -> PathCompletionInfo -> IO T.Text
   makeFullDirPath completion' complInfo = do
@@ -420,6 +429,16 @@ mkDirFromCWD complInfo fp = Posix.addTrailingPathSeparator $ mkCompletionDirecto
 
   Note that partialFileName combined with partialFileDir results in
   the original prefix.
+
+  Example:
+  On the written filepath: @dir1/fi@ the
+  resulting PathCompletionInfo would be:
+
+  @
+    partialFileName = "fi"
+    partialFileDir  = "dir1/dir2/fi"
+    ...
+  @
 -}
 data PathCompletionInfo = PathCompletionInfo
   { partialFileName :: T.Text

diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs
@@ -115,7 +115,7 @@ completionHelperTests =
  where
   getFilePathCursorPrefix :: T.Text -> UInt -> UInt -> T.Text
   getFilePathCursorPrefix lineString linePos charPos =
-    completionPrefix . getFilePathCompletionContext "" $
+    completionPrefix . getCabalCompletionContext "" $
       VFS.PosPrefixInfo
         { VFS.fullLine = lineString
         , VFS.prefixModule = ""
@@ -128,35 +128,35 @@ filePathCompletionContextTests =
   testGroup
     "File Path Completion Context Tests"
     [ testCase "empty line" $ do
-        let complContext = getFilePathCompletionContext "" (simplePosPrefixInfo "   " 0 3)
+        let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "   " 0 3)
         completionSuffix complContext @?= Just ""
         completionPrefix complContext @?= ""
     , testCase "simple filepath" $ do
-        let complContext = getFilePathCompletionContext "" (simplePosPrefixInfo "   src/" 0 7)
+        let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "   src/" 0 7)
         completionSuffix complContext @?= Just ""
         completionPrefix complContext @?= "src/"
     , testCase "simple filepath - starting apostrophe" $ do
-        let complContext = getFilePathCompletionContext "" (simplePosPrefixInfo "   \"src/" 0 8)
+        let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "   \"src/" 0 8)
         completionSuffix complContext @?= Just "\""
         completionPrefix complContext @?= "src/"
     , testCase "simple filepath - starting apostrophe, already closed" $ do
-        let complContext = getFilePathCompletionContext "" (simplePosPrefixInfo "   \"src/\"" 0 8)
+        let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "   \"src/\"" 0 8)
         completionSuffix complContext @?= Just ""
         completionPrefix complContext @?= "src/"
     , testCase "second filepath - starting apostrophe" $ do
-        let complContext = getFilePathCompletionContext "" (simplePosPrefixInfo "fp.txt \"src/" 0 12)
+        let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "fp.txt \"src/" 0 12)
         completionSuffix complContext @?= Just "\""
         completionPrefix complContext @?= "src/"
     , testCase "middle filepath - starting apostrophe" $ do
-        let complContext = getFilePathCompletionContext "" (simplePosPrefixInfo "fp.txt \"src/ fp2.txt" 0 12)
+        let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "fp.txt \"src/ fp2.txt" 0 12)
         completionSuffix complContext @?= Just "\""
         completionPrefix complContext @?= "src/"
     , testCase "middle filepath - starting apostrophe, already closed" $ do
-        let complContext = getFilePathCompletionContext "" (simplePosPrefixInfo "fp.t xt \"src\" fp2.txt" 0 12)
+        let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "fp.t xt \"src\" fp2.txt" 0 12)
         completionSuffix complContext @?= Just ""
         completionPrefix complContext @?= "src"
     , testCase "middle filepath - starting apostrophe, already closed" $ do
-        let complContext = getFilePathCompletionContext "" (simplePosPrefixInfo "\"fp.txt\" \"src fp2.txt" 0 13)
+        let complContext = getCabalCompletionContext "" (simplePosPrefixInfo "\"fp.txt\" \"src fp2.txt" 0 13)
         completionSuffix complContext @?= Just "\""
         completionPrefix complContext @?= "src"
     ]
@@ -341,10 +341,10 @@ contextTests =
         -- for a completely empty file, the context needs to
         -- be top level without a specified keyword
         getContext (Position 0 0) [""] @?= Just (TopLevel, None)
-    , testCase "Cabal version keyword - no value" $ do
+    , testCase "Cabal version keyword - no value, no space after :" $ do
         -- on a file, where the keyword is already written
         -- the context should still be toplevel but the keyword should be recognized
-        getContext (Position 0 15) ["cabal-version:"] @?= Just (TopLevel, KeyWord "cabal-version:")
+        getContext (Position 0 14) ["cabal-version:"] @?= Just (TopLevel, KeyWord "cabal-version:")
     , testCase "Cabal version keyword - cursor in keyword" $ do
         -- on a file, where the keyword is already written
         -- but the cursor is in the middle of the keyword,