Add completion for import fields in cabal files

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

Author: VeryMilkyJoe

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

@@ -337,6 +337,9 @@ completion recorder ide _ complParams = do
               { getLatestGPD = do
                 mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp
                 pure $ fmap fst mGPD
+              , getCabalFields = do
+                mFields <- runIdeAction "cabal-plugin.modulesCompleter.fields" (shakeExtras ide) $ useWithStaleFast ParseCabalFields $ toNormalizedFilePath fp
+                pure $ fmap fst mFields
               , 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
+  cabalFieldsM <- getCabalFields cData
+  case cabalFieldsM of
+    Just cabalFields -> do
+        let commonNames = mapMaybe (\case
+              Syntax.Section (Syntax.Name _ "common") commonNames _ -> getOptionalSectionName commonNames
+              _ -> Nothing)
+              cabalFields
+        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)
 
@@ -17,6 +19,8 @@ data CompleterData = CompleterData
     -- 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),
+    -- | Access to the entries of the handled cabal file as parsed by ParseCabalFields
+    getCabalFields  :: IO (Maybe [Syntax.Field Syntax.Position]),
     -- | Prefix info to be used for constructing completion items
     cabalPrefixInfo :: CabalPrefixInfo,
     -- | The name of the stanza in which the completer is applied

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/test/Completer.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE DisambiguateRecordFields #-}
 {-# LANGUAGE OverloadedStrings        #-}
+{-# LANGUAGE QuasiQuotes              #-}
+
 
 module Completer where
 
@@ -8,16 +10,19 @@ import           Control.Lens.Prism
 import qualified Data.ByteString                                as ByteString
 import           Data.Maybe                                     (mapMaybe)
 import qualified Data.Text                                      as T
+import qualified Data.Text.Encoding                             as Text
 import qualified Development.IDE.Plugin.Completions.Types       as Ghcide
 import           Distribution.PackageDescription                (GenericPackageDescription)
 import           Distribution.PackageDescription.Parsec         (parseGenericPackageDescriptionMaybe)
 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 (..),
                                                                  StanzaName)
+import qualified Ide.Plugin.Cabal.Parse                         as Parse
 import qualified Language.LSP.Protocol.Lens                     as L
 import           System.FilePath
 import           Test.Hls
@@ -33,7 +38,8 @@ completerTests =
       directoryCompleterTests,
       completionHelperTests,
       filePathExposedModulesTests,
-      exposedModuleCompleterTests
+      exposedModuleCompleterTests,
+      importCompleterTests
     ]
 
 basicCompleterTests :: TestTree
@@ -290,23 +296,55 @@ 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 importTestData
+      ("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 importTestData
+      ("notForLib" `elem` completions) @? "notForLib contained, this needs to be fixed"
+    , testCase "All common sections are suggested when curser is below them" $ do
+      completions <- callImportCompleter importTestData
+      completions @?== ["defaults", "notForLib" ,"test-defaults"]
+    ]
+    where
+      callImportCompleter :: T.Text -> IO [T.Text]
+      callImportCompleter filecontent = do
+        let cData' = simpleCompleterData Nothing testDataDir ""
+        let cabalFields = Parse.readCabalFields "not-real" (Text.encodeUtf8 filecontent)
+        case cabalFields of
+          Left err -> fail $ show err
+          Right fields -> do
+            let cData = cData' {getCabalFields = pure $ Just fields}
+            completer <- importCompleter mempty cData
+            pure $ fmap extract completer
+
+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,
+      getCabalFields = undefined,
+      stanzaName = sName
+    }
+
 mkCompleterData :: CabalPrefixInfo -> CompleterData
-mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing}
+mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, getCabalFields = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing}
 
 exposedTestDir :: FilePath
 exposedTestDir = addTrailingPathSeparator $ testDataDir </> "src-modules"
@@ -326,3 +364,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:         [email protected]
+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:
+          ^
+|]