Add completion for import fields in cabal files (#4305)

At the moment import fields always suggest any common stanza names
occuring in the file, while it should be only the ones defined before
the cursor position.

Also moves all CabalFields utility into a separate module

Co-authored-by: Michael Peyton Jones <me@michaelpj.com>

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

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

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
+

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,

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
   }

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

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),

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,

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:
+          ^
+|]