Skip to content

Commit 8c740dc

Browse files
VenInfVenInf
committed
requested changes
1 parent 109f04c commit 8c740dc

File tree

2 files changed

+98
-102
lines changed

2 files changed

+98
-102
lines changed

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

Lines changed: 92 additions & 89 deletions
Original file line numberDiff line numberDiff line change
@@ -8,56 +8,59 @@ module Ide.Plugin.Cabal (descriptor, Log (..)) where
88

99
import Control.Concurrent.Strict
1010
import Control.DeepSeq
11-
import Control.Lens ((^.))
11+
import Control.Lens ((^.))
1212
import Control.Monad.Extra
1313
import Control.Monad.IO.Class
1414
import Control.Monad.Trans.Class
15-
import Control.Monad.Trans.Maybe (runMaybeT)
16-
import qualified Data.ByteString as BS
15+
import Control.Monad.Trans.Maybe (runMaybeT)
16+
import qualified Data.ByteString as BS
1717
import Data.Hashable
18-
import Data.HashMap.Strict (HashMap)
19-
import qualified Data.HashMap.Strict as HashMap
20-
import Data.List (find)
21-
import qualified Data.List.NonEmpty as NE
22-
import qualified Data.Maybe as Maybe
23-
import qualified Data.Text as T
24-
import qualified Data.Text.Encoding as Encoding
18+
import Data.HashMap.Strict (HashMap)
19+
import qualified Data.HashMap.Strict as HashMap
20+
import Data.List (find)
21+
import qualified Data.List.NonEmpty as NE
22+
import qualified Data.Maybe as Maybe
23+
import qualified Data.Text as T
24+
import qualified Data.Text.Encoding as Encoding
2525
import Data.Typeable
26-
import Development.IDE as D
26+
import Debug.Trace
27+
import Development.IDE as D
2728
import Development.IDE.Core.PluginUtils
28-
import Development.IDE.Core.Shake (restartShakeSession)
29-
import qualified Development.IDE.Core.Shake as Shake
30-
import Development.IDE.Graph (Key, alwaysRerun)
31-
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
32-
import Development.IDE.Types.Shake (toKey)
33-
import qualified Distribution.Fields as Syntax
34-
import qualified Distribution.Parsec.Position as Syntax
29+
import Development.IDE.Core.Shake (restartShakeSession)
30+
import qualified Development.IDE.Core.Shake as Shake
31+
import Development.IDE.Graph (Key,
32+
alwaysRerun)
33+
import Development.IDE.LSP.HoverDefinition (foundHover)
34+
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
35+
import Development.IDE.Types.Shake (toKey)
36+
import qualified Distribution.Fields as Syntax
37+
import Distribution.Package (Dependency)
38+
import Distribution.PackageDescription (allBuildDepends,
39+
depPkgName,
40+
unPackageName)
41+
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
42+
import qualified Distribution.Parsec.Position as Syntax
3543
import GHC.Generics
36-
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
37-
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
38-
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
39-
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
40-
ParseCabalFields (..),
41-
ParseCabalFile (..))
42-
import qualified Ide.Plugin.Cabal.Completion.Types as Types
43-
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
44-
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
45-
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
46-
import Ide.Plugin.Cabal.Orphans ()
44+
import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
45+
import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
46+
import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
47+
import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections),
48+
ParseCabalFields (..),
49+
ParseCabalFile (..))
50+
import qualified Ide.Plugin.Cabal.Completion.Types as Types
51+
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
52+
import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
53+
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
54+
import Ide.Plugin.Cabal.Orphans ()
4755
import Ide.Plugin.Cabal.Outline
48-
import qualified Ide.Plugin.Cabal.Parse as Parse
56+
import qualified Ide.Plugin.Cabal.Parse as Parse
4957
import Ide.Plugin.Error
5058
import Ide.Types
51-
import qualified Language.LSP.Protocol.Lens as JL
52-
import qualified Language.LSP.Protocol.Message as LSP
59+
import qualified Language.LSP.Protocol.Lens as JL
60+
import qualified Language.LSP.Protocol.Message as LSP
5361
import Language.LSP.Protocol.Types
54-
import qualified Language.LSP.VFS as VFS
55-
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
56-
import Distribution.Package (Dependency())
57-
import Distribution.PackageDescription (depPkgName, unPackageName, allBuildDepends)
58-
import Development.IDE.LSP.HoverDefinition (foundHover)
62+
import qualified Language.LSP.VFS as VFS
5963
import Text.Regex.TDFA
60-
import Debug.Trace
6164

6265

6366
data Log
@@ -299,67 +302,67 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
299302
-- TODO: Support more definitions than sections.
300303
gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition
301304
gotoDefinition ideState _ msgParam = do
302-
nfp <- getNormalizedFilePathE uri
303-
cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp
304-
case CabalFields.findTextWord cursor cabalFields of
305-
Nothing ->
306-
pure $ InR $ InR Null
307-
Just cursorText -> do
308-
commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp
309-
case find (isSectionArgName cursorText) commonSections of
310-
Nothing ->
311-
pure $ InR $ InR Null
312-
Just commonSection -> do
313-
pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection
314-
where
315-
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
316-
uri = msgParam ^. JL.textDocument . JL.uri
317-
isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName
318-
isSectionArgName _ _ = False
319-
320-
-- | CodeActions for hover messages.
305+
nfp <- getNormalizedFilePathE uri
306+
cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp
307+
case CabalFields.findTextWord cursor cabalFields of
308+
Nothing ->
309+
pure $ InR $ InR Null
310+
Just cursorText -> do
311+
commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp
312+
case find (isSectionArgName cursorText) commonSections of
313+
Nothing ->
314+
pure $ InR $ InR Null
315+
Just commonSection -> do
316+
pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection
317+
where
318+
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
319+
uri = msgParam ^. JL.textDocument . JL.uri
320+
isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName
321+
isSectionArgName _ _ = False
322+
323+
-- | Handler for hover messages.
321324
--
322-
-- Provides a CodeAction for displaying message on hover.
325+
-- Provides a Handler for displaying message on hover.
323326
-- If found that the filtered hover message is a dependency,
324327
-- adds a Documentation link.
325328
hover :: PluginMethodHandler IdeState LSP.Method_TextDocumentHover
326329
hover ide _ msgParam = do
327-
nfp <- getNormalizedFilePathE uri
328-
(cabalFields, _) <- runActionE "cabal.cabal-hover" ide $ useWithStaleE ParseCabalFields nfp
329-
let mCursorText = CabalFields.findTextWord cursor cabalFields
330-
case mCursorText of
331-
Nothing ->
332-
pure $ InR Null
333-
Just cursorText -> do
334-
(gpd, _) <- runActionE "cabal.GPD" ide $ useWithStaleE ParseCabalFile nfp
335-
let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
336-
mText = filterVersion cursorText
337-
case mText of
338-
Nothing -> pure $ foundHover (Nothing, [cursorText])
339-
Just txt ->
340-
if txt `elem` depsNames
341-
then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt])
342-
else pure $ foundHover (Nothing, [txt])
330+
nfp <- getNormalizedFilePathE uri
331+
(cabalFields, _) <- runActionE "cabal.cabal-hover" ide $ useWithStaleE ParseCabalFields nfp
332+
let mCursorText = CabalFields.findTextWord cursor cabalFields
333+
case mCursorText of
334+
Nothing ->
335+
pure $ InR Null
336+
Just cursorText -> do
337+
(gpd, _) <- runActionE "cabal.GPD" ide $ useWithStaleE ParseCabalFile nfp
338+
let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
339+
mText = filterVersion cursorText
340+
case mText of
341+
Nothing -> pure $ InR Null
342+
Just txt ->
343+
if txt `elem` depsNames
344+
then pure $ foundHover (Nothing, [txt <> "\n", documentationText txt])
345+
else pure $ InR Null
343346
where
344-
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
345-
uri = msgParam ^. JL.textDocument . JL.uri
347+
cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
348+
uri = msgParam ^. JL.textDocument . JL.uri
346349

347-
dependencyName :: Dependency -> T.Text
348-
dependencyName dep = T.pack $ unPackageName $ depPkgName dep
350+
dependencyName :: Dependency -> T.Text
351+
dependencyName dep = T.pack $ unPackageName $ depPkgName dep
349352

350-
filterVersion :: T.Text -> Maybe T.Text
351-
filterVersion msg = getMatch (msg =~ regex)
352-
where
353-
regex :: T.Text
354-
regex = "([a-zA-Z0-9-]*[a-zA-Z0-9]).*"
353+
filterVersion :: T.Text -> Maybe T.Text
354+
filterVersion msg = getMatch (msg =~ regex)
355+
where
356+
regex :: T.Text
357+
regex = "([a-zA-Z0-9-]*[a-zA-Z0-9])"
355358

356-
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text
357-
getMatch (_, _, _, []) = Nothing
358-
getMatch (_, _, _, [dependency]) = Just dependency
359-
getMatch (_, _, _, _) = Nothing -- impossible case
359+
getMatch :: (T.Text, T.Text, T.Text, [T.Text]) -> Maybe T.Text
360+
getMatch (_, _, _, []) = Nothing
361+
getMatch (_, _, _, [dependency]) = Just dependency
362+
getMatch (_, _, _, _) = Nothing -- impossible case
360363

361-
documentationText :: T.Text -> T.Text
362-
documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")"
364+
documentationText :: T.Text -> T.Text
365+
documentationText package = "[Documentation](https://hackage.haskell.org/package/" <> package <> ")"
363366

364367
-- ----------------------------------------------------------------
365368
-- Cabal file of Interest rules and global variable

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

Lines changed: 6 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -299,9 +299,9 @@ hoverOnDependencyTests = testGroup "Hover Dependency"
299299
, hoverContainsTest "aeson with not separated version " "hover-deps.cabal" (Position 7 25) "[Documentation](https://hackage.haskell.org/package/aeson)"
300300
, hoverContainsTest "lens no version" "hover-deps.cabal" (Position 7 42) "[Documentation](https://hackage.haskell.org/package/lens)"
301301

302-
, hoverNotContainsTest "name has no documentation" "hover-deps.cabal" (Position 1 25) "[Documentation]"
303-
, hoverNotContainsTest "exposed-modules has no documentation" "hover-deps.cabal" (Position 5 25) "[Documentation]"
304-
, hoverNotContainsTest "hs-source-dirs has no documentation" "hover-deps.cabal" (Position 8 25) "[Documentation]"
302+
, hoverIsNullTest "name has no documentation" "hover-deps.cabal" (Position 1 25)
303+
, hoverIsNullTest "exposed-modules has no documentation" "hover-deps.cabal" (Position 5 25)
304+
, hoverIsNullTest "hs-source-dirs has no documentation" "hover-deps.cabal" (Position 8 25)
305305
]
306306
where
307307
hoverContainsTest :: TestName -> FilePath -> Position -> T.Text -> TestTree
@@ -319,17 +319,10 @@ hoverOnDependencyTests = testGroup "Hover Dependency"
319319
_ -> liftIO $ assertFailure "Unexpected content type"
320320
closeDoc doc
321321

322-
hoverNotContainsTest :: TestName -> FilePath -> Position -> T.Text -> TestTree
323-
hoverNotContainsTest testName cabalFile pos containedText =
322+
hoverIsNullTest :: TestName -> FilePath -> Position -> TestTree
323+
hoverIsNullTest testName cabalFile pos =
324324
runCabalTestCaseSession testName "hover" $ do
325325
doc <- openDoc cabalFile "cabal"
326326
h <- getHover doc pos
327-
case h of
328-
Nothing -> liftIO $ assertFailure "No hover"
329-
Just (Hover contents _) -> case contents of
330-
InL (MarkupContent _ txt) -> do
331-
liftIO
332-
$ assertBool ("Found `" <> T.unpack containedText <> "` in hover message: " <> T.unpack txt)
333-
$ not (containedText `T.isInfixOf` txt)
334-
_ -> liftIO $ assertFailure "Unexpected content type"
327+
liftIO $ assertBool ("Found hover `" <> show h <> "`") $ Maybe.isNothing h
335328
closeDoc doc

0 commit comments

Comments
 (0)