From f9516573d179f482a2b27a897f7dc43e9b92b4a0 Mon Sep 17 00:00:00 2001 From: Jana Chadt Date: Fri, 30 Jun 2023 16:38:09 +0200 Subject: [PATCH] Refactor module structure of cabal completion system --- .../hls-cabal-plugin/hls-cabal-plugin.cabal | 11 +- .../hls-cabal-plugin/src/Ide/Plugin/Cabal.hs | 46 +- .../Completer/FilePath.hs} | 138 ++-- .../Cabal/Completion/Completer/Module.hs | 187 +++++ .../Cabal/Completion/Completer/Simple.hs | 167 ++++ .../Cabal/Completion/Completer/Snippet.hs | 77 ++ .../Cabal/Completion/Completer/Types.hs | 23 + .../Plugin/Cabal/Completion/Completions.hs | 221 +++++ .../src/Ide/Plugin/Cabal/Completion/Data.hs | 205 +++++ .../Plugin/Cabal/{ => Completion}/Types.hs | 24 +- .../src/Ide/Plugin/Cabal/Completions.hs | 764 ------------------ plugins/hls-cabal-plugin/test/Main.hs | 38 +- 12 files changed, 998 insertions(+), 903 deletions(-) rename plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/{FilepathCompletions.hs => Completion/Completer/FilePath.hs} (55%) create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs create mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs rename plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/{ => Completion}/Types.hs (83%) delete mode 100644 plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs diff --git a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal index 8827740735f..c1b1ca6f1b1 100644 --- a/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal +++ b/plugins/hls-cabal-plugin/hls-cabal-plugin.cabal @@ -27,11 +27,16 @@ library exposed-modules: Ide.Plugin.Cabal Ide.Plugin.Cabal.Diagnostics - Ide.Plugin.Cabal.Completions - Ide.Plugin.Cabal.FilepathCompletions + 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.LicenseSuggest Ide.Plugin.Cabal.Parse - Ide.Plugin.Cabal.Types build-depends: diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index e6ad5256cc9..a9af7bf5756 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -16,31 +16,33 @@ import Control.Concurrent.Strict import Control.DeepSeq import Control.Monad.Extra import Control.Monad.IO.Class -import Control.Monad.Trans.Maybe (runMaybeT) -import qualified Data.ByteString as BS +import Control.Monad.Trans.Maybe (runMaybeT) +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 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 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 GHC.Generics -import qualified Ide.Plugin.Cabal.Completions as 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.Types as Types +import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes +import qualified Ide.Plugin.Cabal.Completion.Completions as Completions +import qualified Ide.Plugin.Cabal.Completion.Types as Types +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.Protocol.Lens as JL -import qualified Language.LSP.Protocol.Message as LSP +import qualified Language.LSP.Protocol.Lens as JL +import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types -import Language.LSP.Server (LspM, getVirtualFile) -import qualified Language.LSP.VFS as VFS +import Language.LSP.Server (LspM, + getVirtualFile) +import qualified Language.LSP.VFS as VFS data Log = LogModificationTime NormalizedFilePath FileVersion @@ -292,13 +294,13 @@ completion recorder ide _ complParams = do Just ctx -> do logWith recorder Debug $ LogCompletionContext ctx pos let completer = Completions.contextToCompleter ctx - let completerData = Types.CompleterData + let completerData = CompleterTypes.CompleterData { ideState = ide , cabalPrefixInfo = completionContext , stanzaName = case fst ctx of Types.Stanza _ name -> name - _ -> Nothing + _ -> Nothing } completions <- completer completerRecorder completerData pure completions diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FilepathCompletions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs similarity index 55% rename from plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FilepathCompletions.hs rename to plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs index c6cf0f69bd4..b75eba950ca 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FilepathCompletions.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/FilePath.hs @@ -2,22 +2,69 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Ide.Plugin.Cabal.FilepathCompletions where - -import Control.Exception (evaluate, try) -import Control.Monad (filterM) -import Control.Monad.Extra (concatForM, forM) -import Data.List (stripPrefix) -import Data.Maybe (fromMaybe) -import qualified Data.Text as T + +module Ide.Plugin.Cabal.Completion.Completer.FilePath where + +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 Development.IDE.Types.Logger -import Ide.Plugin.Cabal.Types -import System.Directory (doesDirectoryExist, - doesFileExist, listDirectory) -import qualified System.FilePath as FP -import System.FilePath (dropExtension) -import qualified System.FilePath.Posix as Posix -import qualified Text.Fuzzy.Parallel as Fuzzy +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 + + +{- | Completer to be used when a file path can be + completed for a field, takes the file path of the directory to start from. + Completes file paths as well as directories. +-} +filePathCompleter :: Completer +filePathCompleter recorder cData = do + let prefInfo = cabalPrefixInfo cData + suffix = fromMaybe "" $ completionSuffix prefInfo + complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo + toMatch = fromMaybe (partialFileName complInfo) $ T.stripPrefix "./" $ partialFileName complInfo + filePathCompletions <- listFileCompletions recorder complInfo + let scored = Fuzzy.simpleFilter 1000 10 toMatch (map T.pack filePathCompletions) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + fullFilePath <- mkFilePathCompletion suffix compl complInfo + pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath + ) + +{- | Completer to be used when a directory can be completed for the field, + takes the file path of the directory to start from. + Only completes directories. +-} +directoryCompleter :: Completer +directoryCompleter recorder cData = do + let prefInfo = cabalPrefixInfo cData + complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo + directoryCompletions <- listDirectoryCompletions recorder complInfo + let scored = + Fuzzy.simpleFilter + 1000 + 10 + (partialFileName complInfo) + (map T.pack directoryCompletions) + forM + scored + ( \compl' -> do + let compl = Fuzzy.original compl' + let fullDirPath = mkPathCompletion complInfo compl + pure $ mkCompletionItem (completionRange prefInfo) fullDirPath fullDirPath + ) {- Note [Using correct file path separators] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -97,55 +144,6 @@ pathCompletionInfoFromCabalPrefixInfo ctx = dirNamePrefix = T.pack $ Posix.takeFileName prefix dir = completionWorkingDir ctx -{- | 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 - { partialFileName = T.pack $ Posix.takeFileName 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 - -{- | Takes a source dir path and a cabal file path and returns the complete source dir - 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 - -{- | 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 {- | Returns the directory, the currently handled cabal file is in. @@ -191,16 +189,4 @@ mkFilePathCompletion suffix completion complInfo = do let completedPath = if isFilePath then combinedPath ++ T.unpack suffix else combinedPath pure $ T.pack completedPath -{- 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. - i.e. Dir.Dir2.HaskellFile - or Dir.Dir2. --} -mkExposedModulePathCompletion :: T.Text -> PathCompletionInfo -> IO T.Text -mkExposedModulePathCompletion completion complInfo = do - let combinedPath = T.unpack $ mkPathCompletion complInfo completion - isFilePath <- doesFileExist (workingDir complInfo FP. combinedPath) - let completedPath = T.pack $ if isFilePath then dropExtension combinedPath else combinedPath ++ "." - let exposedPath = fromMaybe completedPath $ T.stripPrefix "./" completedPath - pure $ T.pack $ fpToExposedModulePath "" $ T.unpack exposedPath 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 new file mode 100644 index 00000000000..2d5e62cf69e --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Module.hs @@ -0,0 +1,187 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.Cabal.Completion.Completer.Module where + +import qualified Data.List as List +import Data.Maybe (fromJust, + fromMaybe) +import qualified Data.Text as T +import Development.IDE (IdeState (shakeExtras)) +import Development.IDE.Core.Shake (runIdeAction, + useWithStaleFast) +import Distribution.PackageDescription (Benchmark (..), + BuildInfo (..), + CondTree (condTreeData), + Executable (..), + GenericPackageDescription (..), + Library (..), + TestSuite (testName), + mkUnqualComponentName, + testBuildInfo) +import Distribution.Utils.Path (getSymbolicPath) +import Ide.Plugin.Cabal.Completion.Completer.FilePath +import Ide.Plugin.Cabal.Completion.Completer.Types +import Ide.Plugin.Cabal.Completion.Types + +import Control.Monad (filterM) +import Control.Monad.Extra (concatForM, + forM) +import Data.List (stripPrefix) +import Development.IDE.Types.Logger +import Ide.Plugin.Cabal.Completion.Completer.Simple +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 + to be used by the completer. +-} +modulesCompleter :: (GenericPackageDescription -> [FilePath]) -> Completer +modulesCompleter extractionFunction recorder cData = do + maybeGpd <- runIdeAction "cabal-plugin.modulesCompleter.parseCabal" extras + $ useWithStaleFast ParseCabal $ normalizedCabalFilePath prefInfo + case maybeGpd of + Just (gpd, _) -> do + let sourceDirs = extractionFunction gpd + filePathCompletions <- filePathsForExposedModules sourceDirs recorder prefInfo + pure $ map (\compl -> mkCompletionItem (completionRange prefInfo) compl compl) filePathCompletions + Nothing -> do + logWith recorder Debug LogUseWithStaleFastNoResult + pure [] + where + extras = shakeExtras (ideState cData) + prefInfo = cabalPrefixInfo cData + +{- | Extracts the source directories of the library stanza. +-} +sourceDirsExtractionLibrary :: GenericPackageDescription -> [FilePath] +sourceDirsExtractionLibrary 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 + +{- | 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 + +{- | 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 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 + | 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 + +{- | 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 + { partialFileName = T.pack $ Posix.takeFileName 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 + + +{- 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. + + i.e. Dir.Dir2.HaskellFile + or Dir.Dir2. +-} +mkExposedModulePathCompletion :: T.Text -> PathCompletionInfo -> IO T.Text +mkExposedModulePathCompletion completion complInfo = do + let combinedPath = T.unpack $ mkPathCompletion complInfo completion + isFilePath <- doesFileExist (workingDir complInfo FP. combinedPath) + let completedPath = T.pack $ if isFilePath then FP.dropExtension combinedPath else combinedPath ++ "." + let exposedPath = fromMaybe completedPath $ T.stripPrefix "./" completedPath + pure $ T.pack $ fpToExposedModulePath "" $ T.unpack exposedPath + +{- | Takes a source dir path and a cabal file path and returns the complete source dir + 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 + +{- | 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/Simple.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs new file mode 100644 index 00000000000..7c4714d5d62 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.Cabal.Completion.Completer.Simple where +import Data.Function ((&)) +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import Data.Ord (Down (Down)) +import qualified Data.Text as T +import Distribution.Compat.Lens ((?~)) +import Ide.Plugin.Cabal.Completion.Completer.Types +import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..)) +import qualified Language.LSP.Protocol.Lens as JL +import qualified Language.LSP.Protocol.Types as Compls (CompletionItem (..)) +import qualified Language.LSP.Protocol.Types as LSP +import qualified Text.Fuzzy.Parallel as Fuzzy + +{- | Completer to be used when no completion suggestions + are implemented for the field +-} +noopCompleter :: Completer +noopCompleter _ _ = pure [] + +{- | Completer to be used when a simple set of values + can be completed for a field +-} +constantCompleter :: [T.Text] -> Completer +constantCompleter completions _ cData = do + let prefInfo = cabalPrefixInfo cData + scored = Fuzzy.simpleFilter 1000 10 (completionPrefix prefInfo) completions + range = completionRange prefInfo + pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored + +-- | Completer to be used for the name field's value +nameCompleter :: Completer +nameCompleter _ cData = do + let scored = Fuzzy.simpleFilter 1000 10 (completionPrefix prefInfo) [completionFileName prefInfo] + prefInfo = cabalPrefixInfo cData + range = completionRange prefInfo + pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored + + +{- | Completer to be used when a set of values with priority weights + attached to some values are to be completed for a field. The higher the weight, + the higher the priority to show the value in the completion suggestion. + If the value does not occur in the weighted map its weight is defaulted + to zero. +-} +weightedConstantCompleter :: [T.Text] -> Map T.Text Double -> Completer +weightedConstantCompleter completions weights _ cData = do + let scored = if perfectScore > 0 + then fmap Fuzzy.original $ Fuzzy.simpleFilter' 1000 10 prefix completions customMatch + else topTenByWeight + range = completionRange prefInfo + pure $ map (mkSimpleCompletionItem range) scored + where + prefInfo = cabalPrefixInfo cData + prefix = completionPrefix prefInfo + -- this should never return Nothing since we match the word with itself + perfectScore = fromMaybe (error "match is broken") $ Fuzzy.match prefix prefix + customMatch :: (T.Text -> T.Text -> Maybe Int) + customMatch toSearch searchSpace = do + matched <- Fuzzy.match toSearch searchSpace + let weight = fromMaybe 0 $ Map.lookup searchSpace weights + let score = min + perfectScore + (round (fromIntegral matched * (1 + weight))) + pure score + topTenByWeight :: [T.Text] + topTenByWeight = take 10 $ map fst $ List.sortOn (Down . snd) $ Map.assocs weights + +----------------------------------------- +-- Data +----------------------------------------- +weightedLicenseNames :: Map T.Text Double +weightedLicenseNames = fmap statisticsToWeight $ Map.fromList + [("BSD-3-Clause",9955) + , ("MIT",3336) + , ("GPL-3.0-only",679) + , ("LicenseRef-OtherLicense",521) + , ("Apache-2.0",514) + , ("LicenseRef-GPL",443) + , ("LicenseRef-PublicDomain",318) + , ("MPL-2.0",288) + , ("BSD-2-Clause",174) + , ("GPL-2.0-only",160) + , ("LicenseRef-LGPL",146) + , ("LGPL-2.1-only",112) + , ("LGPL-3.0-only",100) + , ("AGPL-3.0-only",96) + , ("ISC",89) + , ("LicenseRef-Apache",45) + , ("GPL-3.0-or-later",43) + , ("BSD-2-Clause-Patent",33) + , ("GPL-2.0-or-later",21) + , ("CC0-1.0",16) + , ("AGPL-3.0-or-later",15) + , ("LGPL-2.1-or-later",12) + , ("(BSD-2-Clause OR Apache-2.0)",10) + , ("(Apache-2.0 OR MPL-2.0)",8) + , ("LicenseRef-AGPL",6) + , ("(BSD-3-Clause OR Apache-2.0)",4) + , ("0BSD",3) + , ("BSD-4-Clause",3) + , ("LGPL-3.0-or-later",3) + , ("LicenseRef-LGPL-2",2) + , ("GPL-2.0-or-later AND BSD-3-Clause",2) + , ("NONE",2) + , ("Zlib",2) + , ("(Apache-2.0 OR BSD-3-Clause)",2) + , ("BSD-3-Clause AND GPL-2.0-or-later",2) + , ("BSD-3-Clause AND GPL-3.0-or-later",2) + ] + where + statisticsToWeight :: Int -> Double + statisticsToWeight stat + | stat < 10 = 0.1 + | stat < 20 = 0.3 + | stat < 50 = 0.4 + | stat < 100 = 0.5 + | stat < 500 = 0.6 + | stat < 650 = 0.7 + | otherwise = 0.9 + + +{- | Creates a CompletionItem with the given text as the label + where the completion item kind is keyword. +-} +mkDefaultCompletionItem :: T.Text -> LSP.CompletionItem +mkDefaultCompletionItem label = LSP.CompletionItem + { Compls._label = label + , Compls._labelDetails = Nothing + , Compls._kind = Just LSP.CompletionItemKind_Keyword + , Compls._tags = Nothing + , Compls._detail = Nothing + , Compls._documentation = Nothing + , Compls._deprecated = Nothing + , Compls._preselect = Nothing + , Compls._sortText = Nothing + , Compls._filterText = Nothing + , Compls._insertText = Nothing + , Compls._insertTextFormat = Nothing + , Compls._insertTextMode = Nothing + , Compls._textEdit = Nothing + , Compls._textEditText = Nothing + , Compls._additionalTextEdits = Nothing + , Compls._commitCharacters = Nothing + , Compls._command = Nothing + , Compls._data_ = Nothing + } + +{- | Returns a CompletionItem with the given starting position + and text to be inserted, where the displayed text is the same as the + inserted text. +-} +mkSimpleCompletionItem :: LSP.Range -> T.Text -> LSP.CompletionItem +mkSimpleCompletionItem range txt = mkDefaultCompletionItem txt + & JL.textEdit ?~ LSP.InL (LSP.TextEdit range txt) + +{- | Returns a completionItem with the given starting position, + text to be inserted and text to be displayed in the completion suggestion. +-} +mkCompletionItem :: LSP.Range -> T.Text -> T.Text -> LSP.CompletionItem +mkCompletionItem range insertTxt displayTxt = mkDefaultCompletionItem displayTxt + & JL.textEdit ?~ LSP.InL (LSP.TextEdit range insertTxt) 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 new file mode 100644 index 00000000000..061505d350f --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Snippet.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Ide.Plugin.Cabal.Completion.Completer.Snippet where + +import Control.Monad (forM) +import Data.Function ((&)) +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import Distribution.Compat.Lens ((?~)) +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 + forM + scored + (\compl -> do + let matched = Fuzzy.original compl + let completion = fromMaybe [] $ Map.lookup matched snippetMap + pure $ mkSnippetCompletion (T.unlines 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" + ] + ) + ] + 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 new file mode 100644 index 00000000000..926e41b7bbd --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# 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) + +{- | Takes information needed to build possible completion items +and returns the list of possible completion items +-} +type Completer = Recorder (WithPriority Log) -> CompleterData -> IO [CompletionItem] + +{- | Contains information to be used by completers. +-} +data CompleterData = CompleterData + { ideState :: IdeState + -- ^ The ideState, which can be used to call the cabal parser results + , cabalPrefixInfo :: CabalPrefixInfo + -- ^ Prefix info to be used for constructing completion items + , stanzaName :: Maybe StanzaName + -- ^ 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 new file mode 100644 index 00000000000..d16ec00cf26 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.Cabal.Completion.Completions where + +import Control.Applicative (asum) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.Trans.Maybe +import qualified Data.List as List +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Text as T +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 qualified Language.LSP.Protocol.Types as LSP +import qualified Language.LSP.VFS as VFS +import qualified System.FilePath as FP +import System.FilePath (takeBaseName) + +-- ---------------------------------------------------------------- +-- Public API for Completions +-- ---------------------------------------------------------------- + +{- | Takes information about the completion status within the file + and finds the correct completer to be applied. +-} +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) +-- 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) = + case Map.lookup kw (cabalVersionKeyword <> cabalKeywords) of + Nothing -> \recorder cData -> do + logWith recorder Warning $ LogUnknownKeyWordInContextError kw + noopCompleter recorder cData + 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 n, None) = + case Map.lookup s stanzaKeywordMap of + Nothing -> \recorder cData -> do + logWith recorder Warning $ LogUnknownStanzaNameInContextError s + noopCompleter recorder cData + Just l -> constantCompleter $ Map.keys (l n) ++ Map.keys stanzaKeywordMap +-- if we are in a stanza's keyword's context we can complete possible values of that keyword +contextToCompleter (Stanza s n, KeyWord kw) = + case Map.lookup s stanzaKeywordMap of + Nothing -> \recorder cData -> do + logWith recorder Warning $ LogUnknownStanzaNameInContextError s + noopCompleter recorder cData + Just m -> case Map.lookup kw (m n) of + Nothing -> \recorder cData -> do + logWith recorder Warning $ LogUnknownKeyWordInContextError kw + noopCompleter recorder cData + Just l -> l + +{- | Takes prefix info about the previously written text + and a rope (representing a file), returns the corresponding context. + + Can return Nothing if an error occurs. + TODO: first line can only have cabal-version: keyword +-} +getContext :: (MonadIO m) => Recorder (WithPriority Log) -> CabalPrefixInfo -> Rope -> MaybeT m Context +getContext recorder prefInfo ls = + case prevLinesM of + Just prevLines -> do + let lvlContext = + if completionIndentation prefInfo == 0 + then TopLevel + else currentLevel prevLines + case lvlContext of + TopLevel -> do + kwContext <- MaybeT . pure $ getKeyWordContext prefInfo prevLines (cabalVersionKeyword <> cabalKeywords) + pure (TopLevel, kwContext) + Stanza s n -> + case Map.lookup s stanzaKeywordMap of + Nothing -> do + pure (Stanza s n, None) + Just m -> do + kwContext <- MaybeT . pure $ getKeyWordContext prefInfo prevLines $ m n + pure (Stanza s n, kwContext) + Nothing -> do + logWith recorder Warning $ LogFileSplitError pos + -- basically returns nothing + fail "Abort computation" + where + pos = completionCursorPosition prefInfo + prevLinesM = splitAtPosition pos ls + +-- ---------------------------------------------------------------- +-- Helper Functions +-- ---------------------------------------------------------------- + +{- | Takes prefix info about the previously written text, + a list of lines (representing a file) and a map of + keywords and returns a keyword context if the + previously written keyword matches one in the map. +-} +getKeyWordContext :: CabalPrefixInfo -> [T.Text] -> Map KeyWordName a -> Maybe KeyWordContext +getKeyWordContext prefInfo ls keywords = do + case lastNonEmptyLineM of + Nothing -> Just None + Just lastLine' -> do + let (whiteSpaces, lastLine) = T.span (== ' ') lastLine' + let keywordIndentation = T.length whiteSpaces + let cursorIndentation = completionIndentation prefInfo + -- in order to be in a keyword context the cursor needs + -- to be indented more than the keyword + if cursorIndentation > keywordIndentation + then -- if the last thing written was a keyword without a value + case List.find (`T.isPrefixOf` lastLine) (Map.keys keywords) of + Nothing -> Just None + Just kw -> Just $ KeyWord kw + else Just None + where + lastNonEmptyLineM :: Maybe T.Text + lastNonEmptyLineM = do + (curLine, rest) <- List.uncons ls + -- represents the current line while disregarding the + -- currently written text we want to complete + let cur = stripPartiallyWritten curLine + List.find (not . T.null . T.stripEnd) $ + cur : rest + +{- | Parse the given set of lines (starting before current cursor position + up to the start of the file) to find the nearest stanza declaration, + if none is found we are in the top level context. +-} +currentLevel :: [T.Text] -> StanzaContext +currentLevel [] = TopLevel +currentLevel (cur : xs) + | Just (s, n) <- stanza = Stanza s n + | otherwise = currentLevel xs + where + stanza = asum $ map checkStanza (Map.keys stanzaKeywordMap) + checkStanza :: StanzaType -> Maybe (StanzaType, Maybe StanzaName) + checkStanza t = + case T.stripPrefix t (T.strip cur) of + Just n + | T.null n -> Just (t,Nothing) + | otherwise -> Just (t, Just $ T.strip n) + Nothing -> Nothing + +{- | Get all lines before the given cursor position in the given file + and reverse their order to traverse backwards starting from the given position. +-} +splitAtPosition :: Position -> Rope -> Maybe [T.Text] +splitAtPosition pos ls = do + split <- splitFile + pure $ reverse $ Rope.lines $ fst split + where + splitFile = Rope.splitAtPosition ropePos ls + ropePos = + Rope.Position + { Rope.posLine = fromIntegral $ pos ^. JL.line + , Rope.posColumn = fromIntegral $ pos ^. JL.character + } + +{- | Takes a line of text and removes the last partially +written word to be completed. +-} +stripPartiallyWritten :: T.Text -> T.Text +stripPartiallyWritten = T.dropWhileEnd (\y -> (y /= ' ') && (y /= ':')) + +{- | Takes information about the current file's file path, + the current cursor position in the file + and its contents; and builds a CabalCompletionItem + with the prefix up to that cursor position, + checks whether a suffix needs to be completed, + and calculates the range in the document in which to complete. +-} +getCabalPrefixInfo :: FilePath -> VFS.PosPrefixInfo -> CabalPrefixInfo +getCabalPrefixInfo fp prefixInfo = + CabalPrefixInfo + { completionPrefix = completionPrefix' + , completionSuffix = Just suffix + , completionCursorPosition = VFS.cursorPos prefixInfo + , completionRange = Range completionStart completionEnd + , completionWorkingDir = FP.takeDirectory fp + , normalizedCabalFilePath = LSP.toNormalizedFilePath fp + , completionFileName = T.pack $ takeBaseName fp + } + where + completionEnd = VFS.cursorPos prefixInfo + completionStart = + Position + (_line completionEnd) + (_character completionEnd - (fromIntegral $ T.length completionPrefix')) + (beforeCursorText, afterCursorText) = T.splitAt cursorColumn $ VFS.fullLine prefixInfo + completionPrefix' = T.takeWhileEnd (not . (`elem` stopConditionChars)) beforeCursorText + suffix = + if apostropheOrSpaceSeparator == '\"' && even (T.count "\"" afterCursorText) + then "\"" + else "" + apostropheOrSpaceSeparator = + if odd $ T.count "\"" beforeCursorText + then '\"' + else ' ' + 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 : [',', ':'] + +-- | 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 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 new file mode 100644 index 00000000000..31aa37e7551 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Ide.Plugin.Cabal.Completion.Data where + +import Data.Map (Map) +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) +-- ---------------------------------------------------------------- +-- Completion Data +-- ---------------------------------------------------------------- + +-- | Keyword for cabal version; required to be the top line in a cabal file +cabalVersionKeyword :: Map KeyWordName Completer +cabalVersionKeyword = + Map.singleton "cabal-version:" $ + constantCompleter $ + map (T.pack . showCabalSpecVersion) [CabalSpecV2_2 .. maxBound] + +{- | Top level keywords of a cabal file. + + TODO: we could add descriptions of field values and then show them when inside the field's context +-} +cabalKeywords :: Map KeyWordName Completer +cabalKeywords = + Map.fromList + [ ("name:", nameCompleter) + , ("version:", noopCompleter) + , ("build-type:", constantCompleter ["Simple", "Custom", "Configure", "Make"]) + , ("license:", weightedConstantCompleter licenseNames weightedLicenseNames) + , ("license-file:", filePathCompleter) + , ("license-files:", filePathCompleter) -- list of filenames + , ("copyright:", noopCompleter) + , ("author:", noopCompleter) + , ("maintainer:", noopCompleter) -- email address, use git config? + , ("stability:", noopCompleter) + , ("homepage:", noopCompleter) + , ("bug-reports:", noopCompleter) + , ("package-url:", noopCompleter) + , ("synopsis:", noopCompleter) + , ("description:", noopCompleter) + , ("category:", noopCompleter) + , ("tested-with:", constantCompleter ["GHC"]) -- list of compilers, i.e. "GHC == 8.6.3, GHC == 8.4.4" + , ("data-files:", filePathCompleter) -- list of filenames + , ("data-dir:", directoryCompleter) -- directory + , ("extra-source-files:", filePathCompleter) -- filename list + , ("extra-doc-files:", filePathCompleter) -- filename list + , ("extra-tmp-files:", filePathCompleter) -- filename list + ] + +-- | Map, containing all stanzas in a cabal file as keys and lists of their possible nested keywords as values +stanzaKeywordMap :: Map StanzaType (Maybe StanzaName -> Map KeyWordName Completer) +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 + ) + , + ( "executable" + , \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 + ) + , + ( "benchmark" + , \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) + ] + ) + , + ( "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) + ] + ) + , + ( "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) + ] + ) + ] + where + libExecTestBenchCommons = + [ ("build-depends:", noopCompleter) + , ("hs-source-dirs:", directoryCompleter) + , ("default-extensions:", noopCompleter) + , ("other-extensions:", noopCompleter) + , ("default-language:", constantCompleter ["GHC2021", "Haskell2010", "Haskell98"]) + , ("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 + , ("ghc-prof-options:", noopCompleter) + , ("ghc-shared-options:", noopCompleter) + , ("ghcjs-options:", noopCompleter) + , ("ghcjs-prof-options:", noopCompleter) + , ("ghcjs-shared-options:", noopCompleter) + , ("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:", directoryCompleter) -- list of directories + , ("cc-options:", noopCompleter) + , ("cpp-options:", noopCompleter) + , ("cxx-options:", noopCompleter) + , ("cmm-options:", noopCompleter) + , ("asm-options:", noopCompleter) + , ("ld-options:", noopCompleter) + , ("pkgconfig-depends:", noopCompleter) + , ("frameworks:", noopCompleter) + , ("extra-framework-dirs:", directoryCompleter) -- list of directories + , ("mixins:", noopCompleter) + ] + +-- cabalFlagKeywords :: [(T.Text, T.Text)] +-- cabalFlagKeywords = +-- [ +-- ("flag", "name"), +-- ("description:", "freeform"), +-- ("default:", "boolean"), +-- ("manual:", "boolean") +-- ] + +-- cabalStanzaKeywords :: [(T.Text, T.Text)] +-- cabalStanzaKeywords = +-- [ +-- ("common", "name"), +-- ("import:", "token-list") +-- ] diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs similarity index 83% rename from plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Types.hs rename to plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs index b82b8386b57..1b44c0d8e60 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs @@ -4,7 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -module Ide.Plugin.Cabal.Types where + +module Ide.Plugin.Cabal.Completion.Types where import Control.DeepSeq (NFData) import Data.Hashable @@ -13,7 +14,6 @@ import Data.Typeable import Development.IDE as D import GHC.Generics import qualified Ide.Plugin.Cabal.Parse as Parse -import Language.LSP.Protocol.Types (CompletionItem) data Log = LogFileSplitError Position @@ -34,29 +34,13 @@ instance Pretty Log where "Filepath:" <+> viaShow fp <+> viaShow ioErr LogUseWithStaleFastNoResult -> "Package description couldn't be read" +type instance RuleResult ParseCabal = Parse.GenericPackageDescription + data ParseCabal = ParseCabal deriving (Eq, Show, Typeable, Generic) instance Hashable ParseCabal instance NFData ParseCabal -type instance RuleResult ParseCabal = Parse.GenericPackageDescription - - -{- | Takes information needed to build possible completion items -and returns the list of possible completion items --} -type Completer = Recorder (WithPriority Log) -> CompleterData -> IO [CompletionItem] - -{- | Contains information to be used by completers. --} -data CompleterData = CompleterData - { ideState :: IdeState --- ^ The ideState, which can be used to call the cabal parser results - , cabalPrefixInfo :: CabalPrefixInfo --- ^ Prefix info to be used for constructing completion items - , stanzaName :: Maybe StanzaName --- ^ The name of the stanza in which the completer is applied - } {- | The context a cursor can be in within a cabal file, we can be in stanzas or the top level, diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs deleted file mode 100644 index bb0e2c3ea84..00000000000 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completions.hs +++ /dev/null @@ -1,764 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} - - -module Ide.Plugin.Cabal.Completions where - -import Control.Applicative (asum) -import Control.Monad (forM) -import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Trans.Maybe -import Data.Function ((&)) -import qualified Data.List as List -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Maybe (fromJust, fromMaybe) -import Data.Ord (Down (..)) -import qualified Data.Text as T -import Data.Text.Utf16.Rope (Rope) -import qualified Data.Text.Utf16.Rope as Rope -import Development.IDE as D -import Distribution.CabalSpecVersion (CabalSpecVersion (CabalSpecV2_2), - showCabalSpecVersion) -import Distribution.Compat.Lens ((?~), (^.)) -import Distribution.PackageDescription (CondTree (..), - GenericPackageDescription (..), - Library (libBuildInfo), - hsSourceDirs) -import Distribution.Types.Benchmark (Benchmark (..)) -import Distribution.Types.Executable (Executable (..)) -import Distribution.Types.TestSuite (TestSuite (..)) -import Distribution.Types.UnqualComponentName -import Distribution.Utils.Path (getSymbolicPath) -import Ide.Plugin.Cabal.FilepathCompletions -import Ide.Plugin.Cabal.LicenseSuggest (licenseNames) -import Ide.Plugin.Cabal.Types -import qualified Language.LSP.Protocol.Lens as JL -import qualified Language.LSP.Protocol.Types as Compls (CompletionItem (..)) -import qualified Language.LSP.Protocol.Types as LSP -import qualified Language.LSP.VFS as VFS -import qualified System.FilePath as FP -import System.FilePath (takeBaseName) -import qualified Text.Fuzzy.Parallel as Fuzzy - --- ---------------------------------------------------------------- --- Public API for Completions --- ---------------------------------------------------------------- - -{- | Takes information about the completion status within the file - and finds the correct completer to be applied. --} -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) --- 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) = - case Map.lookup kw (cabalVersionKeyword <> cabalKeywords) of - Nothing -> \recorder cData -> do - logWith recorder Warning $ LogUnknownKeyWordInContextError kw - noopCompleter recorder cData - 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 n, None) = - case Map.lookup s stanzaKeywordMap of - Nothing -> \recorder cData -> do - logWith recorder Warning $ LogUnknownStanzaNameInContextError s - noopCompleter recorder cData - Just l -> constantCompleter $ Map.keys (l n) ++ Map.keys stanzaKeywordMap --- if we are in a stanza's keyword's context we can complete possible values of that keyword -contextToCompleter (Stanza s n, KeyWord kw) = - case Map.lookup s stanzaKeywordMap of - Nothing -> \recorder cData -> do - logWith recorder Warning $ LogUnknownStanzaNameInContextError s - noopCompleter recorder cData - Just m -> case Map.lookup kw (m n) of - Nothing -> \recorder cData -> do - logWith recorder Warning $ LogUnknownKeyWordInContextError kw - noopCompleter recorder cData - Just l -> l - -{- | Takes prefix info about the previously written text - and a rope (representing a file), returns the corresponding context. - - Can return Nothing if an error occurs. - TODO: first line can only have cabal-version: keyword --} -getContext :: (MonadIO m) => Recorder (WithPriority Log) -> CabalPrefixInfo -> Rope -> MaybeT m Context -getContext recorder prefInfo ls = - case prevLinesM of - Just prevLines -> do - let lvlContext = - if completionIndentation prefInfo == 0 - then TopLevel - else currentLevel prevLines - case lvlContext of - TopLevel -> do - kwContext <- MaybeT . pure $ getKeyWordContext prefInfo prevLines (cabalVersionKeyword <> cabalKeywords) - pure (TopLevel, kwContext) - Stanza s n -> - case Map.lookup s stanzaKeywordMap of - Nothing -> do - pure (Stanza s n, None) - Just m -> do - kwContext <- MaybeT . pure $ getKeyWordContext prefInfo prevLines $ m n - pure (Stanza s n, kwContext) - Nothing -> do - logWith recorder Warning $ LogFileSplitError pos - -- basically returns nothing - fail "Abort computation" - where - pos = completionCursorPosition prefInfo - prevLinesM = splitAtPosition pos ls - --- ---------------------------------------------------------------- --- Helper Functions --- ---------------------------------------------------------------- - -{- | Takes prefix info about the previously written text, - a list of lines (representing a file) and a map of - keywords and returns a keyword context if the - previously written keyword matches one in the map. --} -getKeyWordContext :: CabalPrefixInfo -> [T.Text] -> Map KeyWordName a -> Maybe KeyWordContext -getKeyWordContext prefInfo ls keywords = do - case lastNonEmptyLineM of - Nothing -> Just None - Just lastLine' -> do - let (whiteSpaces, lastLine) = T.span (== ' ') lastLine' - let keywordIndentation = T.length whiteSpaces - let cursorIndentation = completionIndentation prefInfo - -- in order to be in a keyword context the cursor needs - -- to be indented more than the keyword - if cursorIndentation > keywordIndentation - then -- if the last thing written was a keyword without a value - case List.find (`T.isPrefixOf` lastLine) (Map.keys keywords) of - Nothing -> Just None - Just kw -> Just $ KeyWord kw - else Just None - where - lastNonEmptyLineM :: Maybe T.Text - lastNonEmptyLineM = do - (curLine, rest) <- List.uncons ls - -- represents the current line while disregarding the - -- currently written text we want to complete - let cur = stripPartiallyWritten curLine - List.find (not . T.null . T.stripEnd) $ - cur : rest - -{- | Parse the given set of lines (starting before current cursor position - up to the start of the file) to find the nearest stanza declaration, - if none is found we are in the top level context. --} -currentLevel :: [T.Text] -> StanzaContext -currentLevel [] = TopLevel -currentLevel (cur : xs) - | Just (s, n) <- stanza = Stanza s n - | otherwise = currentLevel xs - where - stanza = asum $ map checkStanza (Map.keys stanzaKeywordMap) - checkStanza :: StanzaType -> Maybe (StanzaType, Maybe StanzaName) - checkStanza t = - case T.stripPrefix t (T.strip cur) of - Just n - | T.null n -> Just (t,Nothing) - | otherwise -> Just (t, Just $ T.strip n) - Nothing -> Nothing - -{- | Creates a CompletionItem with the given text as the label - where the completion item kind is keyword. --} -mkDefaultCompletionItem :: T.Text -> LSP.CompletionItem -mkDefaultCompletionItem label = LSP.CompletionItem - { Compls._label = label - , Compls._labelDetails = Nothing - , Compls._kind = Just LSP.CompletionItemKind_Keyword - , Compls._tags = Nothing - , Compls._detail = Nothing - , Compls._documentation = Nothing - , Compls._deprecated = Nothing - , Compls._preselect = Nothing - , Compls._sortText = Nothing - , Compls._filterText = Nothing - , Compls._insertText = Nothing - , Compls._insertTextFormat = Nothing - , Compls._insertTextMode = Nothing - , Compls._textEdit = Nothing - , Compls._textEditText = Nothing - , Compls._additionalTextEdits = Nothing - , Compls._commitCharacters = Nothing - , Compls._command = Nothing - , Compls._data_ = Nothing - } - -{- | Returns a CompletionItem with the given starting position - and text to be inserted, where the displayed text is the same as the - inserted text. --} -mkSimpleCompletionItem :: Range -> T.Text -> LSP.CompletionItem -mkSimpleCompletionItem range txt = mkDefaultCompletionItem txt - & JL.textEdit ?~ LSP.InL (LSP.TextEdit range txt) - -{- | Returns a completionItem with the given starting position, - text to be inserted and text to be displayed in the completion suggestion. --} -mkCompletionItem :: Range -> T.Text -> T.Text -> LSP.CompletionItem -mkCompletionItem range insertTxt displayTxt = mkDefaultCompletionItem displayTxt - & JL.textEdit ?~ LSP.InL (LSP.TextEdit range insertTxt) - -{- | Get all lines before the given cursor position in the given file - and reverse their order to traverse backwards starting from the given position. --} -splitAtPosition :: Position -> Rope -> Maybe [T.Text] -splitAtPosition pos ls = do - split <- splitFile - pure $ reverse $ Rope.lines $ fst split - where - splitFile = Rope.splitAtPosition ropePos ls - ropePos = - Rope.Position - { Rope.posLine = fromIntegral $ pos ^. JL.line - , Rope.posColumn = fromIntegral $ pos ^. JL.character - } - -{- | Takes a line of text and removes the last partially -written word to be completed. --} -stripPartiallyWritten :: T.Text -> T.Text -stripPartiallyWritten = T.dropWhileEnd (\y -> (y /= ' ') && (y /= ':')) - -{- | Takes information about the current file's file path, - the current cursor position in the file - and its contents; and builds a CabalCompletionItem - with the prefix up to that cursor position, - checks whether a suffix needs to be completed, - and calculates the range in the document in which to complete. --} -getCabalPrefixInfo :: FilePath -> VFS.PosPrefixInfo -> CabalPrefixInfo -getCabalPrefixInfo fp prefixInfo = - CabalPrefixInfo - { completionPrefix = completionPrefix' - , completionSuffix = Just suffix - , completionCursorPosition = VFS.cursorPos prefixInfo - , completionRange = Range completionStart completionEnd - , completionWorkingDir = FP.takeDirectory fp - , normalizedCabalFilePath = LSP.toNormalizedFilePath fp - , completionFileName = T.pack $ takeBaseName fp - } - where - completionEnd = VFS.cursorPos prefixInfo - completionStart = - Position - (_line completionEnd) - (_character completionEnd - (fromIntegral $ T.length completionPrefix')) - (beforeCursorText, afterCursorText) = T.splitAt cursorColumn $ VFS.fullLine prefixInfo - completionPrefix' = T.takeWhileEnd (not . (`elem` stopConditionChars)) beforeCursorText - suffix = - if apostropheOrSpaceSeparator == '\"' && even (T.count "\"" afterCursorText) - then "\"" - else "" - apostropheOrSpaceSeparator = - if odd $ T.count "\"" beforeCursorText - then '\"' - else ' ' - 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 : [',', ':'] - --- | 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 - - --- ---------------------------------------------------------------- --- Completer API --- ---------------------------------------------------------------- - -{- | Completer to be used when no completion suggestions - are implemented for the field --} -noopCompleter :: Completer -noopCompleter _ _ = pure [] - -{- | Completer to be used when a simple set of values - can be completed for a field --} -constantCompleter :: [T.Text] -> Completer -constantCompleter completions _ cData = do - let prefInfo = cabalPrefixInfo cData - scored = Fuzzy.simpleFilter 1000 10 (completionPrefix prefInfo) completions - range = completionRange prefInfo - pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored - --- | Completer to be used for the name field's value -nameCompleter :: Completer -nameCompleter _ cData = do - let scored = Fuzzy.simpleFilter 1000 10 (completionPrefix prefInfo) [completionFileName prefInfo] - prefInfo = cabalPrefixInfo cData - range = completionRange prefInfo - pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored - --- | Maps snippet triggerwords with their completers -snippetCompleter :: Completer -snippetCompleter _ cData = do - let scored = Fuzzy.simpleFilter 1000 10 (completionPrefix prefInfo) $ Map.keys snippetMap - forM - scored - (\compl -> do - let matched = Fuzzy.original compl - let completion = fromMaybe [] $ Map.lookup matched snippetMap - pure $ mkSnippetCompletion (T.unlines 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" - ] - ) - ] - -{- | Completer to be used when a set of values with priority weights - attached to some values are to be completed for a field. The higher the weight, - the higher the priority to show the value in the completion suggestion. - If the value does not occur in the weighted map its weight is defaulted - to zero. --} -weightedConstantCompleter :: [T.Text] -> Map T.Text Double -> Completer -weightedConstantCompleter completions weights _ cData = do - let scored = if perfectScore > 0 - then fmap Fuzzy.original $ Fuzzy.simpleFilter' 1000 10 prefix completions customMatch - else topTenByWeight - range = completionRange prefInfo - pure $ map (mkSimpleCompletionItem range) scored - where - prefInfo = cabalPrefixInfo cData - prefix = completionPrefix prefInfo - -- this should never return Nothing since we match the word with itself - perfectScore = fromMaybe (error "match is broken") $ Fuzzy.match prefix prefix - customMatch :: (T.Text -> T.Text -> Maybe Int) - customMatch toSearch searchSpace = do - matched <- Fuzzy.match toSearch searchSpace - let weight = fromMaybe 0 $ Map.lookup searchSpace weights - let score = min - perfectScore - (round (fromIntegral matched * (1 + weight))) - pure score - topTenByWeight :: [T.Text] - topTenByWeight = take 10 $ map fst $ List.sortOn (Down . snd) $ Map.assocs weights - -{- | Completer to be used when a file path can be - completed for a field, takes the file path of the directory to start from. - Completes file paths as well as directories. --} -filePathCompleter :: Completer -filePathCompleter recorder cData = do - let prefInfo = cabalPrefixInfo cData - suffix = fromMaybe "" $ completionSuffix prefInfo - complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo - toMatch = fromMaybe (partialFileName complInfo) $ T.stripPrefix "./" $ partialFileName complInfo - filePathCompletions <- listFileCompletions recorder complInfo - let scored = Fuzzy.simpleFilter 1000 10 toMatch (map T.pack filePathCompletions) - forM - scored - ( \compl' -> do - let compl = Fuzzy.original compl' - fullFilePath <- mkFilePathCompletion suffix compl complInfo - pure $ mkCompletionItem (completionRange prefInfo) fullFilePath fullFilePath - ) - -{- | Completer to be used when module paths can be completed for the field. - - Takes an extraction function which extracts the source directories - to be used by the completer. --} -modulesCompleter :: (GenericPackageDescription -> [FilePath]) -> Completer -modulesCompleter extractionFunction recorder cData = do - maybeGpd <- runIdeAction "cabal-plugin.modulesCompleter.parseCabal" extras - $ useWithStaleFast ParseCabal $ normalizedCabalFilePath prefInfo - case maybeGpd of - Just (gpd, _) -> do - let sourceDirs = extractionFunction gpd - filePathCompletions <- filePathsForExposedModules sourceDirs recorder prefInfo - pure $ map (\compl -> mkCompletionItem (completionRange prefInfo) compl compl) filePathCompletions - Nothing -> do - logWith recorder Debug LogUseWithStaleFastNoResult - pure [] - where - extras = shakeExtras (ideState cData) - prefInfo = cabalPrefixInfo cData - -{- | Extracts the source directories of the library stanza. --} -sourceDirsExtractionLibrary :: GenericPackageDescription -> [FilePath] -sourceDirsExtractionLibrary 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 - -{- | 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 - -{- | 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 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 - | 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 - -{- | Completer to be used when a directory can be completed for the field, - takes the file path of the directory to start from. - Only completes directories. --} -directoryCompleter :: Completer -directoryCompleter recorder cData = do - let prefInfo = cabalPrefixInfo cData - complInfo = pathCompletionInfoFromCabalPrefixInfo prefInfo - directoryCompletions <- listDirectoryCompletions recorder complInfo - let scored = - Fuzzy.simpleFilter - 1000 - 10 - (partialFileName complInfo) - (map T.pack directoryCompletions) - forM - scored - ( \compl' -> do - let compl = Fuzzy.original compl' - let fullDirPath = mkPathCompletion complInfo compl - pure $ mkCompletionItem (completionRange prefInfo) fullDirPath fullDirPath - ) - - --- ---------------------------------------------------------------- --- Completion Data --- ---------------------------------------------------------------- - --- | Keyword for cabal version; required to be the top line in a cabal file -cabalVersionKeyword :: Map KeyWordName Completer -cabalVersionKeyword = - Map.singleton "cabal-version:" $ - constantCompleter $ - map (T.pack . showCabalSpecVersion) [CabalSpecV2_2 .. maxBound] - -{- | Top level keywords of a cabal file. - - TODO: we could add descriptions of field values and then show them when inside the field's context --} -cabalKeywords :: Map KeyWordName Completer -cabalKeywords = - Map.fromList - [ ("name:", nameCompleter) - , ("version:", noopCompleter) - , ("build-type:", constantCompleter ["Simple", "Custom", "Configure", "Make"]) - , ("license:", weightedConstantCompleter licenseNames weightedLicenseNames) - , ("license-file:", filePathCompleter) - , ("license-files:", filePathCompleter) -- list of filenames - , ("copyright:", noopCompleter) - , ("author:", noopCompleter) - , ("maintainer:", noopCompleter) -- email address, use git config? - , ("stability:", noopCompleter) - , ("homepage:", noopCompleter) - , ("bug-reports:", noopCompleter) - , ("package-url:", noopCompleter) - , ("synopsis:", noopCompleter) - , ("description:", noopCompleter) - , ("category:", noopCompleter) - , ("tested-with:", constantCompleter ["GHC"]) -- list of compilers, i.e. "GHC == 8.6.3, GHC == 8.4.4" - , ("data-files:", filePathCompleter) -- list of filenames - , ("data-dir:", directoryCompleter) -- directory - , ("extra-source-files:", filePathCompleter) -- filename list - , ("extra-doc-files:", filePathCompleter) -- filename list - , ("extra-tmp-files:", filePathCompleter) -- filename list - ] - --- | Map, containing all stanzas in a cabal file as keys and lists of their possible nested keywords as values -stanzaKeywordMap :: Map StanzaType (Maybe StanzaName -> Map KeyWordName Completer) -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 - ) - , - ( "executable" - , \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 - ) - , - ( "benchmark" - , \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) - ] - ) - , - ( "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) - ] - ) - , - ( "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) - ] - ) - ] - where - libExecTestBenchCommons = - [ ("build-depends:", noopCompleter) - , ("hs-source-dirs:", directoryCompleter) - , ("default-extensions:", noopCompleter) - , ("other-extensions:", noopCompleter) - , ("default-language:", constantCompleter ["GHC2021", "Haskell2010", "Haskell98"]) - , ("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 - , ("ghc-prof-options:", noopCompleter) - , ("ghc-shared-options:", noopCompleter) - , ("ghcjs-options:", noopCompleter) - , ("ghcjs-prof-options:", noopCompleter) - , ("ghcjs-shared-options:", noopCompleter) - , ("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:", directoryCompleter) -- list of directories - , ("cc-options:", noopCompleter) - , ("cpp-options:", noopCompleter) - , ("cxx-options:", noopCompleter) - , ("cmm-options:", noopCompleter) - , ("asm-options:", noopCompleter) - , ("ld-options:", noopCompleter) - , ("pkgconfig-depends:", noopCompleter) - , ("frameworks:", noopCompleter) - , ("extra-framework-dirs:", directoryCompleter) -- list of directories - , ("mixins:", noopCompleter) - ] - -weightedLicenseNames :: Map T.Text Double -weightedLicenseNames = fmap statisticsToWeight $ Map.fromList - [("BSD-3-Clause",9955) - , ("MIT",3336) - , ("GPL-3.0-only",679) - , ("LicenseRef-OtherLicense",521) - , ("Apache-2.0",514) - , ("LicenseRef-GPL",443) - , ("LicenseRef-PublicDomain",318) - , ("MPL-2.0",288) - , ("BSD-2-Clause",174) - , ("GPL-2.0-only",160) - , ("LicenseRef-LGPL",146) - , ("LGPL-2.1-only",112) - , ("LGPL-3.0-only",100) - , ("AGPL-3.0-only",96) - , ("ISC",89) - , ("LicenseRef-Apache",45) - , ("GPL-3.0-or-later",43) - , ("BSD-2-Clause-Patent",33) - , ("GPL-2.0-or-later",21) - , ("CC0-1.0",16) - , ("AGPL-3.0-or-later",15) - , ("LGPL-2.1-or-later",12) - , ("(BSD-2-Clause OR Apache-2.0)",10) - , ("(Apache-2.0 OR MPL-2.0)",8) - , ("LicenseRef-AGPL",6) - , ("(BSD-3-Clause OR Apache-2.0)",4) - , ("0BSD",3) - , ("BSD-4-Clause",3) - , ("LGPL-3.0-or-later",3) - , ("LicenseRef-LGPL-2",2) - , ("GPL-2.0-or-later AND BSD-3-Clause",2) - , ("NONE",2) - , ("Zlib",2) - , ("(Apache-2.0 OR BSD-3-Clause)",2) - , ("BSD-3-Clause AND GPL-2.0-or-later",2) - , ("BSD-3-Clause AND GPL-3.0-or-later",2) - ] - where - statisticsToWeight :: Int -> Double - statisticsToWeight stat - | stat < 10 = 0.1 - | stat < 20 = 0.3 - | stat < 50 = 0.4 - | stat < 100 = 0.5 - | stat < 500 = 0.6 - | stat < 650 = 0.7 - | otherwise = 0.9 - --- cabalFlagKeywords :: [(T.Text, T.Text)] --- cabalFlagKeywords = --- [ --- ("flag", "name"), --- ("description:", "freeform"), --- ("default:", "boolean"), --- ("manual:", "boolean") --- ] - --- cabalStanzaKeywords :: [(T.Text, T.Text)] --- cabalStanzaKeywords = --- [ --- ("common", "name"), --- ("import:", "token-list") --- ] diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index 31cc2c97864..c02dc23942c 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -9,25 +9,27 @@ module Main ( main, ) where -import Control.Lens ((^.)) -import Control.Monad (guard) -import Control.Monad.Trans.Maybe (runMaybeT) -import qualified Data.ByteString as BS -import Data.Either (isRight) -import Data.List (sort) +import Control.Lens ((^.)) +import Control.Monad (guard) +import Control.Monad.Trans.Maybe (runMaybeT) +import qualified Data.ByteString as BS +import Data.Either (isRight) +import Data.List (sort) import Data.Row -import qualified Data.Text as T -import qualified Data.Text as Text -import qualified Data.Text.Utf16.Rope as Rope +import qualified Data.Text as T +import qualified Data.Text as Text +import qualified Data.Text.Utf16.Rope as Rope import Ide.Plugin.Cabal -import Ide.Plugin.Cabal.Completions -import Ide.Plugin.Cabal.FilepathCompletions -import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) -import qualified Ide.Plugin.Cabal.Parse as Lib -import Ide.Plugin.Cabal.Types -import qualified Language.LSP.Protocol.Lens as L -import qualified Language.LSP.VFS as VFS -import System.Directory (getCurrentDirectory) +import Ide.Plugin.Cabal.Completion.Completer.FilePath +import Ide.Plugin.Cabal.Completion.Completer.Module +import Ide.Plugin.Cabal.Completion.Completer.Types +import Ide.Plugin.Cabal.Completion.Completions +import Ide.Plugin.Cabal.Completion.Types +import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion) +import qualified Ide.Plugin.Cabal.Parse as Lib +import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.VFS as VFS +import System.Directory (getCurrentDirectory) import System.FilePath import Test.Hls @@ -217,7 +219,7 @@ pathCompleterTests = extract :: CompletionItem -> T.Text extract item = case item ^. L.textEdit of Just (InL v) -> v ^. L.newText - _ -> error "" + _ -> error "" pathCompletionInfoFromCompletionContextTests :: TestTree pathCompletionInfoFromCompletionContextTests =