diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index cdd614c653..c21f2f2639 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -29,6 +29,7 @@ library Ide.Plugin.Cabal.Diagnostics Ide.Plugin.Cabal.Completion.Completer.FilePath Ide.Plugin.Cabal.Completion.Completer.Module + Ide.Plugin.Cabal.Completion.Completer.Paths Ide.Plugin.Cabal.Completion.Completer.Simple Ide.Plugin.Cabal.Completion.Completer.Snippet Ide.Plugin.Cabal.Completion.Completer.Types diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs index b0681d467d..c7aa59f125 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs @@ -5,9 +5,11 @@ module Ide.Plugin.Cabal.Completion.Completer.FilePath where import Control.Exception (evaluate, try) import Control.Monad (filterM) -import Control.Monad.Extra (forM) +import Control.Monad.Extra (concatForM, forM) import qualified Data.Text as T +import Distribution.PackageDescription (GenericPackageDescription) import Ide.Logger +import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Types import Ide.Plugin.Cabal.Completion.Types @@ -23,7 +25,7 @@ import qualified Text.Fuzzy.Parallel as Fuzzy filePathCompleter :: Completer filePathCompleter recorder cData = do let prefInfo = cabalPrefixInfo cData - complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo + complInfo = pathCompletionInfoFromCabalPrefixInfo "" prefInfo filePathCompletions <- listFileCompletions recorder complInfo let scored = Fuzzy.simpleFilter @@ -39,12 +41,44 @@ filePathCompleter recorder cData = do pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath ) +mainIsCompleter :: (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> Completer +mainIsCompleter extractionFunction recorder cData = do + mGPD <- getLatestGPD cData + case mGPD of + Just gpd -> do + let srcDirs = extractionFunction sName gpd + concatForM srcDirs + (\dir' -> do + let dir = FP.normalise dir' + let pathInfo = pathCompletionInfoFromCabalPrefixInfo dir prefInfo + completions <- listFileCompletions recorder pathInfo + let scored = Fuzzy.simpleFilter + Fuzzy.defChunkSize + Fuzzy.defMaxResults + (pathSegment pathInfo) + (map T.pack completions) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + fullFilePath <- mkFilePathCompletion pathInfo compl + pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath + ) + ) + Nothing -> do + logWith recorder Debug LogUseWithStaleFastNoResult + pure [] + where + sName = stanzaName cData + prefInfo = cabalPrefixInfo cData + + -- | Completer to be used when a directory can be completed for the field. -- Only completes directories. directoryCompleter :: Completer directoryCompleter recorder cData = do let prefInfo = cabalPrefixInfo cData - complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo + complInfo = pathCompletionInfoFromCabalPrefixInfo "" prefInfo directoryCompletions <- listDirectoryCompletions recorder complInfo let scored = Fuzzy.simpleFilter @@ -73,33 +107,6 @@ directoryCompleter recorder cData = do be used for file path completions to be written to the cabal file. -} --- | Information used to query and build path completions. --- --- Note that pathSegment combined with queryDirectory results in --- the original prefix. --- --- Example: --- When given the written prefix, @dir1\/dir2\/fi@, the --- resulting PathCompletionInfo would be: --- --- @ --- pathSegment = "fi" --- queryDirectory = "dir1\/dir2\/fi" --- ... --- @ -data PathCompletionInfo = PathCompletionInfo - { -- | partly written segment of the next part of the path - pathSegment :: T.Text, - -- | written part of path, platform dependent - queryDirectory :: FilePath, - -- | directory relative to which relative paths are interpreted, platform dependent - workingDirectory :: FilePath, - -- | Did the completion happen in the context of a string notation, - -- if yes, contains the state of the string notation - isStringNotationPath :: Maybe Apostrophe - } - deriving (Eq, Show) - -- | Takes a PathCompletionInfo and returns the list of files and directories -- in the directory which match the path completion info in posix style. -- @@ -126,18 +133,6 @@ listDirectoryCompletions recorder complInfo = do filepaths <- listFileCompletions recorder complInfo filterM (doesDirectoryExist . mkDirFromCWD complInfo) filepaths -pathCompletionInfoFromCabalPrefixInfo :: CabalPrefixInfo -> PathCompletionInfo -pathCompletionInfoFromCabalPrefixInfo ctx = - PathCompletionInfo - { pathSegment = T.pack pathSegment', - queryDirectory = queryDirectory', - workingDirectory = completionWorkingDir ctx, - isStringNotationPath = isStringNotation ctx - } - where - prefix = T.unpack $ completionPrefix ctx - (queryDirectory', pathSegment') = Posix.splitFileName prefix - -- | Returns the directory where files and directories can be queried from -- for the passed PathCompletionInfo. -- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs index 4cae2dae5d..21dfbb9e1f 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs @@ -6,26 +6,16 @@ import Control.Monad (filterM) import Control.Monad.Extra (concatForM, forM) import Data.List (stripPrefix) -import qualified Data.List as List import Data.Maybe (fromMaybe) import qualified Data.Text as T -import Distribution.PackageDescription (Benchmark (..), - BuildInfo (..), - CondTree (condTreeData), - Executable (..), - GenericPackageDescription (..), - Library (..), - UnqualComponentName, - mkUnqualComponentName, - testBuildInfo) -import Distribution.Utils.Path (getSymbolicPath) +import Distribution.PackageDescription (GenericPackageDescription) import Ide.Logger (Priority (..), Recorder, WithPriority, logWith) -import Ide.Plugin.Cabal.Completion.Completer.FilePath (PathCompletionInfo (..), - listFileCompletions, +import Ide.Plugin.Cabal.Completion.Completer.FilePath (listFileCompletions, mkCompletionDirectory) +import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Types import Ide.Plugin.Cabal.Completion.Types @@ -53,56 +43,6 @@ modulesCompleter extractionFunction recorder cData = do sName = stanzaName cData prefInfo = cabalPrefixInfo cData --- | Extracts the source directories of the library stanza. -sourceDirsExtractionLibrary :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] -sourceDirsExtractionLibrary Nothing gpd = - -- we use condLibrary to get the information contained in the library stanza - -- since the library in PackageDescription is not populated by us - case libM of - Just lib -> do - map getSymbolicPath $ hsSourceDirs $ libBuildInfo $ condTreeData lib - Nothing -> [] - where - libM = condLibrary gpd -sourceDirsExtractionLibrary name gpd = extractRelativeDirsFromStanza name gpd condSubLibraries libBuildInfo - --- | Extracts the source directories of the executable stanza with the given name. -sourceDirsExtractionExecutable :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] -sourceDirsExtractionExecutable name gpd = extractRelativeDirsFromStanza name gpd condExecutables buildInfo - --- | Extracts the source directories of the test suite stanza with the given name. -sourceDirsExtractionTestSuite :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] -sourceDirsExtractionTestSuite name gpd = extractRelativeDirsFromStanza name gpd condTestSuites testBuildInfo - --- | Extracts the source directories of benchmark stanza with the given name. -sourceDirsExtractionBenchmark :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] -sourceDirsExtractionBenchmark name gpd = extractRelativeDirsFromStanza name gpd condBenchmarks benchmarkBuildInfo - --- | Takes a possible stanza name, a GenericPackageDescription, --- a function to access the stanza information we are interested in --- and a function to access the build info from the specific stanza. --- --- Returns a list of relative source directory paths specified for the extracted stanza. -extractRelativeDirsFromStanza :: - Maybe StanzaName -> - GenericPackageDescription -> - (GenericPackageDescription -> [(UnqualComponentName, CondTree b c a)]) -> - (a -> BuildInfo) -> - [FilePath] -extractRelativeDirsFromStanza Nothing _ _ _ = [] -extractRelativeDirsFromStanza (Just name) gpd getStanza getBuildInfo - | Just stanza <- stanzaM = map getSymbolicPath $ hsSourceDirs $ getBuildInfo stanza - | otherwise = [] - where - stanzaM = fmap (condTreeData . snd) res - allStanzasM = getStanza gpd - res = - List.find - ( \(n, _) -> - n == mkUnqualComponentName (T.unpack name) - ) - allStanzasM - -- | Takes a list of source directories and returns a list of path completions -- relative to any of the passed source directories which fit the passed prefix info. filePathsForExposedModules :: Recorder (WithPriority Log) -> [FilePath] -> CabalPrefixInfo -> IO [T.Text] @@ -111,34 +51,36 @@ filePathsForExposedModules recorder srcDirs prefInfo = do srcDirs ( \dir' -> do let dir = FP.normalise dir' - let pInfo = - PathCompletionInfo - { isStringNotationPath = Nothing, - pathSegment = T.pack $ FP.takeFileName prefix, - queryDirectory = FP.addTrailingPathSeparator $ FP.takeDirectory prefix, - workingDirectory = completionWorkingDir prefInfo FP. dir - } - completions <- listFileCompletions recorder pInfo - validExposedCompletions <- filterM (isValidExposedModulePath pInfo) completions - let toMatch = pathSegment pInfo - scored = Fuzzy.simpleFilter Fuzzy.defChunkSize Fuzzy.defMaxResults toMatch (map T.pack validExposedCompletions) + pathInfo = pathCompletionInfoFromCabalPrefixInfo dir modPrefInfo + completions <- listFileCompletions recorder pathInfo + validExposedCompletions <- filterM (isValidExposedModulePath pathInfo) completions + let toMatch = pathSegment pathInfo + scored = Fuzzy.simpleFilter + Fuzzy.defChunkSize + Fuzzy.defMaxResults + toMatch + (map T.pack validExposedCompletions) forM scored ( \compl' -> do let compl = Fuzzy.original compl' - fullFilePath <- mkExposedModulePathCompletion pInfo $ T.unpack compl + fullFilePath <- mkExposedModulePathCompletion pathInfo $ T.unpack compl pure fullFilePath ) ) where prefix = - exposedModulePathToFp $ + T.pack $ exposedModulePathToFp $ completionPrefix prefInfo - -- \| Takes a PathCompletionInfo and a path segment and checks whether + -- build completion info relative to the source dir, + -- we overwrite the prefix written in the cabal file with its translation + -- to filepath syntax, since it is in exposed module syntax + modPrefInfo = prefInfo{completionPrefix=prefix} + + -- Takes a PathCompletionInfo and a path segment and checks whether -- the path segment can be completed for an exposed module. -- -- This is the case if the segment represents either a directory or a Haskell file. - -- isValidExposedModulePath :: PathCompletionInfo -> FilePath -> IO Bool isValidExposedModulePath pInfo path = do let dir = mkCompletionDirectory pInfo diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Paths.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Paths.hs new file mode 100644 index 0000000000..b067fa9e49 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Paths.hs @@ -0,0 +1,118 @@ +module Ide.Plugin.Cabal.Completion.Completer.Paths where + +import qualified Data.List as List +import qualified Data.Text as T +import Distribution.PackageDescription (Benchmark (..), + BuildInfo (..), + CondTree (condTreeData), + Executable (..), + GenericPackageDescription (..), + Library (..), + UnqualComponentName, + mkUnqualComponentName, + testBuildInfo) +import Distribution.Utils.Path (getSymbolicPath) +import Ide.Plugin.Cabal.Completion.Types +import qualified System.FilePath as FP +import qualified System.FilePath.Posix as Posix + + +{- | Information used to query and build path completions. + + Note that pathSegment combined with queryDirectory results in + the original prefix. + + Example: + When given the written prefix, @dir1\/dir2\/fi@, the + resulting PathCompletionInfo would be: + + @ + pathSegment = "fi" + queryDirectory = "dir1\/dir2\/fi" + ... + @ +-} +data PathCompletionInfo = PathCompletionInfo + { pathSegment :: T.Text, + -- ^ Partly written segment of the next part of the path. + queryDirectory :: FilePath, + -- ^ Written part of path, in posix format. + workingDirectory :: FilePath, + -- ^ Directory relative to which relative paths are interpreted, platform dependent. + isStringNotationPath :: Maybe Apostrophe + -- ^ Did the completion happen in the context of a string notation, + -- if yes, contains the state of the string notation. + } + deriving (Eq, Show) + +{- | Takes an optional source subdirectory and a prefix info + and creates a path completion info accordingly. + + The source directory represents some subdirectory of the working directory such as a + path from the field @hs-source-dirs@. + + If the source subdirectory is empty, then the working directory is simply set to + the currently handled cabal file's directory. +-} +pathCompletionInfoFromCabalPrefixInfo :: FilePath -> CabalPrefixInfo -> PathCompletionInfo +pathCompletionInfoFromCabalPrefixInfo srcDir prefInfo = + PathCompletionInfo + { pathSegment = T.pack pathSegment', + queryDirectory = queryDirectory', + workingDirectory = completionWorkingDir prefInfo FP. srcDir, + isStringNotationPath = isStringNotation prefInfo + } + where + prefix = T.unpack $ completionPrefix prefInfo + (queryDirectory', pathSegment') = Posix.splitFileName prefix + +-- | Extracts the source directories of the library stanza. +sourceDirsExtractionLibrary :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] +sourceDirsExtractionLibrary Nothing gpd = + -- we use condLibrary to get the information contained in the library stanza + -- since the library in PackageDescription is not populated by us + case libM of + Just lib -> do + map getSymbolicPath $ hsSourceDirs $ libBuildInfo $ condTreeData lib + Nothing -> [] + where + libM = condLibrary gpd +sourceDirsExtractionLibrary name gpd = extractRelativeDirsFromStanza name gpd condSubLibraries libBuildInfo + +-- | Extracts the source directories of the executable stanza with the given name. +sourceDirsExtractionExecutable :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] +sourceDirsExtractionExecutable name gpd = extractRelativeDirsFromStanza name gpd condExecutables buildInfo + +-- | Extracts the source directories of the test suite stanza with the given name. +sourceDirsExtractionTestSuite :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] +sourceDirsExtractionTestSuite name gpd = extractRelativeDirsFromStanza name gpd condTestSuites testBuildInfo + +-- | Extracts the source directories of benchmark stanza with the given name. +sourceDirsExtractionBenchmark :: Maybe StanzaName -> GenericPackageDescription -> [FilePath] +sourceDirsExtractionBenchmark name gpd = extractRelativeDirsFromStanza name gpd condBenchmarks benchmarkBuildInfo + +{- | Takes a possible stanza name, a GenericPackageDescription, + a function to access the stanza information we are interested in + and a function to access the build info from the specific stanza. + + Returns a list of relative source directory paths specified for the extracted stanza. +-} +extractRelativeDirsFromStanza :: + Maybe StanzaName -> + GenericPackageDescription -> + (GenericPackageDescription -> [(UnqualComponentName, CondTree b c a)]) -> + (a -> BuildInfo) -> + [FilePath] +extractRelativeDirsFromStanza Nothing _ _ _ = [] +extractRelativeDirsFromStanza (Just name) gpd getStanza getBuildInfo + | Just stanza <- stanzaM = map getSymbolicPath $ hsSourceDirs $ getBuildInfo stanza + | otherwise = [] + where + stanzaM = fmap (condTreeData . snd) res + allStanzasM = getStanza gpd + res = + List.find + ( \(n, _) -> + n == mkUnqualComponentName (T.unpack name) + ) + allStanzasM diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs index 5c42dca708..24badfcfc5 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs @@ -14,6 +14,7 @@ import Distribution.CabalSpecVersion (CabalSpecVersio showCabalSpecVersion) import Ide.Plugin.Cabal.Completion.Completer.FilePath import Ide.Plugin.Cabal.Completion.Completer.Module +import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Types (Completer) import Ide.Plugin.Cabal.Completion.Types @@ -92,16 +93,16 @@ libraryFields = executableFields :: Map KeyWordName Completer executableFields = Map.fromList - [ ("main-is:", filePathCompleter), + [ ("main-is:", mainIsCompleter sourceDirsExtractionExecutable), ("scope:", constantCompleter ["public", "private"]), - ("other-modules:", modulesCompleter (sourceDirsExtractionExecutable)) + ("other-modules:", modulesCompleter sourceDirsExtractionExecutable) ] testSuiteFields :: Map KeyWordName Completer testSuiteFields = Map.fromList [ ("type:", constantCompleter ["exitcode-stdio-1.0", "detailed-0.9"]), - ("main-is:", filePathCompleter), + ("main-is:", mainIsCompleter sourceDirsExtractionTestSuite), ("other-modules:", modulesCompleter sourceDirsExtractionTestSuite) ] @@ -109,8 +110,8 @@ benchmarkFields :: Map KeyWordName Completer benchmarkFields = Map.fromList [ ("type:", noopCompleter), - ("main-is:", filePathCompleter), - ("other-modules:", modulesCompleter (sourceDirsExtractionBenchmark)) + ("main-is:", mainIsCompleter sourceDirsExtractionBenchmark), + ("other-modules:", modulesCompleter sourceDirsExtractionBenchmark) ] foreignLibraryFields :: Map KeyWordName Completer diff --git a/plugins/hls-cabal-plugin/test/Completer.hs b/plugins/hls-cabal-plugin/test/Completer.hs index 4dfa0f18eb..594678ad71 100644 --- a/plugins/hls-cabal-plugin/test/Completer.hs +++ b/plugins/hls-cabal-plugin/test/Completer.hs @@ -11,6 +11,7 @@ import qualified Data.Text as T import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) import Ide.Plugin.Cabal.Completion.Completer.FilePath import Ide.Plugin.Cabal.Completion.Completer.Module +import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..)) import Ide.Plugin.Cabal.Completion.Completions import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..), @@ -42,51 +43,52 @@ basicCompleterTests = [ runCabalTestCaseSession "In stanza context - stanza should not be suggested" "" $ do doc <- openDoc "completer.cabal" "cabal" compls <- getCompletions doc (Position 11 7) - let complTexts = mapMaybe (^? L.textEdit . _Just . _L . L.newText) compls + let complTexts = getTextEditTexts compls liftIO $ assertBool "does not suggest library" $ "library" `notElem` complTexts liftIO $ assertBool "suggests library keyword" $ "extra-libraries:" `elem` complTexts , runCabalTestCaseSession "In top level context - stanza should be suggested" "" $ do doc <- openDoc "completer.cabal" "cabal" compls <- getCompletions doc (Position 8 2) - let complTexts = mapMaybe (^? L.textEdit . _Just . _L . L.newText) compls + let complTexts = getTextEditTexts compls liftIO $ assertBool "suggests benchmark" $ "benchmark" `elem` complTexts + , runCabalTestCaseSession "Main-is completions should be relative to hs-source-dirs of same stanza" "filepath-completions" $ do + doc <- openDoc "main-is.cabal" "cabal" + compls <- getCompletions doc (Position 10 12) + let complTexts = getTextEditTexts compls + liftIO $ assertBool "suggests f2" $ "./f2.hs" `elem` complTexts + liftIO $ assertBool "does not suggest" $ "./Content.hs" `notElem` complTexts ] + where + getTextEditTexts :: [CompletionItem] -> [T.Text] + getTextEditTexts compls = mapMaybe (^? L.textEdit . _Just . _L . L.newText) compls fileCompleterTests :: TestTree fileCompleterTests = testGroup "File Completer Tests" [ testCase "Current Directory" $ do - testDir <- getFilePathComplTestDir - completions <- completeFilePath "" testDir - completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt"], + completions <- completeFilePath "" filePathComplTestDir + completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt", "./main-is.cabal"], testCase "Current Directory - alternative writing" $ do - testDir <- getFilePathComplTestDir - completions <- completeFilePath "./" testDir - completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt"], + completions <- completeFilePath "./" filePathComplTestDir + completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt", "./main-is.cabal"], testCase "Current Directory - hidden file start" $ do - testDir <- getFilePathComplTestDir - completions <- completeFilePath "." testDir - completions @?== ["./Content.hs", "./.hidden", "./textfile.txt"], + completions <- completeFilePath "." filePathComplTestDir + completions @?== ["./Content.hs", "./.hidden", "./textfile.txt", "./main-is.cabal"], testCase "Current Directory - incomplete directory path written" $ do - testDir <- getFilePathComplTestDir - completions <- completeFilePath "di" testDir + completions <- completeFilePath "di" filePathComplTestDir completions @?== ["./dir1/", "./dir2/"], testCase "Current Directory - incomplete filepath written" $ do - testDir <- getFilePathComplTestDir - completions <- completeFilePath "te" testDir + completions <- completeFilePath "te" filePathComplTestDir completions @?== ["./Content.hs", "./textfile.txt"], testCase "Subdirectory" $ do - testDir <- getFilePathComplTestDir - completions <- completeFilePath "dir1/" testDir + completions <- completeFilePath "dir1/" filePathComplTestDir completions @?== ["dir1/f1.txt", "dir1/f2.hs"], testCase "Subdirectory - incomplete filepath written" $ do - testDir <- getFilePathComplTestDir - completions <- completeFilePath "dir2/dir3/MA" testDir + completions <- completeFilePath "dir2/dir3/MA" filePathComplTestDir completions @?== ["dir2/dir3/MARKDOWN.md"], testCase "Nonexistent directory" $ do - testDir <- getFilePathComplTestDir - completions <- completeFilePath "dir2/dir4/" testDir + completions <- completeFilePath "dir2/dir4/" filePathComplTestDir completions @?== [] ] where @@ -127,7 +129,6 @@ filePathCompletionContextTests = let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "\"fp.txt\" \"src fp2.txt" 0 13) completionPrefix complContext @?= "src", testCase "Current Directory" $ do - testDir <- getFilePathComplTestDir compls <- listFileCompletions mempty @@ -135,11 +136,10 @@ filePathCompletionContextTests = { isStringNotationPath = Nothing, pathSegment = "", queryDirectory = "", - workingDirectory = testDir + workingDirectory = filePathComplTestDir } - compls @?== [".hidden", "Content.hs", "dir1/", "dir2/", "textfile.txt"], + compls @?== [".hidden", "Content.hs", "dir1/", "dir2/", "textfile.txt", "main-is.cabal"], testCase "In directory" $ do - testDir <- getFilePathComplTestDir compls <- listFileCompletions mempty @@ -147,7 +147,7 @@ filePathCompletionContextTests = { isStringNotationPath = Nothing, pathSegment = "", queryDirectory = "dir1/", - workingDirectory = testDir + workingDirectory = filePathComplTestDir } compls @?== ["f1.txt", "f2.hs"] ] @@ -166,32 +166,25 @@ directoryCompleterTests = testGroup "Directory Completer Tests" [ testCase "Current Directory" $ do - testDir <- getFilePathComplTestDir - completions <- completeDirectory "" testDir + completions <- completeDirectory "" filePathComplTestDir completions @?== ["./dir1/", "./dir2/"], testCase "Current Directory - alternative writing" $ do - testDir <- getFilePathComplTestDir - completions <- completeDirectory "./" testDir + completions <- completeDirectory "./" filePathComplTestDir completions @?== ["./dir1/", "./dir2/"], testCase "Current Directory - incomplete directory path written" $ do - testDir <- getFilePathComplTestDir - completions <- completeDirectory "di" testDir + completions <- completeDirectory "di" filePathComplTestDir completions @?== ["./dir1/", "./dir2/"], testCase "Current Directory - incomplete filepath written" $ do - testDir <- getFilePathComplTestDir - completions <- completeDirectory "te" testDir + completions <- completeDirectory "te" filePathComplTestDir completions @?== [], testCase "Subdirectory - no more directories found" $ do - testDir <- getFilePathComplTestDir - completions <- completeDirectory "dir1/" testDir + completions <- completeDirectory "dir1/" filePathComplTestDir completions @?== [], testCase "Subdirectory - available subdirectory" $ do - testDir <- getFilePathComplTestDir - completions <- completeDirectory "dir2/" testDir + completions <- completeDirectory "dir2/" filePathComplTestDir completions @?== ["dir2/dir3/"], testCase "Nonexistent directory" $ do - testDir <- getFilePathComplTestDir - completions <- completeDirectory "dir2/dir4/" testDir + completions <- completeDirectory "dir2/dir4/" filePathComplTestDir completions @?== [] ] where @@ -262,8 +255,7 @@ filePathExposedModulesTests = where callFilePathsForExposedModules :: [FilePath] -> IO [T.Text] callFilePathsForExposedModules srcDirs = do - cwd <- getExposedTestDir - let prefInfo = simpleCabalPrefixInfoFromFp "" cwd + let prefInfo = simpleCabalPrefixInfoFromFp "" exposedTestDir filePathsForExposedModules mempty srcDirs prefInfo exposedModuleCompleterTests :: TestTree @@ -298,25 +290,21 @@ exposedModuleCompleterTests = CompleterData { cabalPrefixInfo = simpleExposedCabalPrefixInfo pref dir, getLatestGPD = do - testDir <- getTestDir - cabalContents <- ByteString.readFile $ testDir "exposed.cabal" + cabalContents <- ByteString.readFile $ testDataDir "exposed.cabal" pure $ parseGenericPackageDescriptionMaybe cabalContents, stanzaName = sName } callModulesCompleter :: Maybe StanzaName -> (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> T.Text -> IO [T.Text] callModulesCompleter sName func prefix = do - cwd <- getTestDir - let cData = simpleCompleterData sName cwd prefix + let cData = simpleCompleterData sName testDataDir prefix completer <- modulesCompleter func mempty cData pure $ fmap extract completer mkCompleterData :: CabalPrefixInfo -> CompleterData mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing} -getExposedTestDir :: IO FilePath -getExposedTestDir = do - testDir <- getTestDir - pure $ addTrailingPathSeparator $ testDir "src-modules" +exposedTestDir :: FilePath +exposedTestDir = addTrailingPathSeparator $ testDataDir "src-modules" simpleExposedCabalPrefixInfo :: T.Text -> FilePath -> CabalPrefixInfo simpleExposedCabalPrefixInfo prefix fp = diff --git a/plugins/hls-cabal-plugin/test/Context.hs b/plugins/hls-cabal-plugin/test/Context.hs index 356da51481..e2a7b0290e 100644 --- a/plugins/hls-cabal-plugin/test/Context.hs +++ b/plugins/hls-cabal-plugin/test/Context.hs @@ -4,17 +4,17 @@ module Context where -import Control.Monad.Trans.Maybe (runMaybeT) -import qualified Data.Text as T -import qualified Data.Text.Utf16.Rope as Rope +import Control.Monad.Trans.Maybe (runMaybeT) +import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope as Rope import Ide.Plugin.Cabal -import Ide.Plugin.Cabal.Completion.Completer.FilePath +import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completions -import Ide.Plugin.Cabal.Completion.Types (Context, - FieldContext (KeyWord, None), - StanzaContext (Stanza, TopLevel)) +import Ide.Plugin.Cabal.Completion.Types (Context, + FieldContext (KeyWord, None), + StanzaContext (Stanza, TopLevel)) import Test.Hls -import Utils as T +import Utils as T cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log cabalPlugin = mkPluginTestDescriptor descriptor "cabal context" @@ -32,31 +32,25 @@ pathCompletionInfoFromCompletionContextTests = testGroup "Completion Info to Completion Context Tests" [ testCase "Current Directory" $ do - testDir <- getTestDir - let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "" testDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo "" $ simpleCabalPrefixInfoFromFp "" testDataDir queryDirectory complInfo @?= "./" , testCase "Current Directory - partly written next" $ do - testDir <- getTestDir - let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "di" testDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo "" $ simpleCabalPrefixInfoFromFp "di" testDataDir queryDirectory complInfo @?= "./" pathSegment complInfo @?= "di" , testCase "Current Directory - alternative writing" $ do - testDir <- getTestDir - let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "./" testDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo "" $ simpleCabalPrefixInfoFromFp "./" testDataDir queryDirectory complInfo @?= "./" , testCase "Subdirectory" $ do - testDir <- getTestDir - let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "dir1/" testDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo "" $ simpleCabalPrefixInfoFromFp "dir1/" testDataDir queryDirectory complInfo @?= "dir1/" pathSegment complInfo @?= "" , testCase "Subdirectory - partly written next" $ do - testDir <- getTestDir - let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "dir1/d" testDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo "" $ simpleCabalPrefixInfoFromFp "dir1/d" testDataDir queryDirectory complInfo @?= "dir1/" pathSegment complInfo @?= "d" , testCase "Subdirectory - partly written next" $ do - testDir <- getTestDir - let complInfo = pathCompletionInfoFromCabalPrefixInfo $ simpleCabalPrefixInfoFromFp "dir1/dir2/d" testDir + let complInfo = pathCompletionInfoFromCabalPrefixInfo "" $ simpleCabalPrefixInfoFromFp "dir1/dir2/d" testDataDir queryDirectory complInfo @?= "dir1/dir2/" pathSegment complInfo @?= "d" ] @@ -172,6 +166,7 @@ getContextTests = -- ------------------------------------------------------------------------ -- Test Data -- ------------------------------------------------------------------------ + libraryStanzaData :: [T.Text] libraryStanzaData = [ "cabal-version: 3.0" diff --git a/plugins/hls-cabal-plugin/test/Utils.hs b/plugins/hls-cabal-plugin/test/Utils.hs index bf1606cba8..078c05750a 100644 --- a/plugins/hls-cabal-plugin/test/Utils.hs +++ b/plugins/hls-cabal-plugin/test/Utils.hs @@ -8,7 +8,6 @@ import qualified Data.Text as T import Ide.Plugin.Cabal (descriptor) import qualified Ide.Plugin.Cabal import Ide.Plugin.Cabal.Completion.Types -import System.Directory (getCurrentDirectory) import System.FilePath import Test.Hls @@ -37,15 +36,8 @@ simpleCabalPrefixInfoFromFp prefix fp = , completionFileName = "test" } -getTestDir :: IO FilePath -getTestDir = do - cwd <- getCurrentDirectory - pure $ addTrailingPathSeparator $ cwd "test" "testdata" - -getFilePathComplTestDir :: IO FilePath -getFilePathComplTestDir = do - testDir <- getTestDir - pure $ addTrailingPathSeparator $ testDir "filepath-completions" +filePathComplTestDir :: FilePath +filePathComplTestDir = addTrailingPathSeparator $ testDataDir "filepath-completions" runCabalTestCaseSession :: TestName -> FilePath -> Session () -> TestTree runCabalTestCaseSession title subdir = testCase title . runCabalSession subdir diff --git a/plugins/hls-cabal-plugin/test/testdata/filepath-completions/main-is.cabal b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/main-is.cabal new file mode 100644 index 0000000000..777f6ef769 --- /dev/null +++ b/plugins/hls-cabal-plugin/test/testdata/filepath-completions/main-is.cabal @@ -0,0 +1,11 @@ +cabal-version: 3.4 +name: test-hls +version: 0.1.0.0 +maintainer: milky +synopsis: example cabal file :) +license: Apache-2.0 +build-type: Simple + +executable exe + hs-source-dirs: ./dir1/ + main-is: