@@ -8,50 +8,62 @@ module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) whe
88
99import Control.Concurrent.Strict
1010import Control.DeepSeq
11- import Control.Lens ((^.) )
11+ import Control.Lens ((^.) )
1212import Control.Monad.Extra
1313import Control.Monad.IO.Class
1414import 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
1717import Data.Hashable
18- import Data.HashMap.Strict (HashMap )
19- import qualified Data.HashMap.Strict as HashMap
20- import qualified Data.List.NonEmpty as NE
21- import qualified Data.Maybe as Maybe
22- import qualified Data.Text as T
23- import qualified Data.Text.Encoding as Encoding
18+ import Data.HashMap.Strict (HashMap )
19+ import qualified Data.HashMap.Strict as HashMap
20+ import qualified Data.List.NonEmpty as NE
21+ import qualified Data.Maybe as Maybe
22+ import qualified Data.Text as T
23+ import qualified Data.Text.Encoding as Encoding
2424import Data.Typeable
25- import Development.IDE as D
26- import Development.IDE.Core.Shake (restartShakeSession )
27- import qualified Development.IDE.Core.Shake as Shake
28- import Development.IDE.Graph (Key , alwaysRerun )
29- import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
30- import Development.IDE.Types.Shake (toKey )
31- import qualified Distribution.Fields as Syntax
32- import qualified Distribution.Parsec.Position as Syntax
25+ import Development.IDE as D
26+ import Development.IDE.Core.PluginUtils
27+ import Development.IDE.Core.Shake (restartShakeSession )
28+ import qualified Development.IDE.Core.Shake as Shake
29+ import Development.IDE.Graph (Key ,
30+ alwaysRerun )
31+ import Development.IDE.LSP.HoverDefinition (foundHover )
32+ import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
33+ import Development.IDE.Types.Shake (toKey )
34+ import qualified Distribution.Fields as Syntax
35+ import Distribution.Package (Dependency )
36+ import Distribution.PackageDescription (allBuildDepends ,
37+ depPkgName ,
38+ unPackageName )
39+ import Distribution.PackageDescription.Configuration (flattenPackageDescription )
40+ import qualified Distribution.Parsec.Position as Syntax
3341import GHC.Generics
34- import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
35- import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
36- import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections ),
37- ParseCabalFields (.. ),
38- ParseCabalFile (.. ))
39- import qualified Ide.Plugin.Cabal.Completion.Types as Types
40- import Ide.Plugin.Cabal.Definition (gotoDefinition )
41- import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
42- import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
43- import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
44- import Ide.Plugin.Cabal.Orphans ()
42+ import Ide.Plugin.Cabal.Completion.CabalFields as CabalFields
43+ import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
44+ import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
45+ import Ide.Plugin.Cabal.Completion.Types (ParseCabalCommonSections (ParseCabalCommonSections ),
46+ ParseCabalFields (.. ),
47+ ParseCabalFile (.. ))
48+ import qualified Ide.Plugin.Cabal.Completion.Types as Types
49+ import Ide.Plugin.Cabal.Definition (gotoDefinition )
50+ import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
51+ import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
52+ import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
53+ import Ide.Plugin.Cabal.Orphans ()
4554import Ide.Plugin.Cabal.Outline
46- import qualified Ide.Plugin.Cabal.Parse as Parse
55+ import qualified Ide.Plugin.Cabal.Parse as Parse
56+ import Ide.Plugin.Error
4757import Ide.Types
48- import qualified Language.LSP.Protocol.Lens as JL
49- import qualified Language.LSP.Protocol.Message as LSP
58+ import qualified Language.LSP.Protocol.Lens as JL
59+ import qualified Language.LSP.Protocol.Message as LSP
5060import Language.LSP.Protocol.Types
51- import qualified Language.LSP.VFS as VFS
61+ import qualified Language.LSP.VFS as VFS
62+ import Text.Regex.TDFA
5263
53- import qualified Data.Text ()
54- import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd
64+
65+ import qualified Data.Text ()
66+ import qualified Ide.Plugin.Cabal.CabalAdd as CabalAdd
5567
5668data Log
5769 = LogModificationTime NormalizedFilePath FileVersion
@@ -118,6 +130,7 @@ descriptor recorder plId =
118130 , mkPluginHandler LSP. SMethod_TextDocumentDocumentSymbol moduleOutline
119131 , mkPluginHandler LSP. SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
120132 , mkPluginHandler LSP. SMethod_TextDocumentDefinition gotoDefinition
133+ , mkPluginHandler LSP. SMethod_TextDocumentHover hover
121134 ]
122135 , pluginNotificationHandlers =
123136 mconcat
@@ -302,7 +315,6 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
302315 let completionTexts = fmap (^. JL. label) completions
303316 pure $ FieldSuggest. fieldErrorAction uri fieldName completionTexts _range
304317
305-
306318cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
307319cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext {_diagnostics= diags}) = do
308320 maxCompls <- fmap maxCompletions . liftIO $ runAction " cabal.cabal-add" state getClientConfigAction
@@ -328,6 +340,55 @@ cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri)
328340 gpd
329341 pure $ InL $ fmap InR actions
330342
343+ -- | Handler for hover messages.
344+ --
345+ -- Provides a Handler for displaying message on hover.
346+ -- If found that the filtered hover message is a dependency,
347+ -- adds a Documentation link.
348+ hover :: PluginMethodHandler IdeState LSP. Method_TextDocumentHover
349+ hover ide _ msgParam = do
350+ nfp <- getNormalizedFilePathE uri
351+ cabalFields <- runActionE " cabal.cabal-hover" ide $ useE ParseCabalFields nfp
352+ case CabalFields. findTextWord cursor cabalFields of
353+ Nothing ->
354+ pure $ InR Null
355+ Just cursorText -> do
356+ gpd <- runActionE " cabal.GPD" ide $ useE ParseCabalFile nfp
357+ let depsNames = map dependencyName $ allBuildDepends $ flattenPackageDescription gpd
358+ case filterVersion cursorText of
359+ Nothing -> pure $ InR Null
360+ Just txt ->
361+ if txt `elem` depsNames
362+ then pure $ foundHover (Nothing , [txt <> " \n " , documentationText txt])
363+ else pure $ InR Null
364+ where
365+ cursor = Types. lspPositionToCabalPosition (msgParam ^. JL. position)
366+ uri = msgParam ^. JL. textDocument . JL. uri
367+
368+ dependencyName :: Dependency -> T. Text
369+ dependencyName dep = T. pack $ unPackageName $ depPkgName dep
370+
371+ -- | Removes version requirements like
372+ -- `==1.0.0.0`, `>= 2.1.1` that could be included in
373+ -- hover message. Assumes that the dependency consists
374+ -- of alphanums with dashes in between. Ends with an alphanum.
375+ --
376+ -- Examples:
377+ -- >>> filterVersion "imp-deps>=2.1.1"
378+ -- "imp-deps"
379+ filterVersion :: T. Text -> Maybe T. Text
380+ filterVersion msg = getMatch (msg =~ regex)
381+ where
382+ regex :: T. Text
383+ regex = " ([a-zA-Z0-9-]*[a-zA-Z0-9])"
384+
385+ getMatch :: (T. Text , T. Text , T. Text , [T. Text ]) -> Maybe T. Text
386+ getMatch (_, _, _, [dependency]) = Just dependency
387+ getMatch (_, _, _, _) = Nothing -- impossible case
388+
389+ documentationText :: T. Text -> T. Text
390+ documentationText package = " [Documentation](https://hackage.haskell.org/package/" <> package <> " )"
391+
331392
332393-- ----------------------------------------------------------------
333394-- Cabal file of Interest rules and global variable
0 commit comments