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..94acc88f69f 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 @@ -2,26 +2,24 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} - 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 completed for a field, takes the file path of the directory to start from. @@ -30,7 +28,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 +37,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 ) @@ -144,7 +145,6 @@ pathCompletionInfoFromCabalPrefixInfo ctx = dirNamePrefix = T.pack $ Posix.takeFileName prefix dir = completionWorkingDir ctx - {- | Returns the directory, the currently handled cabal file is in. We let System.FilePath handle the separator syntax since this is used @@ -188,5 +188,3 @@ mkFilePathCompletion suffix completion complInfo = do isFilePath <- doesFileExist combinedPath let completedPath = if isFilePath then combinedPath ++ T.unpack suffix else combinedPath pure $ T.pack completedPath - - 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..6f1dada51fe 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 @@ -40,8 +43,10 @@ import qualified Text.Fuzzy.Parallel as Fuzzy -} modulesCompleter :: (GenericPackageDescription -> [FilePath]) -> Completer modulesCompleter extractionFunction recorder cData = do - maybeGpd <- runIdeAction "cabal-plugin.modulesCompleter.parseCabal" extras - $ useWithStaleFast ParseCabal $ normalizedCabalFilePath prefInfo + maybeGpd <- + runIdeAction "cabal-plugin.modulesCompleter.parseCabal" extras $ + useWithStaleFast ParseCabal $ + normalizedCabalFilePath prefInfo case maybeGpd of Just (gpd, _) -> do let sourceDirs = extractionFunction gpd @@ -50,114 +55,91 @@ modulesCompleter extractionFunction recorder cData = do Nothing -> do logWith recorder Debug LogUseWithStaleFastNoResult pure [] - where - extras = shakeExtras (ideState cData) - prefInfo = cabalPrefixInfo cData + where + extras = shakeExtras (ideState cData) + prefInfo = cabalPrefixInfo cData -{- | Extracts the source directories of the library stanza. --} -sourceDirsExtractionLibrary :: GenericPackageDescription -> [FilePath] -sourceDirsExtractionLibrary gpd = +-- | Extracts the source directories of the library stanza. +sourceDirsExtractionLibrary :: Maybe T.Text -> 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 + where + libM = condLibrary gpd +sourceDirsExtractionLibrary name gpd = extractRelativeDirsFromStanza name gpd condSubLibraries libBuildInfo -{- | Extracts the source directories of the executable stanza with the given name. --} +-- | 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 +-- | Extracts the source directories of the test suite stanza with the given name. +sourceDirsExtractionTestSuite :: Maybe T.Text -> GenericPackageDescription -> [FilePath] +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 +-- | Extracts the source directories of benchmark stanza with the given name. +sourceDirsExtractionBenchmark :: Maybe T.Text -> GenericPackageDescription -> [FilePath] +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 - res = - List.find - (\(_, cTree) -> do - let bMarkName = benchmarkName $ condTreeData cTree - bMarkName == (mkUnqualComponentName $ T.unpack name) - ) - bMarksM + where + stanzaM = fmap (condTreeData . snd) res + allStanzasM = getStanza gpd + res = + 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. -} filePathsForExposedModules :: [FilePath] -> Recorder (WithPriority Log) -> CabalPrefixInfo -> IO [T.Text] filePathsForExposedModules srcDirs recorder prefInfo = do - concatForM - srcDirs - (\dir -> do - let pInfo = - PathCompletionInfo + concatForM + srcDirs + ( \dir -> do + let pInfo = + PathCompletionInfo { partialFileName = T.pack $ Posix.takeFileName prefix - , partialFileDir = Posix.addTrailingPathSeparator $ Posix.takeDirectory prefix + , partialFileDir = Posix.addTrailingPathSeparator $ Posix.takeDirectory prefix , workingDir = completionWorkingDir prefInfo FP. dir } - completions <- listFileCompletions recorder pInfo - validExposedCompletions <- filterM (isValidExposedModulePath pInfo) completions - let filePathCompletions = map (fpToExposedModulePath dir) validExposedCompletions - toMatch = fromMaybe (partialFileName pInfo) $ T.stripPrefix "./" $ partialFileName pInfo - scored = Fuzzy.simpleFilter 1000 10 toMatch (map T.pack filePathCompletions) - forM - scored - ( \compl' -> do - let compl = Fuzzy.original compl' - fullFilePath <- mkExposedModulePathCompletion compl pInfo - pure fullFilePath - ) - ) - where - prefix = - exposedModulePathToFp - $ completionPrefix prefInfo - isValidExposedModulePath :: PathCompletionInfo -> FilePath -> IO Bool - isValidExposedModulePath pInfo path = do - let dir = mkCompletionDirectory pInfo - fileExists <- doesFileExist (dir FP. path) - pure $ not fileExists || FP.isExtensionOf ".hs" path - + completions <- listFileCompletions recorder pInfo + validExposedCompletions <- filterM (isValidExposedModulePath pInfo) completions + let filePathCompletions = map (fpToExposedModulePath dir) validExposedCompletions + toMatch = fromMaybe (partialFileName pInfo) $ T.stripPrefix "./" $ partialFileName pInfo + scored = Fuzzy.simpleFilter 1000 10 toMatch (map T.pack filePathCompletions) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + fullFilePath <- mkExposedModulePathCompletion compl pInfo + pure fullFilePath + ) + ) + where + prefix = + exposedModulePathToFp $ + completionPrefix prefInfo + isValidExposedModulePath :: PathCompletionInfo -> FilePath -> IO Bool + isValidExposedModulePath pInfo path = do + let dir = mkCompletionDirectory pInfo + fileExists <- doesFileExist (dir FP. path) + pure $ not fileExists || FP.isExtensionOf ".hs" path {- Takes a completed path and a pathCompletionInfo and generates the whole completed filepath including the already written prefix using the cabal syntax for exposed modules. @@ -177,11 +159,10 @@ mkExposedModulePathCompletion completion complInfo = do path in exposed module syntax where the separators are '.' and the file ending is removed. -} fpToExposedModulePath :: FilePath -> FilePath -> FilePath -fpToExposedModulePath srcDir cabalDir = T.unpack $ T.intercalate "." $ fmap T.pack $ FP.splitDirectories fp - where - fp = fromMaybe cabalDir $ stripPrefix srcDir cabalDir +fpToExposedModulePath srcDir cabalDir = T.unpack $ T.intercalate "." $ fmap T.pack $ FP.splitDirectories fp + where + fp = fromMaybe cabalDir $ stripPrefix srcDir cabalDir -{- | Takes a path in the exposed module field and translates it to a filepath. --} +-- | Takes a path in the exposed module field and translates it to a filepath. exposedModulePathToFp :: T.Text -> FilePath exposedModulePathToFp fp = T.unpack $ T.replace "." (T.singleton FP.pathSeparator) fp diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs index 061505d350f..6f49813a7d1 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs @@ -8,70 +8,95 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T +import Development.IDE.Types.Logger (Priority (..), + logWith) import Distribution.Compat.Lens ((?~)) +import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Types import Ide.Plugin.Cabal.Completion.Types import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Types as LSP - -import Ide.Plugin.Cabal.Completion.Completer.Simple import qualified Text.Fuzzy.Parallel as Fuzzy -- | Maps snippet triggerwords with their completers snippetCompleter :: Completer -snippetCompleter _ cData = do - let scored = Fuzzy.simpleFilter 1000 10 (completionPrefix prefInfo) $ Map.keys snippetMap +snippetCompleter recorder cData = do + let scored = Fuzzy.simpleFilter 1000 10 (completionPrefix prefInfo) $ Map.keys snippets forM scored - (\compl -> do + ( \compl -> do let matched = Fuzzy.original compl - let completion = fromMaybe [] $ Map.lookup matched snippetMap - pure $ mkSnippetCompletion (T.unlines completion) matched + let completion = fromMaybe "" $ Map.lookup matched snippets + logWith recorder Warning $ LogMapLookUpOfKnownKeyFailed matched + pure $ mkSnippetCompletion completion matched ) - where - prefInfo = cabalPrefixInfo cData - mkSnippetCompletion :: T.Text -> T.Text -> LSP.CompletionItem - mkSnippetCompletion insertText toDisplay = mkDefaultCompletionItem toDisplay - & JL.kind ?~ LSP.CompletionItemKind_Snippet - & JL.insertText ?~ insertText - & JL.insertTextFormat ?~ LSP.InsertTextFormat_Snippet - snippetMap :: Map T.Text [T.Text] - snippetMap = Map.fromList - [ ("library-snippet", - [ "library" - , " hs-source-dirs: $1" - , " exposed-modules: $2" - , " build-depends: base" - , " default-language: Haskell2010" - ]) - , ("recommended-fields", - [ "cabal-version: $1" - , "name: " <> completionFileName prefInfo - , "version: 0.1.0.0" - , "maintainer: $4" - , "category: $5" - , "synopsis: $6" - , "license: $7" - , "build-type: Simple" - ]) - , ("executable-snippet", - [ "executable $1" - , " main-is: ${2:Main.hs}" - ]) - , ("benchmark-snippet", - [ "benchmark $1" - , " type: exitcode-stdio-1.0" - , " main-is: ${3:Main.hs}" - ]) - , ("testsuite-snippet", - [ "test-suite $1" - , " type: exitcode-stdio-1.0" - , " main-is: ${3:Main.hs}" - ]) - , ("common-warnings", - [ "common warnings" - , " ghc-options: -Wall" - ] - ) - ] + where + snippets = snippetMap prefInfo + prefInfo = cabalPrefixInfo cData + mkSnippetCompletion :: T.Text -> T.Text -> LSP.CompletionItem + mkSnippetCompletion insertText toDisplay = + mkDefaultCompletionItem toDisplay + & JL.kind ?~ LSP.CompletionItemKind_Snippet + & JL.insertText ?~ insertText + & JL.insertTextFormat ?~ LSP.InsertTextFormat_Snippet + +type TriggerWord = T.Text +snippetMap :: CabalPrefixInfo -> Map TriggerWord T.Text +snippetMap prefInfo = + fmap T.unlines $ + Map.fromList + [ + ( "library-snippet" + , + [ "library" + , " hs-source-dirs: $1" + , " exposed-modules: $2" + , " build-depends: base" + , " default-language: Haskell2010" + ] + ) + , + ( "recommended-fields" + , + [ "cabal-version: $1" + , "name: " <> completionFileName prefInfo + , "version: 0.1.0.0" + , "maintainer: $4" + , "category: $5" + , "synopsis: $6" + , "license: $7" + , "build-type: Simple" + ] + ) + , + ( "executable-snippet" + , + [ "executable $1" + , " main-is: ${2:Main.hs}" + ] + ) + , + ( "benchmark-snippet" + , + [ "benchmark $1" + , " type: exitcode-stdio-1.0" + , " main-is: ${3:Main.hs}" + ] + ) + , + ( "testsuite-snippet" + , + [ "test-suite $1" + , " type: exitcode-stdio-1.0" + , " main-is: ${3:Main.hs}" + ] + ) + , + ( "common-warnings" + , + [ "common warnings" + , " ghc-options: -Wall" + ] + ) + ] diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs index 926e41b7bbd..368af905e17 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs @@ -2,6 +2,7 @@ {-# LANGUAGE TypeFamilies #-} module Ide.Plugin.Cabal.Completion.Completer.Types where + import Development.IDE as D import Ide.Plugin.Cabal.Completion.Types import Language.LSP.Protocol.Types (CompletionItem) @@ -11,13 +12,12 @@ and returns the list of possible completion items -} type Completer = Recorder (WithPriority Log) -> CompleterData -> IO [CompletionItem] -{- | Contains information to be used by completers. --} +-- | Contains information to be used by completers. data CompleterData = CompleterData { ideState :: IdeState - -- ^ The ideState, which can be used to call the cabal parser results + -- ^ The ideState, which can be used to call the cabal parser results , cabalPrefixInfo :: CabalPrefixInfo - -- ^ Prefix info to be used for constructing completion items + -- ^ Prefix info to be used for constructing completion items , stanzaName :: Maybe StanzaName - -- ^ The name of the stanza in which the completer is applied + -- ^ The name of the stanza in which the completer is applied } diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs index d16ec00cf26..62d2fb2a21c 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs @@ -14,13 +14,12 @@ import Data.Text.Utf16.Rope (Rope) import qualified Data.Text.Utf16.Rope as Rope import Development.IDE as D import Distribution.Compat.Lens ((^.)) -import Ide.Plugin.Cabal.Completion.Types -import qualified Language.LSP.Protocol.Lens as JL - import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Snippet import Ide.Plugin.Cabal.Completion.Completer.Types (Completer) import Ide.Plugin.Cabal.Completion.Data +import Ide.Plugin.Cabal.Completion.Types +import qualified Language.LSP.Protocol.Lens as JL import qualified Language.LSP.Protocol.Types as LSP import qualified Language.LSP.VFS as VFS import qualified System.FilePath as FP @@ -37,8 +36,10 @@ contextToCompleter :: 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) = - snippetCompleter <> (constantCompleter $ - Map.keys (cabalVersionKeyword <> cabalKeywords) ++ Map.keys stanzaKeywordMap) + snippetCompleter + <> ( constantCompleter $ + Map.keys (cabalVersionKeyword <> cabalKeywords) ++ Map.keys stanzaKeywordMap + ) -- if we are in a keyword context in the top level, -- we look up that keyword in the top level context and can complete its possible values contextToCompleter (TopLevel, KeyWord kw) = @@ -78,7 +79,7 @@ getContext recorder prefInfo ls = case prevLinesM of Just prevLines -> do let lvlContext = - if completionIndentation prefInfo == 0 + if completionIndentation prefInfo == 0 then TopLevel else currentLevel prevLines case lvlContext of @@ -150,7 +151,7 @@ currentLevel (cur : xs) checkStanza t = case T.stripPrefix t (T.strip cur) of Just n - | T.null n -> Just (t,Nothing) + | T.null n -> Just (t, Nothing) | otherwise -> Just (t, Just $ T.strip n) Nothing -> Nothing @@ -217,5 +218,5 @@ getCabalPrefixInfo fp prefixInfo = -- | Calculates how many spaces the currently completed item is indented. completionIndentation :: CabalPrefixInfo -> Int completionIndentation prefInfo = fromIntegral (pos ^. JL.character) - (T.length $ completionPrefix prefInfo) - where - pos = completionCursorPosition prefInfo + where + pos = completionCursorPosition prefInfo 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..547c4a239ef 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 @@ -8,13 +8,13 @@ import qualified Data.Map as Map import qualified Data.Text as T import Distribution.CabalSpecVersion (CabalSpecVersion (CabalSpecV2_2), showCabalSpecVersion) -import Ide.Plugin.Cabal.Completion.Types -import Ide.Plugin.Cabal.LicenseSuggest (licenseNames) - 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) +import Ide.Plugin.Cabal.Completion.Types +import Ide.Plugin.Cabal.LicenseSuggest (licenseNames) + -- ---------------------------------------------------------------- -- Completion Data -- ---------------------------------------------------------------- @@ -63,89 +63,96 @@ stanzaKeywordMap = Map.fromList [ ( "library" - , \_ -> Map.fromList $ - [ ("exposed-modules:", modulesCompleter sourceDirsExtractionLibrary) -- identifier list - , ("virtual-modules:", noopCompleter) - , ("exposed:", constantCompleter ["True", "False"]) - , ("visibility:", constantCompleter ["private", "public"]) - , ("reexported-modules:", noopCompleter) -- export list, i.e. "orig-okg:Name as NewName" - , ("signatures:", noopCompleter) -- list of signatures - , ("other-modules:", modulesCompleter sourceDirsExtractionLibrary) - ] - ++ libExecTestBenchCommons + , \n -> + Map.fromList $ + [ ("exposed-modules:", modulesCompleter (sourceDirsExtractionLibrary n)) -- identifier list + , ("virtual-modules:", noopCompleter) + , ("exposed:", constantCompleter ["True", "False"]) + , ("visibility:", constantCompleter ["private", "public"]) + , ("reexported-modules:", noopCompleter) -- export list, i.e. "orig-okg:Name as NewName" + , ("signatures:", noopCompleter) -- list of signatures + , ("other-modules:", modulesCompleter (sourceDirsExtractionLibrary n)) + ] + ++ libExecTestBenchCommons ) , ( "executable" - , \n -> Map.fromList $ - [ ("main-is:", filePathCompleter) - , ("scope:", constantCompleter ["public", "private"]) - , ("other-modules:", modulesCompleter (sourceDirsExtractionExecutable n)) - ] - ++ libExecTestBenchCommons + , \n -> + Map.fromList $ + [ ("main-is:", filePathCompleter) + , ("scope:", constantCompleter ["public", "private"]) + , ("other-modules:", modulesCompleter (sourceDirsExtractionExecutable n)) + ] + ++ libExecTestBenchCommons ) , ( "test-suite" - , \n -> Map.fromList $ - [ ("type:", constantCompleter ["exitcode-stdio-1.0", "detailed-0.9"]) - , ("main-is:", filePathCompleter) - , ("other-modules:", modulesCompleter (sourceDirsExtractionTestSuite n)) - ] - ++ libExecTestBenchCommons + , \n -> + Map.fromList $ + [ ("type:", constantCompleter ["exitcode-stdio-1.0", "detailed-0.9"]) + , ("main-is:", filePathCompleter) + , ("other-modules:", modulesCompleter (sourceDirsExtractionTestSuite n)) + ] + ++ libExecTestBenchCommons ) , ( "benchmark" - , \n -> Map.fromList $ - [ ("type:", noopCompleter) - , ("main-is:", filePathCompleter) - , ("other-modules:", modulesCompleter (sourceDirsExtractionBenchmark n)) - ] - ++ libExecTestBenchCommons + , \n -> + Map.fromList $ + [ ("type:", noopCompleter) + , ("main-is:", filePathCompleter) + , ("other-modules:", modulesCompleter (sourceDirsExtractionBenchmark n)) + ] + ++ libExecTestBenchCommons ) , ( "foreign-library" - , \_ -> Map.fromList - [ ("type:", constantCompleter ["native-static", "native-shared"]) - , ("options:", constantCompleter ["standalone"]) - , ("mod-def-file:", filePathCompleter) - , ("lib-version-info:", noopCompleter) - , ("lib-version-linux:", noopCompleter) - ] + , \_ -> + Map.fromList + [ ("type:", constantCompleter ["native-static", "native-shared"]) + , ("options:", constantCompleter ["standalone"]) + , ("mod-def-file:", filePathCompleter) + , ("lib-version-info:", noopCompleter) + , ("lib-version-linux:", noopCompleter) + ] ) , ( "flag" - , \_ -> Map.fromList - [ ("description:", noopCompleter) - , ("default:", constantCompleter ["True", "False"]) - , ("manual:", constantCompleter ["False", "True"]) - , ("lib-def-file:", noopCompleter) - , ("lib-version-info:", noopCompleter) - , ("lib-version-linux:", noopCompleter) - ] + , \_ -> + Map.fromList + [ ("description:", noopCompleter) + , ("default:", constantCompleter ["True", "False"]) + , ("manual:", constantCompleter ["False", "True"]) + , ("lib-def-file:", noopCompleter) + , ("lib-version-info:", noopCompleter) + , ("lib-version-linux:", noopCompleter) + ] ) , ( "source-repository" - , \_ -> Map.fromList - [ - ( "type:" - , constantCompleter - [ "darcs" - , "git" - , "svn" - , "cvs" - , "mercurial" - , "hg" - , "bazaar" - , "bzr" - , "arch" - , "monotone" - ] - ) - , ("location:", noopCompleter) - , ("module:", noopCompleter) - , ("branch:", noopCompleter) - , ("tag:", noopCompleter) - , ("subdir:", directoryCompleter) - ] + , \_ -> + Map.fromList + [ + ( "type:" + , constantCompleter + [ "darcs" + , "git" + , "svn" + , "cvs" + , "mercurial" + , "hg" + , "bazaar" + , "bzr" + , "arch" + , "monotone" + ] + ) + , ("location:", noopCompleter) + , ("module:", noopCompleter) + , ("branch:", noopCompleter) + , ("tag:", noopCompleter) + , ("subdir:", directoryCompleter) + ] ) ] where 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..ffa75e4f3bf 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) @@ -21,6 +20,7 @@ data Log | LogUnknownStanzaNameInContextError StanzaName | LogFilePathCompleterIOError FilePath IOError | LogUseWithStaleFastNoResult + | LogMapLookUpOfKnownKeyFailed T.Text deriving (Show) instance Pretty Log where @@ -33,6 +33,7 @@ instance Pretty Log where LogFilePathCompleterIOError fp ioErr -> "Filepath:" <+> viaShow fp <+> viaShow ioErr LogUseWithStaleFastNoResult -> "Package description couldn't be read" + LogMapLookUpOfKnownKeyFailed key -> "Lookup of key in map failed even though it should exist" <+> viaShow key type instance RuleResult ParseCabal = Parse.GenericPackageDescription @@ -41,7 +42,6 @@ data ParseCabal = ParseCabal instance Hashable ParseCabal instance NFData ParseCabal - {- | The context a cursor can be in within a cabal file, we can be in stanzas or the top level, and additionally we can be in a context where we have already diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index c02dc23942c..96af5ed1e0a 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -290,7 +290,7 @@ pathCompleterTests = where completeDirectory :: T.Text -> TestName -> IO [T.Text] completeDirectory written dirName = do - completer <- directoryCompleter mempty $ mkCompleterData $ simpleCabalPrefixInfoFromFp written dirName + completer <- directoryCompleter mempty $ mkCompleterData $ simpleCabalPrefixInfoFromFp written dirName pure $ fmap extract completer fileCompleterTests :: TestTree @@ -300,7 +300,7 @@ pathCompleterTests = [ testCase "Current Directory" $ do testDir <- getTestDir completions <- completeFilePath "" testDir - completions @?== ["./.hidden","./Content.hs", "./dir1/", "./dir2/", "./textfile.txt"] + completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt"] , testCase "Current Directory - alternative writing" $ do testDir <- getTestDir completions <- completeFilePath "./" testDir @@ -348,18 +348,18 @@ contextTests = , 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 - ctx <- callGetContext (Position 0 14) ""["cabal-version:"] + ctx <- callGetContext (Position 0 14) "" ["cabal-version:"] ctx @?= (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, -- we are not in a keyword context - ctx <- callGetContext (Position 0 5) "cabal"["cabal-version:"] + ctx <- callGetContext (Position 0 5) "cabal" ["cabal-version:"] ctx @?= (TopLevel, None) , testCase "Cabal version keyword - no value, many spaces" $ do -- on a file, where the "cabal-version:" keyword is already written -- the context should still be top level but the keyword should be recognized - ctx <- callGetContext (Position 0 45) ("")["cabal-version:" <> T.replicate 50 " "] + ctx <- callGetContext (Position 0 45) ("") ["cabal-version:" <> T.replicate 50 " "] ctx @?= (TopLevel, KeyWord "cabal-version:") , testCase "Cabal version keyword - keyword partly written" $ do -- in the first line of the file, if the keyword @@ -371,7 +371,7 @@ contextTests = -- in the first line of the file, if the keyword -- has not been written completely, the keyword context -- should still be None - ctx <- callGetContext (Position 0 17) "1."["cabal-version: 1."] + ctx <- callGetContext (Position 0 17) "1." ["cabal-version: 1."] ctx @?= (TopLevel, KeyWord "cabal-version:") , testCase "Inside Stanza - no keyword" $ do -- on a file, where the library stanza has been defined @@ -388,7 +388,7 @@ contextTests = -- if the cabal version keyword has been written but without a value, -- in the next line we still should be in top level context with no keyword -- since the cabal version keyword and value pair need to be in the same line - ctx <- callGetContext (Position 1 2) "" ["cabal-version:", ""] + ctx <- callGetContext (Position 1 2) "" ["cabal-version:", ""] ctx @?= (TopLevel, None) , testCase "Non-cabal-version keyword - no value, next line indentented position" $ do -- if a keyword, other than the cabal version keyword has been written @@ -430,10 +430,10 @@ contextTests = ctx <- callGetContext (Position 5 0) "" libraryStanzaData ctx @?= (TopLevel, None) , testCase "Top level - cursor in later line with partially written value" $ do - ctx <- callGetContext (Position 5 13) "eee" topLevelData + ctx <- callGetContext (Position 5 13) "eee" topLevelData ctx @?= (TopLevel, KeyWord "name:") , testCase "Named Stanza" $ do - ctx <- callGetContext (Position 2 18) "" executableStanzaData + ctx <- callGetContext (Position 2 18) "" executableStanzaData ctx @?= (Stanza "executable" (Just "exeName"), None) ] where @@ -461,13 +461,12 @@ exposedModulesTests = exposed <- callFilePathsForExposedModules ["./Dir1/", "Dir1/Dir3/Dir4/"] exposed @?== ["Dir2.", "Dir3.", "file3"] ] - where - callFilePathsForExposedModules :: [FilePath] -> IO [T.Text] - callFilePathsForExposedModules srcDirs = do - cwd <- getExposedTestDir - let prefInfo = simpleCabalPrefixInfoFromFp "" cwd - filePathsForExposedModules srcDirs mempty prefInfo - + where + callFilePathsForExposedModules :: [FilePath] -> IO [T.Text] + callFilePathsForExposedModules srcDirs = do + cwd <- getExposedTestDir + let prefInfo = simpleCabalPrefixInfoFromFp "" cwd + filePathsForExposedModules srcDirs mempty prefInfo -- ------------------------ ------------------------------------------------ -- Integration Tests @@ -629,7 +628,7 @@ simpleCabalPrefixInfoFromFp prefix fp = } mkCompleterData :: CabalPrefixInfo -> CompleterData -mkCompleterData prefInfo = CompleterData {ideState = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing} +mkCompleterData prefInfo = CompleterData{ideState = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing} getTestDir :: IO FilePath getTestDir = do