diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index c1b1ca6f1b1..d4804ff3417 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -27,14 +27,14 @@ library exposed-modules: Ide.Plugin.Cabal Ide.Plugin.Cabal.Diagnostics - Ide.Plugin.Cabal.Completion.Completions - Ide.Plugin.Cabal.Completion.Types - Ide.Plugin.Cabal.Completion.Data Ide.Plugin.Cabal.Completion.Completer.FilePath Ide.Plugin.Cabal.Completion.Completer.Module Ide.Plugin.Cabal.Completion.Completer.Simple - Ide.Plugin.Cabal.Completion.Completer.Types Ide.Plugin.Cabal.Completion.Completer.Snippet + Ide.Plugin.Cabal.Completion.Completer.Types + Ide.Plugin.Cabal.Completion.Completions + Ide.Plugin.Cabal.Completion.Data + Ide.Plugin.Cabal.Completion.Types Ide.Plugin.Cabal.LicenseSuggest Ide.Plugin.Cabal.Parse 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 b75eba950ca..e577e10f355 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,22 +5,22 @@ module Ide.Plugin.Cabal.Completion.Completer.FilePath where -import Data.Maybe (fromMaybe) -import qualified Data.Text as T +import Data.Maybe (fromMaybe) +import qualified Data.Text as T import Ide.Plugin.Cabal.Completion.Completer.Types -import Control.Exception (evaluate, try) -import Control.Monad (filterM) -import Control.Monad.Extra (forM) +import Control.Exception (evaluate, try) +import Control.Monad (filterM) +import Control.Monad.Extra (forM) import Development.IDE.Types.Logger +import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Types -import System.Directory (doesDirectoryExist, - doesFileExist, - listDirectory) -import qualified System.FilePath as FP -import qualified System.FilePath.Posix as Posix -import qualified Text.Fuzzy.Parallel as Fuzzy -import Ide.Plugin.Cabal.Completion.Completer.Simple +import System.Directory (doesDirectoryExist, + doesFileExist, + listDirectory) +import qualified System.FilePath as FP +import qualified System.FilePath.Posix as Posix +import qualified Text.Fuzzy.Parallel as Fuzzy {- | Completer to be used when a file path can be @@ -30,7 +30,7 @@ import Ide.Plugin.Cabal.Completion.Completer.Simple filePathCompleter :: Completer filePathCompleter recorder cData = do let prefInfo = cabalPrefixInfo cData - suffix = fromMaybe "" $ completionSuffix prefInfo + suffix' = fromMaybe "" $ completionSuffix prefInfo complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo toMatch = fromMaybe (partialFileName complInfo) $ T.stripPrefix "./" $ partialFileName complInfo filePathCompletions <- listFileCompletions recorder complInfo @@ -39,7 +39,10 @@ filePathCompleter recorder cData = do scored ( \compl' -> do let compl = Fuzzy.original compl' - fullFilePath <- mkFilePathCompletion suffix compl complInfo + suffix = if ' ' `T.elem` compl then "\"" else suffix' + fullFilePath' <- mkFilePathCompletion suffix compl complInfo + -- if we complete a filepath name which contains a space then we need to wrap the path in apostrophes + let fullFilePath = if ' ' `T.elem` fullFilePath' then T.append "\"" fullFilePath' else fullFilePath' pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath ) 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 2d5e62cf69e..2053b8c3a29 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 @@ -3,8 +3,7 @@ module Ide.Plugin.Cabal.Completion.Completer.Module where import qualified Data.List as List -import Data.Maybe (fromJust, - fromMaybe) +import Data.Maybe (fromMaybe) import qualified Data.Text as T import Development.IDE (IdeState (shakeExtras)) import Development.IDE.Core.Shake (runIdeAction, @@ -15,11 +14,14 @@ import Distribution.PackageDescription (Benchmark (..), Executable (..), GenericPackageDescription (..), Library (..), - TestSuite (testName), + UnqualComponentName, mkUnqualComponentName, testBuildInfo) import Distribution.Utils.Path (getSymbolicPath) -import Ide.Plugin.Cabal.Completion.Completer.FilePath +import Ide.Plugin.Cabal.Completion.Completer.FilePath (PathCompletionInfo (..), + listFileCompletions, + mkCompletionDirectory, + mkPathCompletion) import Ide.Plugin.Cabal.Completion.Completer.Types import Ide.Plugin.Cabal.Completion.Types @@ -33,6 +35,7 @@ import System.Directory (doesFileExist) import qualified System.FilePath as FP import qualified System.FilePath.Posix as Posix import qualified Text.Fuzzy.Parallel as Fuzzy + {- | Completer to be used when module paths can be completed for the field. Takes an extraction function which extracts the source directories @@ -70,56 +73,37 @@ sourceDirsExtractionLibrary gpd = {- | Extracts the source directories of the executable stanza with the given name. -} sourceDirsExtractionExecutable :: Maybe T.Text -> GenericPackageDescription -> [FilePath] -sourceDirsExtractionExecutable Nothing _ = [] -sourceDirsExtractionExecutable (Just name) gpd - | exeName executable == (mkUnqualComponentName $ T.unpack name) = map getSymbolicPath $ hsSourceDirs $ buildInfo executable - | otherwise = [] - where - executable = condTreeData $ snd $ fromJust res - execsM = condExecutables gpd - res = - List.find - (\(_, cTree) -> do - let execName = exeName $ condTreeData cTree - execName == (mkUnqualComponentName $ T.unpack name) - ) - execsM +sourceDirsExtractionExecutable name gpd = extractRelativeDirsFromStanza name gpd condExecutables buildInfo {- | Extracts the source directories of the test suite stanza with the given name. -} sourceDirsExtractionTestSuite :: Maybe T.Text -> GenericPackageDescription -> [FilePath] -sourceDirsExtractionTestSuite Nothing _ = [] -sourceDirsExtractionTestSuite (Just name) gpd - | testName testSuite == (mkUnqualComponentName $ T.unpack name) = map getSymbolicPath $ hsSourceDirs $ testBuildInfo testSuite - | otherwise = [] - where - testSuite = condTreeData $ snd $ fromJust res - testSuitesM = condTestSuites gpd - res = - List.find - (\(_, cTree) -> do - let testsName = testName $ condTreeData cTree - testsName == (mkUnqualComponentName $ T.unpack name) - ) - testSuitesM +sourceDirsExtractionTestSuite name gpd = extractRelativeDirsFromStanza name gpd condTestSuites testBuildInfo {- | Extracts the source directories of benchmark stanza with the given name. -} sourceDirsExtractionBenchmark :: Maybe T.Text -> GenericPackageDescription -> [FilePath] -sourceDirsExtractionBenchmark Nothing _ = [] -sourceDirsExtractionBenchmark (Just name) gpd - | benchmarkName bMark == (mkUnqualComponentName $ T.unpack name) = map getSymbolicPath $ hsSourceDirs $ benchmarkBuildInfo bMark +sourceDirsExtractionBenchmark name gpd = extractRelativeDirsFromStanza name gpd condBenchmarks benchmarkBuildInfo + +extractRelativeDirsFromStanza :: + Maybe T.Text -> + 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 - bMark = condTreeData $ snd $ fromJust res - bMarksM = condBenchmarks gpd + stanzaM = fmap (condTreeData . snd) res + allStanzasM = getStanza gpd res = - List.find - (\(_, cTree) -> do - let bMarkName = benchmarkName $ condTreeData cTree - bMarkName == (mkUnqualComponentName $ T.unpack name) - ) - bMarksM + List.find + (\(n,_) -> + n == (mkUnqualComponentName $ T.unpack name) + ) + allStanzasM {- | Extracts the source dirs from the library stanza in the cabal file using the GPD and returns a list of path completions relative to any source dir which fit the passed prefix info. 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 31aa37e7551..1c95213e5c7 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 @@ -15,6 +15,7 @@ import Ide.Plugin.Cabal.Completion.Completer.FilePath import Ide.Plugin.Cabal.Completion.Completer.Module import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Types (Completer) + -- ---------------------------------------------------------------- -- Completion Data -- ---------------------------------------------------------------- diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs index 1b44c0d8e60..5fb6b1b1686 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs @@ -4,7 +4,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} - module Ide.Plugin.Cabal.Completion.Types where import Control.DeepSeq (NFData)