diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index acede2ec8f..5312276148 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -231,6 +231,7 @@ library hls-cabal-plugin exposed-modules: Ide.Plugin.Cabal Ide.Plugin.Cabal.Diagnostics + Ide.Plugin.Cabal.Completion.CabalFields Ide.Plugin.Cabal.Completion.Completer.FilePath Ide.Plugin.Cabal.Completion.Completer.Module Ide.Plugin.Cabal.Completion.Completer.Paths diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index eb9fed55d7..3c471a21b7 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -18,6 +18,7 @@ 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.Maybe as Maybe import qualified Data.Text.Encoding as Encoding import Data.Typeable import Development.IDE as D @@ -32,7 +33,8 @@ import qualified Distribution.Parsec.Position as Syntax import GHC.Generics import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes import qualified Ide.Plugin.Cabal.Completion.Completions as Completions -import Ide.Plugin.Cabal.Completion.Types (ParseCabalFields (..), +import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections), + ParseCabalFields (..), ParseCabalFile (..)) import qualified Ide.Plugin.Cabal.Completion.Types as Types import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics @@ -170,6 +172,14 @@ cabalRules recorder plId = do Right fields -> pure ([], Just fields) + define (cmapWithPrio LogShake recorder) $ \ParseCabalCommonSections file -> do + fields <- use_ ParseCabalFields file + let commonSections = Maybe.mapMaybe (\case + commonSection@(Syntax.Section (Syntax.Name _ "common") _ _) -> Just commonSection + _ -> Nothing) + fields + pure ([], Just commonSections) + define (cmapWithPrio LogShake recorder) $ \ParseCabalFile file -> do config <- getPluginConfigAction plId if not (plcGlobalOn config && plcDiagnosticsOn config) @@ -342,6 +352,9 @@ completion recorder ide _ complParams = do -- The `withStale` option is very important here, since we often call this rule with invalid cabal files. mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp pure $ fmap fst mGPD + , getCabalCommonSections = do + mSections <- runIdeAction "cabal-plugin.modulesCompleter.commonsections" (shakeExtras ide) $ useWithStaleFast ParseCabalCommonSections $ toNormalizedFilePath fp + pure $ fmap fst mSections , cabalPrefixInfo = prefInfo , stanzaName = case fst ctx of diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs new file mode 100644 index 0000000000..02daa72826 --- /dev/null +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs @@ -0,0 +1,68 @@ +module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName) where + +import Data.List.NonEmpty (NonEmpty) +import qualified Data.List.NonEmpty as NE +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Distribution.Fields as Syntax +import qualified Distribution.Parsec.Position as Syntax +import Ide.Plugin.Cabal.Completion.Types + +-- ---------------------------------------------------------------- +-- Cabal-syntax utilities I don't really want to write myself +-- ---------------------------------------------------------------- + +-- | Determine the context of a cursor position within a stack of stanza contexts +-- +-- If the cursor is indented more than one of the stanzas in the stack +-- the respective stanza is returned if this is never the case, the toplevel stanza +-- in the stack is returned. +findStanzaForColumn :: Int -> NonEmpty (Int, StanzaContext) -> (StanzaContext, FieldContext) +findStanzaForColumn col ctx = case NE.uncons ctx of + ((_, stanza), Nothing) -> (stanza, None) + ((indentation, stanza), Just res) + | col < indentation -> findStanzaForColumn col res + | otherwise -> (stanza, None) + +-- | Determine the field the cursor is currently a part of. +-- +-- The result is said field and its starting position +-- or Nothing if the passed list of fields is empty. + +-- This only looks at the row of the cursor and not at the cursor's +-- position within the row. +-- +-- TODO: we do not handle braces correctly. Add more tests! +findFieldSection :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.Field Syntax.Position) +findFieldSection _cursor [] = Nothing +findFieldSection _cursor [x] = + -- Last field. We decide later, whether we are starting + -- a new section. + Just x +findFieldSection cursor (x:y:ys) + | Syntax.positionRow (getAnnotation x) <= cursorLine && cursorLine < Syntax.positionRow (getAnnotation y) + = Just x + | otherwise = findFieldSection cursor (y:ys) + where + cursorLine = Syntax.positionRow cursor + +type FieldName = T.Text + +getAnnotation :: Syntax.Field ann -> ann +getAnnotation (Syntax.Field (Syntax.Name ann _) _) = ann +getAnnotation (Syntax.Section (Syntax.Name ann _) _ _) = ann + +getFieldName :: Syntax.Field ann -> FieldName +getFieldName (Syntax.Field (Syntax.Name _ fn) _) = T.decodeUtf8 fn +getFieldName (Syntax.Section (Syntax.Name _ fn) _ _) = T.decodeUtf8 fn + +-- | Returns the name of a section if it has a name. +-- +-- This assumes that the given section args belong to named stanza +-- in which case the stanza name is returned. +getOptionalSectionName :: [Syntax.SectionArg ann] -> Maybe T.Text +getOptionalSectionName [] = Nothing +getOptionalSectionName (x:xs) = case x of + Syntax.SecArgName _ name -> Just (T.decodeUtf8 name) + _ -> getOptionalSectionName xs + 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 index 853b9f4b48..b097af5cd2 100644 --- 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Ide.Plugin.Cabal.Completion.Completer.Simple where @@ -7,11 +8,14 @@ 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.Maybe (fromMaybe, + mapMaybe) import Data.Ord (Down (Down)) import qualified Data.Text as T +import qualified Distribution.Fields as Syntax import Ide.Logger (Priority (..), logWith) +import Ide.Plugin.Cabal.Completion.CabalFields import Ide.Plugin.Cabal.Completion.Completer.Types import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..), Log) @@ -41,6 +45,22 @@ constantCompleter completions _ cData = do range = completionRange prefInfo pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored +-- | Completer to be used for import fields. +-- +-- TODO: Does not exclude imports, defined after the current cursor position +-- which are not allowed according to the cabal specification +importCompleter :: Completer +importCompleter l cData = do + cabalCommonsM <- getCabalCommonSections cData + case cabalCommonsM of + Just cabalCommons -> do + let commonNames = mapMaybe (\case + Syntax.Section (Syntax.Name _ "common") commonNames _ -> getOptionalSectionName commonNames + _ -> Nothing) + cabalCommons + constantCompleter commonNames l cData + Nothing -> noopCompleter l cData + -- | Completer to be used for the field @name:@ value. -- -- This is almost always the name of the cabal file. However, 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 65b7343346..968b68919b 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 @@ -3,7 +3,9 @@ module Ide.Plugin.Cabal.Completion.Completer.Types where import Development.IDE as D +import qualified Distribution.Fields as Syntax import Distribution.PackageDescription (GenericPackageDescription) +import qualified Distribution.Parsec.Position as Syntax import Ide.Plugin.Cabal.Completion.Types import Language.LSP.Protocol.Types (CompletionItem) @@ -16,9 +18,11 @@ data CompleterData = CompleterData { -- | Access to the latest available generic package description for the handled cabal file, -- relevant for some completion actions which require the file's meta information -- such as the module completers which require access to source directories - getLatestGPD :: IO (Maybe GenericPackageDescription), + getLatestGPD :: IO (Maybe GenericPackageDescription), + -- | Access to the entries of the handled cabal file as parsed by ParseCabalFields + getCabalCommonSections :: IO (Maybe [Syntax.Field Syntax.Position]), -- | Prefix info to be used for constructing completion items - cabalPrefixInfo :: CabalPrefixInfo, + cabalPrefixInfo :: CabalPrefixInfo, -- | The name of the stanza in which the completer is applied - stanzaName :: Maybe StanzaName + stanzaName :: Maybe StanzaName } 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 6b3f3c9e45..04b6562270 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 @@ -8,11 +8,11 @@ import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Data.Text as T -import qualified Data.Text.Encoding as T import Development.IDE as D import qualified Development.IDE.Plugin.Completions.Types as Ghcide import qualified Distribution.Fields as Syntax import qualified Distribution.Parsec.Position as Syntax +import Ide.Plugin.Cabal.Completion.CabalFields import Ide.Plugin.Cabal.Completion.Completer.Simple import Ide.Plugin.Cabal.Completion.Completer.Snippet import Ide.Plugin.Cabal.Completion.Completer.Types (Completer) @@ -177,57 +177,3 @@ classifyFieldContext ctx cursor field cursorColumn = Syntax.positionCol cursor fieldColumn = Syntax.positionCol (getAnnotation field) - --- ---------------------------------------------------------------- --- Cabal-syntax utilities I don't really want to write myself --- ---------------------------------------------------------------- - --- | Determine the context of a cursor position within a stack of stanza contexts --- --- If the cursor is indented more than one of the stanzas in the stack --- the respective stanza is returned if this is never the case, the toplevel stanza --- in the stack is returned. -findStanzaForColumn :: Int -> NonEmpty (Int, StanzaContext) -> (StanzaContext, FieldContext) -findStanzaForColumn col ctx = case NE.uncons ctx of - ((_, stanza), Nothing) -> (stanza, None) - ((indentation, stanza), Just res) - | col < indentation -> findStanzaForColumn col res - | otherwise -> (stanza, None) - --- | Determine the field the cursor is currently a part of. --- --- The result is said field and its starting position --- or Nothing if the passed list of fields is empty. - --- This only looks at the row of the cursor and not at the cursor's --- position within the row. --- --- TODO: we do not handle braces correctly. Add more tests! -findFieldSection :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.Field Syntax.Position) -findFieldSection _cursor [] = Nothing -findFieldSection _cursor [x] = - -- Last field. We decide later, whether we are starting - -- a new section. - Just x -findFieldSection cursor (x:y:ys) - | Syntax.positionRow (getAnnotation x) <= cursorLine && cursorLine < Syntax.positionRow (getAnnotation y) - = Just x - | otherwise = findFieldSection cursor (y:ys) - where - cursorLine = Syntax.positionRow cursor - -type FieldName = T.Text - -getAnnotation :: Syntax.Field ann -> ann -getAnnotation (Syntax.Field (Syntax.Name ann _) _) = ann -getAnnotation (Syntax.Section (Syntax.Name ann _) _ _) = ann - -getFieldName :: Syntax.Field ann -> FieldName -getFieldName (Syntax.Field (Syntax.Name _ fn) _) = T.decodeUtf8 fn -getFieldName (Syntax.Section (Syntax.Name _ fn) _ _) = T.decodeUtf8 fn - -getOptionalSectionName :: [Syntax.SectionArg ann] -> Maybe T.Text -getOptionalSectionName [] = Nothing -getOptionalSectionName (x:xs) = case x of - Syntax.SecArgName _ name -> Just (T.decodeUtf8 name) - _ -> getOptionalSectionName xs 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 143dfaadff..44535607ab 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 @@ -162,7 +162,8 @@ flagFields = libExecTestBenchCommons :: Map KeyWordName Completer libExecTestBenchCommons = Map.fromList - [ ("build-depends:", noopCompleter), + [ ("import:", importCompleter), + ("build-depends:", noopCompleter), ("hs-source-dirs:", directoryCompleter), ("default-extensions:", noopCompleter), ("other-extensions:", noopCompleter), 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 c39362e826..ab53ce658b 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 @@ -59,6 +59,15 @@ instance Hashable ParseCabalFields instance NFData ParseCabalFields +type instance RuleResult ParseCabalCommonSections = [Syntax.Field Syntax.Position] + +data ParseCabalCommonSections = ParseCabalCommonSections + deriving (Eq, Show, Typeable, Generic) + +instance Hashable ParseCabalCommonSections + +instance NFData ParseCabalCommonSections + -- | 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/test/Completer.hs b/plugins/hls-cabal-plugin/test/Completer.hs index e7403e9a0e..6b1f772af0 100644 --- a/plugins/hls-cabal-plugin/test/Completer.hs +++ b/plugins/hls-cabal-plugin/test/Completer.hs @@ -1,19 +1,25 @@ {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + module Completer where import Control.Lens ((^.), (^?)) import Control.Lens.Prism import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Char8 as BS8 import Data.Maybe (mapMaybe) import qualified Data.Text as T import qualified Development.IDE.Plugin.Completions.Types as Ghcide +import qualified Distribution.Fields as Syntax import Distribution.PackageDescription (GenericPackageDescription) import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) +import qualified Distribution.Parsec.Position as Syntax import Ide.Plugin.Cabal.Completion.Completer.FilePath import Ide.Plugin.Cabal.Completion.Completer.Module import Ide.Plugin.Cabal.Completion.Completer.Paths +import Ide.Plugin.Cabal.Completion.Completer.Simple (importCompleter) import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..)) import Ide.Plugin.Cabal.Completion.Completions import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..), @@ -33,7 +39,8 @@ completerTests = directoryCompleterTests, completionHelperTests, filePathExposedModulesTests, - exposedModuleCompleterTests + exposedModuleCompleterTests, + importCompleterTests ] basicCompleterTests :: TestTree @@ -290,23 +297,58 @@ exposedModuleCompleterTests = completions @?== [] ] where - simpleCompleterData :: Maybe StanzaName -> FilePath -> T.Text -> CompleterData - simpleCompleterData sName dir pref = do - CompleterData - { cabalPrefixInfo = simpleExposedCabalPrefixInfo pref dir, - getLatestGPD = do - cabalContents <- ByteString.readFile $ testDataDir "exposed.cabal" - pure $ parseGenericPackageDescriptionMaybe cabalContents, - stanzaName = sName - } callModulesCompleter :: Maybe StanzaName -> (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> T.Text -> IO [T.Text] callModulesCompleter sName func prefix = do let cData = simpleCompleterData sName testDataDir prefix completer <- modulesCompleter func mempty cData pure $ fmap extract completer +-- TODO: These tests are a bit barebones at the moment, +-- since we do not take cursorposition into account at this point. +importCompleterTests :: TestTree +importCompleterTests = + testGroup + "Import Completer Tests" + [ testCase "All above common sections are suggested" $ do + completions <- callImportCompleter + ("defaults" `elem` completions) @? "defaults contained" + ("test-defaults" `elem` completions) @? "test-defaults contained" + -- TODO: Only common sections defined before the current stanza may be imported + , testCase "Common sections occuring below are not suggested" $ do + completions <- callImportCompleter + ("notForLib" `elem` completions) @? "notForLib contained, this needs to be fixed" + , testCase "All common sections are suggested when curser is below them" $ do + completions <- callImportCompleter + completions @?== ["defaults", "notForLib" ,"test-defaults"] + ] + where + callImportCompleter :: IO [T.Text] + callImportCompleter = do + let cData' = simpleCompleterData Nothing testDataDir "" + let cabalCommonSections = [makeCommonSection 13 0 "defaults", makeCommonSection 18 0 "test-defaults", makeCommonSection 27 0 "notForLib"] + let cData = cData' {getCabalCommonSections = pure $ Just cabalCommonSections} + completer <- importCompleter mempty cData + pure $ fmap extract completer + makeCommonSection :: Int -> Int -> String -> Syntax.Field Syntax.Position + makeCommonSection row col name = + Syntax.Section + (Syntax.Name (Syntax.Position row col) "common") + [Syntax.SecArgName (Syntax.Position row (col + 7)) (BS8.pack name)] + [] + +simpleCompleterData :: Maybe StanzaName -> FilePath -> T.Text -> CompleterData +simpleCompleterData sName dir pref = do + CompleterData + { cabalPrefixInfo = simpleExposedCabalPrefixInfo pref dir, + getLatestGPD = do + cabalContents <- ByteString.readFile $ testDataDir "exposed.cabal" + pure $ parseGenericPackageDescriptionMaybe cabalContents, + getCabalCommonSections = undefined, + stanzaName = sName + } + mkCompleterData :: CabalPrefixInfo -> CompleterData -mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing} +mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, getCabalCommonSections = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing} exposedTestDir :: FilePath exposedTestDir = addTrailingPathSeparator $ testDataDir "src-modules" @@ -326,3 +368,41 @@ extract :: CompletionItem -> T.Text extract item = case item ^. L.textEdit of Just (InL v) -> v ^. L.newText _ -> error "" + +importTestData :: T.Text +importTestData = [trimming| +cabal-version: 3.0 +name: hls-cabal-plugin +version: 0.1.0.0 +synopsis: +homepage: +license: MIT +license-file: LICENSE +author: Fendor +maintainer: fendor@posteo.de +category: Development +extra-source-files: CHANGELOG.md + +common defaults + default-language: GHC2021 + -- Should have been in GHC2021, an oversight + default-extensions: ExplicitNamespaces + +common test-defaults + ghc-options: -threaded -rtsopts -with-rtsopts=-N + +library + import: + ^ + exposed-modules: IDE.Plugin.Cabal + build-depends: base ^>=4.14.3.0 + hs-source-dirs: src + default-language: Haskell2010 + +common notForLib + default-language: GHC2021 + +test-suite tests + import: + ^ +|]