Skip to content

Commit 7f8a0f6

Browse files
VeryMilkyJoeVeryMilkyJoe
committed
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
1 parent e9c2f55 commit 7f8a0f6

File tree

8 files changed

+187
-68
lines changed

8 files changed

+187
-68
lines changed

‎haskell-language-server.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -231,6 +231,7 @@ library hls-cabal-plugin
231231
exposed-modules:
232232
Ide.Plugin.Cabal
233233
Ide.Plugin.Cabal.Diagnostics
234+
Ide.Plugin.Cabal.Completion.CabalFields
234235
Ide.Plugin.Cabal.Completion.Completer.FilePath
235236
Ide.Plugin.Cabal.Completion.Completer.Module
236237
Ide.Plugin.Cabal.Completion.Completer.Paths

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

+3
Original file line numberDiff line numberDiff line change
@@ -337,6 +337,9 @@ completion recorder ide _ complParams = do
337337
{ getLatestGPD = do
338338
mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp
339339
pure $ fmap fst mGPD
340+
, getCabalFields = do
341+
mFields <- runIdeAction "cabal-plugin.modulesCompleter.fields" (shakeExtras ide) $ useWithStaleFast ParseCabalFields $ toNormalizedFilePath fp
342+
pure $ fmap fst mFields
340343
, cabalPrefixInfo = prefInfo
341344
, stanzaName =
342345
case fst ctx of

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/CabalFields.hs

+68
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
module Ide.Plugin.Cabal.Completion.CabalFields (findStanzaForColumn, findFieldSection, getOptionalSectionName, getAnnotation, getFieldName) where
2+
3+
import Data.List.NonEmpty (NonEmpty)
4+
import qualified Data.List.NonEmpty as NE
5+
import qualified Data.Text as T
6+
import qualified Data.Text.Encoding as T
7+
import qualified Distribution.Fields as Syntax
8+
import qualified Distribution.Parsec.Position as Syntax
9+
import Ide.Plugin.Cabal.Completion.Types
10+
11+
-- ----------------------------------------------------------------
12+
-- Cabal-syntax utilities I don't really want to write myself
13+
-- ----------------------------------------------------------------
14+
15+
-- | Determine the context of a cursor position within a stack of stanza contexts
16+
--
17+
-- If the cursor is indented more than one of the stanzas in the stack
18+
-- the respective stanza is returned if this is never the case, the toplevel stanza
19+
-- in the stack is returned.
20+
findStanzaForColumn :: Int -> NonEmpty (Int, StanzaContext) -> (StanzaContext, FieldContext)
21+
findStanzaForColumn col ctx = case NE.uncons ctx of
22+
((_, stanza), Nothing) -> (stanza, None)
23+
((indentation, stanza), Just res)
24+
| col < indentation -> findStanzaForColumn col res
25+
| otherwise -> (stanza, None)
26+
27+
-- | Determine the field the cursor is currently a part of.
28+
--
29+
-- The result is said field and its starting position
30+
-- or Nothing if the passed list of fields is empty.
31+
32+
-- This only looks at the row of the cursor and not at the cursor's
33+
-- position within the row.
34+
--
35+
-- TODO: we do not handle braces correctly. Add more tests!
36+
findFieldSection :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.Field Syntax.Position)
37+
findFieldSection _cursor [] = Nothing
38+
findFieldSection _cursor [x] =
39+
-- Last field. We decide later, whether we are starting
40+
-- a new section.
41+
Just x
42+
findFieldSection cursor (x:y:ys)
43+
| Syntax.positionRow (getAnnotation x) <= cursorLine && cursorLine < Syntax.positionRow (getAnnotation y)
44+
= Just x
45+
| otherwise = findFieldSection cursor (y:ys)
46+
where
47+
cursorLine = Syntax.positionRow cursor
48+
49+
type FieldName = T.Text
50+
51+
getAnnotation :: Syntax.Field ann -> ann
52+
getAnnotation (Syntax.Field (Syntax.Name ann _) _) = ann
53+
getAnnotation (Syntax.Section (Syntax.Name ann _) _ _) = ann
54+
55+
getFieldName :: Syntax.Field ann -> FieldName
56+
getFieldName (Syntax.Field (Syntax.Name _ fn) _) = T.decodeUtf8 fn
57+
getFieldName (Syntax.Section (Syntax.Name _ fn) _ _) = T.decodeUtf8 fn
58+
59+
-- | Returns the name of a section if it has a name.
60+
--
61+
-- This assumes that the given section args belong to named stanza
62+
-- in which case the stanza name is returned.
63+
getOptionalSectionName :: [Syntax.SectionArg ann] -> Maybe T.Text
64+
getOptionalSectionName [] = Nothing
65+
getOptionalSectionName (x:xs) = case x of
66+
Syntax.SecArgName _ name -> Just (T.decodeUtf8 name)
67+
_ -> getOptionalSectionName xs
68+

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Simple.hs

+21-1
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE LambdaCase #-}
12
{-# LANGUAGE OverloadedStrings #-}
23

34
module Ide.Plugin.Cabal.Completion.Completer.Simple where
@@ -7,11 +8,14 @@ import Data.Function ((&))
78
import qualified Data.List as List
89
import Data.Map (Map)
910
import qualified Data.Map as Map
10-
import Data.Maybe (fromMaybe)
11+
import Data.Maybe (fromMaybe,
12+
mapMaybe)
1113
import Data.Ord (Down (Down))
1214
import qualified Data.Text as T
15+
import qualified Distribution.Fields as Syntax
1316
import Ide.Logger (Priority (..),
1417
logWith)
18+
import Ide.Plugin.Cabal.Completion.CabalFields
1519
import Ide.Plugin.Cabal.Completion.Completer.Types
1620
import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..),
1721
Log)
@@ -41,6 +45,22 @@ constantCompleter completions _ cData = do
4145
range = completionRange prefInfo
4246
pure $ map (mkSimpleCompletionItem range . Fuzzy.original) scored
4347

48+
-- | Completer to be used for import fields.
49+
--
50+
-- TODO: Does not exclude imports, defined after the current cursor position
51+
-- which are not allowed according to the cabal specification
52+
importCompleter :: Completer
53+
importCompleter l cData = do
54+
cabalFieldsM <- getCabalFields cData
55+
case cabalFieldsM of
56+
Just cabalFields -> do
57+
let commonNames = mapMaybe (\case
58+
Syntax.Section (Syntax.Name _ "common") commonNames _ -> getOptionalSectionName commonNames
59+
_ -> Nothing)
60+
cabalFields
61+
constantCompleter commonNames l cData
62+
Nothing -> noopCompleter l cData
63+
4464
-- | Completer to be used for the field @name:@ value.
4565
--
4666
-- This is almost always the name of the cabal file. However,

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completer/Types.hs

+4
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,9 @@
33
module Ide.Plugin.Cabal.Completion.Completer.Types where
44

55
import Development.IDE as D
6+
import qualified Distribution.Fields as Syntax
67
import Distribution.PackageDescription (GenericPackageDescription)
8+
import qualified Distribution.Parsec.Position as Syntax
79
import Ide.Plugin.Cabal.Completion.Types
810
import Language.LSP.Protocol.Types (CompletionItem)
911

@@ -17,6 +19,8 @@ data CompleterData = CompleterData
1719
-- relevant for some completion actions which require the file's meta information
1820
-- such as the module completers which require access to source directories
1921
getLatestGPD :: IO (Maybe GenericPackageDescription),
22+
-- | Access to the entries of the handled cabal file as parsed by ParseCabalFields
23+
getCabalFields :: IO (Maybe [Syntax.Field Syntax.Position]),
2024
-- | Prefix info to be used for constructing completion items
2125
cabalPrefixInfo :: CabalPrefixInfo,
2226
-- | The name of the stanza in which the completer is applied

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Completions.hs

+1-55
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,11 @@ import Data.List.NonEmpty (NonEmpty)
88
import qualified Data.List.NonEmpty as NE
99
import qualified Data.Map as Map
1010
import qualified Data.Text as T
11-
import qualified Data.Text.Encoding as T
1211
import Development.IDE as D
1312
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
1413
import qualified Distribution.Fields as Syntax
1514
import qualified Distribution.Parsec.Position as Syntax
15+
import Ide.Plugin.Cabal.Completion.CabalFields
1616
import Ide.Plugin.Cabal.Completion.Completer.Simple
1717
import Ide.Plugin.Cabal.Completion.Completer.Snippet
1818
import Ide.Plugin.Cabal.Completion.Completer.Types (Completer)
@@ -177,57 +177,3 @@ classifyFieldContext ctx cursor field
177177

178178
cursorColumn = Syntax.positionCol cursor
179179
fieldColumn = Syntax.positionCol (getAnnotation field)
180-
181-
-- ----------------------------------------------------------------
182-
-- Cabal-syntax utilities I don't really want to write myself
183-
-- ----------------------------------------------------------------
184-
185-
-- | Determine the context of a cursor position within a stack of stanza contexts
186-
--
187-
-- If the cursor is indented more than one of the stanzas in the stack
188-
-- the respective stanza is returned if this is never the case, the toplevel stanza
189-
-- in the stack is returned.
190-
findStanzaForColumn :: Int -> NonEmpty (Int, StanzaContext) -> (StanzaContext, FieldContext)
191-
findStanzaForColumn col ctx = case NE.uncons ctx of
192-
((_, stanza), Nothing) -> (stanza, None)
193-
((indentation, stanza), Just res)
194-
| col < indentation -> findStanzaForColumn col res
195-
| otherwise -> (stanza, None)
196-
197-
-- | Determine the field the cursor is currently a part of.
198-
--
199-
-- The result is said field and its starting position
200-
-- or Nothing if the passed list of fields is empty.
201-
202-
-- This only looks at the row of the cursor and not at the cursor's
203-
-- position within the row.
204-
--
205-
-- TODO: we do not handle braces correctly. Add more tests!
206-
findFieldSection :: Syntax.Position -> [Syntax.Field Syntax.Position] -> Maybe (Syntax.Field Syntax.Position)
207-
findFieldSection _cursor [] = Nothing
208-
findFieldSection _cursor [x] =
209-
-- Last field. We decide later, whether we are starting
210-
-- a new section.
211-
Just x
212-
findFieldSection cursor (x:y:ys)
213-
| Syntax.positionRow (getAnnotation x) <= cursorLine && cursorLine < Syntax.positionRow (getAnnotation y)
214-
= Just x
215-
| otherwise = findFieldSection cursor (y:ys)
216-
where
217-
cursorLine = Syntax.positionRow cursor
218-
219-
type FieldName = T.Text
220-
221-
getAnnotation :: Syntax.Field ann -> ann
222-
getAnnotation (Syntax.Field (Syntax.Name ann _) _) = ann
223-
getAnnotation (Syntax.Section (Syntax.Name ann _) _ _) = ann
224-
225-
getFieldName :: Syntax.Field ann -> FieldName
226-
getFieldName (Syntax.Field (Syntax.Name _ fn) _) = T.decodeUtf8 fn
227-
getFieldName (Syntax.Section (Syntax.Name _ fn) _ _) = T.decodeUtf8 fn
228-
229-
getOptionalSectionName :: [Syntax.SectionArg ann] -> Maybe T.Text
230-
getOptionalSectionName [] = Nothing
231-
getOptionalSectionName (x:xs) = case x of
232-
Syntax.SecArgName _ name -> Just (T.decodeUtf8 name)
233-
_ -> getOptionalSectionName xs

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Data.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -162,7 +162,8 @@ flagFields =
162162
libExecTestBenchCommons :: Map KeyWordName Completer
163163
libExecTestBenchCommons =
164164
Map.fromList
165-
[ ("build-depends:", noopCompleter),
165+
[ ("import:", importCompleter),
166+
("build-depends:", noopCompleter),
166167
("hs-source-dirs:", directoryCompleter),
167168
("default-extensions:", noopCompleter),
168169
("other-extensions:", noopCompleter),

‎plugins/hls-cabal-plugin/test/Completer.hs

+87-11
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
{-# LANGUAGE DisambiguateRecordFields #-}
22
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE QuasiQuotes #-}
4+
35

46
module Completer where
57

@@ -8,16 +10,19 @@ import Control.Lens.Prism
810
import qualified Data.ByteString as ByteString
911
import Data.Maybe (mapMaybe)
1012
import qualified Data.Text as T
13+
import qualified Data.Text.Encoding as Text
1114
import qualified Development.IDE.Plugin.Completions.Types as Ghcide
1215
import Distribution.PackageDescription (GenericPackageDescription)
1316
import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe)
1417
import Ide.Plugin.Cabal.Completion.Completer.FilePath
1518
import Ide.Plugin.Cabal.Completion.Completer.Module
1619
import Ide.Plugin.Cabal.Completion.Completer.Paths
20+
import Ide.Plugin.Cabal.Completion.Completer.Simple (importCompleter)
1721
import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..))
1822
import Ide.Plugin.Cabal.Completion.Completions
1923
import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..),
2024
StanzaName)
25+
import qualified Ide.Plugin.Cabal.Parse as Parse
2126
import qualified Language.LSP.Protocol.Lens as L
2227
import System.FilePath
2328
import Test.Hls
@@ -33,7 +38,8 @@ completerTests =
3338
directoryCompleterTests,
3439
completionHelperTests,
3540
filePathExposedModulesTests,
36-
exposedModuleCompleterTests
41+
exposedModuleCompleterTests,
42+
importCompleterTests
3743
]
3844

3945
basicCompleterTests :: TestTree
@@ -290,23 +296,55 @@ exposedModuleCompleterTests =
290296
completions @?== []
291297
]
292298
where
293-
simpleCompleterData :: Maybe StanzaName -> FilePath -> T.Text -> CompleterData
294-
simpleCompleterData sName dir pref = do
295-
CompleterData
296-
{ cabalPrefixInfo = simpleExposedCabalPrefixInfo pref dir,
297-
getLatestGPD = do
298-
cabalContents <- ByteString.readFile $ testDataDir </> "exposed.cabal"
299-
pure $ parseGenericPackageDescriptionMaybe cabalContents,
300-
stanzaName = sName
301-
}
302299
callModulesCompleter :: Maybe StanzaName -> (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> T.Text -> IO [T.Text]
303300
callModulesCompleter sName func prefix = do
304301
let cData = simpleCompleterData sName testDataDir prefix
305302
completer <- modulesCompleter func mempty cData
306303
pure $ fmap extract completer
307304

305+
-- TODO: These tests are a bit barebones at the moment,
306+
-- since we do not take cursorposition into account at this point.
307+
importCompleterTests :: TestTree
308+
importCompleterTests =
309+
testGroup
310+
"Import Completer Tests"
311+
[ testCase "All above common sections are suggested" $ do
312+
completions <- callImportCompleter importTestData
313+
("defaults" `elem` completions) @? "defaults contained"
314+
("test-defaults" `elem` completions) @? "test-defaults contained"
315+
-- TODO: Only common sections defined before the current stanza may be imported
316+
, testCase "Common sections occuring below are not suggested" $ do
317+
completions <- callImportCompleter importTestData
318+
("notForLib" `elem` completions) @? "notForLib contained, this needs to be fixed"
319+
, testCase "All common sections are suggested when curser is below them" $ do
320+
completions <- callImportCompleter importTestData
321+
completions @?== ["defaults", "notForLib" ,"test-defaults"]
322+
]
323+
where
324+
callImportCompleter :: T.Text -> IO [T.Text]
325+
callImportCompleter filecontent = do
326+
let cData' = simpleCompleterData Nothing testDataDir ""
327+
let cabalFields = Parse.readCabalFields "not-real" (Text.encodeUtf8 filecontent)
328+
case cabalFields of
329+
Left err -> fail $ show err
330+
Right fields -> do
331+
let cData = cData' {getCabalFields = pure $ Just fields}
332+
completer <- importCompleter mempty cData
333+
pure $ fmap extract completer
334+
335+
simpleCompleterData :: Maybe StanzaName -> FilePath -> T.Text -> CompleterData
336+
simpleCompleterData sName dir pref = do
337+
CompleterData
338+
{ cabalPrefixInfo = simpleExposedCabalPrefixInfo pref dir,
339+
getLatestGPD = do
340+
cabalContents <- ByteString.readFile $ testDataDir </> "exposed.cabal"
341+
pure $ parseGenericPackageDescriptionMaybe cabalContents,
342+
getCabalFields = undefined,
343+
stanzaName = sName
344+
}
345+
308346
mkCompleterData :: CabalPrefixInfo -> CompleterData
309-
mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing}
347+
mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, getCabalFields = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing}
310348

311349
exposedTestDir :: FilePath
312350
exposedTestDir = addTrailingPathSeparator $ testDataDir </> "src-modules"
@@ -326,3 +364,41 @@ extract :: CompletionItem -> T.Text
326364
extract item = case item ^. L.textEdit of
327365
Just (InL v) -> v ^. L.newText
328366
_ -> error ""
367+
368+
importTestData :: T.Text
369+
importTestData = [trimming|
370+
cabal-version: 3.0
371+
name: hls-cabal-plugin
372+
version: 0.1.0.0
373+
synopsis:
374+
homepage:
375+
license: MIT
376+
license-file: LICENSE
377+
author: Fendor
378+
maintainer: [email protected]
379+
category: Development
380+
extra-source-files: CHANGELOG.md
381+
382+
common defaults
383+
default-language: GHC2021
384+
-- Should have been in GHC2021, an oversight
385+
default-extensions: ExplicitNamespaces
386+
387+
common test-defaults
388+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
389+
390+
library
391+
import:
392+
^
393+
exposed-modules: IDE.Plugin.Cabal
394+
build-depends: base ^>=4.14.3.0
395+
hs-source-dirs: src
396+
default-language: Haskell2010
397+
398+
common notForLib
399+
default-language: GHC2021
400+
401+
test-suite tests
402+
import:
403+
^
404+
|]

0 commit comments

Comments
 (0)