Skip to content

Commit e677c9b

Browse files
rm41339rm41339
committed
Initial cabal-project plugin setup
1 parent d9aaa01 commit e677c9b

File tree

6 files changed

+318
-1
lines changed

6 files changed

+318
-1
lines changed

‎haskell-language-server.cabal

Lines changed: 72 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -317,6 +317,77 @@ test-suite hls-cabal-plugin-tests
317317
, text
318318
, hls-plugin-api
319319

320+
-----------------------------
321+
-- cabal project plugin
322+
-----------------------------
323+
324+
flag cabalProject
325+
description: Enable cabalProject plugin
326+
default: True
327+
manual: True
328+
329+
common cabalProject
330+
if flag(cabalProject)
331+
build-depends: haskell-language-server:hls-cabal-project-plugin
332+
cpp-options: -Dhls_cabal_project
333+
334+
library hls-cabal-project-plugin
335+
import: defaults, pedantic, warnings
336+
if !flag(cabal)
337+
buildable: False
338+
exposed-modules:
339+
Ide.Plugin.CabalProject
340+
341+
342+
build-depends:
343+
, bytestring
344+
, Cabal-syntax >= 3.7
345+
, containers
346+
, deepseq
347+
, directory
348+
, filepath
349+
, extra >=1.7.4
350+
, ghcide == 2.9.0.1
351+
, hashable
352+
, hls-plugin-api == 2.9.0.1
353+
, hls-graph == 2.9.0.1
354+
, lens
355+
, lsp ^>=2.7
356+
, lsp-types ^>=2.3
357+
, regex-tdfa ^>=1.3.1
358+
, text
359+
, text-rope
360+
, transformers
361+
, unordered-containers >=0.2.10.0
362+
, containers
363+
, process
364+
, aeson
365+
, Cabal
366+
, pretty
367+
368+
hs-source-dirs: plugins/hls-cabal-project-plugin/src
369+
370+
test-suite hls-cabal-project-plugin-tests
371+
import: defaults, pedantic, test-defaults, warnings
372+
if !flag(cabalProject)
373+
buildable: False
374+
type: exitcode-stdio-1.0
375+
hs-source-dirs: plugins/hls-cabal-project-plugin/test
376+
main-is: Main.hs
377+
other-modules:
378+
build-depends:
379+
, bytestring
380+
, Cabal-syntax >= 3.7
381+
, extra
382+
, filepath
383+
, ghcide
384+
, haskell-language-server:hls-cabal-project-plugin
385+
, hls-test-utils == 2.9.0.1
386+
, lens
387+
, lsp-types
388+
, text
389+
, hls-plugin-api
390+
320391
-----------------------------
321392
-- class plugin
322393
-----------------------------
@@ -1830,6 +1901,7 @@ library
18301901
, pedantic
18311902
-- plugins
18321903
, cabal
1904+
, cabalProject
18331905
, callHierarchy
18341906
, cabalfmt
18351907
, cabalgild

‎hls-plugin-api/src/Ide/Types.hs

Lines changed: 16 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@
1414
{-# LANGUAGE UndecidableInstances #-}
1515
{-# LANGUAGE ViewPatterns #-}
1616
module Ide.Types
17-
( PluginDescriptor(..), defaultPluginDescriptor, defaultCabalPluginDescriptor
17+
( PluginDescriptor(..), defaultPluginDescriptor, defaultCabalPluginDescriptor, defaultCabalProjectPluginDescriptor
1818
, defaultPluginPriority
1919
, describePlugin
2020
, IdeCommand(..)
@@ -1077,6 +1077,21 @@ defaultCabalPluginDescriptor plId desc =
10771077
Nothing
10781078
[".cabal"]
10791079

1080+
defaultCabalProjectPluginDescriptor :: PluginId -> T.Text -> PluginDescriptor ideState
1081+
defaultCabalProjectPluginDescriptor plId desc =
1082+
PluginDescriptor
1083+
plId
1084+
desc
1085+
defaultPluginPriority
1086+
mempty
1087+
mempty
1088+
mempty
1089+
defaultConfigDescriptor
1090+
mempty
1091+
mempty
1092+
Nothing
1093+
[".project"]
1094+
10801095
newtype CommandId = CommandId T.Text
10811096
deriving (Show, Read, Eq, Ord)
10821097
instance IsString CommandId where

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

Lines changed: 218 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,218 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DuplicateRecordFields #-}
3+
{-# LANGUAGE LambdaCase #-}
4+
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE TypeFamilies #-}
6+
7+
module Ide.Plugin.CabalProject where
8+
9+
import Control.Concurrent.Strict
10+
import Control.DeepSeq
11+
import Control.Lens ((^.))
12+
import Control.Monad.Extra
13+
import Control.Monad.IO.Class
14+
import Control.Monad.Trans.Class (lift)
15+
import Control.Monad.Trans.Maybe (runMaybeT)
16+
import qualified Data.ByteString as BS
17+
import Data.Hashable
18+
import Data.HashMap.Strict (HashMap)
19+
import qualified Data.HashMap.Strict as HashMap
20+
import qualified Data.List as List
21+
import qualified Data.List.NonEmpty as NE
22+
import qualified Data.Maybe as Maybe
23+
import Data.Proxy
24+
import qualified Data.Text ()
25+
import qualified Data.Text as T
26+
import qualified Data.Text.Encoding as Encoding
27+
import Data.Text.Utf16.Rope.Mixed as Rope
28+
import Development.IDE as D
29+
import Development.IDE.Core.FileStore (getVersionedTextDoc)
30+
import Development.IDE.Core.PluginUtils
31+
import Development.IDE.Core.Shake (restartShakeSession)
32+
import qualified Development.IDE.Core.Shake as Shake
33+
import Development.IDE.Graph (Key,
34+
alwaysRerun)
35+
import Development.IDE.LSP.HoverDefinition (foundHover)
36+
import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
37+
import Development.IDE.Types.Shake (toKey)
38+
import qualified Distribution.CabalSpecVersion as Cabal
39+
import qualified Distribution.Fields as Syntax
40+
import Distribution.Package (Dependency)
41+
import Distribution.PackageDescription (allBuildDepends,
42+
depPkgName,
43+
unPackageName)
44+
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
45+
import Distribution.Parsec.Error
46+
import qualified Distribution.Parsec.Position as Syntax
47+
import GHC.Generics
48+
import Ide.Plugin.Error
49+
import Ide.Types
50+
import qualified Language.LSP.Protocol.Lens as JL
51+
import qualified Language.LSP.Protocol.Message as LSP
52+
import Language.LSP.Protocol.Types
53+
import qualified Language.LSP.VFS as VFS
54+
import Text.Regex.TDFA
55+
56+
data Log
57+
= LogModificationTime NormalizedFilePath FileVersion
58+
| LogShake Shake.Log
59+
| LogDocOpened Uri
60+
| LogDocModified Uri
61+
| LogDocSaved Uri
62+
| LogDocClosed Uri
63+
| LogFOI (HashMap NormalizedFilePath FileOfInterestStatus)
64+
deriving (Show)
65+
66+
instance Pretty Log where
67+
pretty = \case
68+
LogShake log' -> pretty log'
69+
LogModificationTime nfp modTime ->
70+
"Modified:" <+> pretty (fromNormalizedFilePath nfp) <+> pretty (show modTime)
71+
LogDocOpened uri ->
72+
"Opened text document:" <+> pretty (getUri uri)
73+
LogDocModified uri ->
74+
"Modified text document:" <+> pretty (getUri uri)
75+
LogDocSaved uri ->
76+
"Saved text document:" <+> pretty (getUri uri)
77+
LogDocClosed uri ->
78+
"Closed text document:" <+> pretty (getUri uri)
79+
LogFOI files ->
80+
"Set files of interest to:" <+> viaShow files
81+
82+
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
83+
descriptor recorder plId =
84+
(defaultCabalProjectPluginDescriptor plId "Provides a variety of IDE features in cabal files")
85+
{ pluginRules = cabalRules recorder plId
86+
, pluginHandlers =
87+
mconcat
88+
[]
89+
, pluginNotificationHandlers =
90+
mconcat
91+
[ mkPluginNotificationHandler LSP.SMethod_TextDocumentDidOpen $
92+
\ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do
93+
whenUriFile _uri $ \file -> do
94+
log' Debug $ LogDocOpened _uri
95+
restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" $
96+
addFileOfInterest recorder ide file Modified{firstOpen = True}
97+
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $
98+
\ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
99+
whenUriFile _uri $ \file -> do
100+
log' Debug $ LogDocModified _uri
101+
restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $
102+
addFileOfInterest recorder ide file Modified{firstOpen = False}
103+
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $
104+
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
105+
whenUriFile _uri $ \file -> do
106+
log' Debug $ LogDocSaved _uri
107+
restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $
108+
addFileOfInterest recorder ide file OnDisk
109+
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
110+
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
111+
whenUriFile _uri $ \file -> do
112+
log' Debug $ LogDocClosed _uri
113+
restartCabalShakeSession (shakeExtras ide) vfs file "(closed)" $
114+
deleteFileOfInterest recorder ide file
115+
]
116+
, pluginConfigDescriptor = defaultConfigDescriptor
117+
{ configHasDiagnostics = True
118+
}
119+
}
120+
where
121+
log' = logWith recorder
122+
123+
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
124+
whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath'
125+
126+
cabalRules :: Recorder (WithPriority Log) -> PluginId -> Rules ()
127+
cabalRules recorder _ = do
128+
ofInterestRules recorder
129+
130+
{- | Helper function to restart the shake session, specifically for modifying .cabal files.
131+
No special logic, just group up a bunch of functions you need for the base
132+
Notification Handlers.
133+
134+
To make sure diagnostics are up to date, we need to tell shake that the file was touched and
135+
needs to be re-parsed. That's what we do when we record the dirty key that our parsing
136+
rule depends on.
137+
Then we restart the shake session, so that changes to our virtual files are actually picked up.
138+
-}
139+
restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO ()
140+
restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = do
141+
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do
142+
keys <- actionBetweenSession
143+
return (toKey GetModificationTime file:keys)
144+
145+
-- ----------------------------------------------------------------
146+
-- Cabal file of Interest rules and global variable
147+
-- ----------------------------------------------------------------
148+
149+
{- | Cabal files that are currently open in the lsp-client.
150+
Specific actions happen when these files are saved, closed or modified,
151+
such as generating diagnostics, re-parsing, etc...
152+
153+
We need to store the open files to parse them again if we restart the shake session.
154+
Restarting of the shake session happens whenever these files are modified.
155+
-}
156+
newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
157+
158+
instance Shake.IsIdeGlobal OfInterestCabalVar
159+
160+
data IsCabalFileOfInterest = IsCabalFileOfInterest
161+
deriving (Eq, Show, Generic)
162+
instance Hashable IsCabalFileOfInterest
163+
instance NFData IsCabalFileOfInterest
164+
165+
type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult
166+
167+
data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus
168+
deriving (Eq, Show, Generic)
169+
instance Hashable CabalFileOfInterestResult
170+
instance NFData CabalFileOfInterestResult
171+
172+
{- | The rule that initialises the files of interest state.
173+
174+
Needs to be run on start-up.
175+
-}
176+
ofInterestRules :: Recorder (WithPriority Log) -> Rules ()
177+
ofInterestRules recorder = do
178+
Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty)
179+
Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do
180+
alwaysRerun
181+
filesOfInterest <- getCabalFilesOfInterestUntracked
182+
let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest
183+
fp = summarize foi
184+
res = (Just fp, Just foi)
185+
return res
186+
where
187+
summarize NotCabalFOI = BS.singleton 0
188+
summarize (IsCabalFOI OnDisk) = BS.singleton 1
189+
summarize (IsCabalFOI (Modified False)) = BS.singleton 2
190+
summarize (IsCabalFOI (Modified True)) = BS.singleton 3
191+
192+
getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
193+
getCabalFilesOfInterestUntracked = do
194+
OfInterestCabalVar var <- Shake.getIdeGlobalAction
195+
liftIO $ readVar var
196+
197+
addFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO [Key]
198+
addFileOfInterest recorder state f v = do
199+
OfInterestCabalVar var <- Shake.getIdeGlobalState state
200+
(prev, files) <- modifyVar var $ \dict -> do
201+
let (prev, new) = HashMap.alterF (,Just v) f dict
202+
pure (new, (prev, new))
203+
if prev /= Just v
204+
then do
205+
log' Debug $ LogFOI files
206+
return [toKey IsCabalFileOfInterest f]
207+
else return []
208+
where
209+
log' = logWith recorder
210+
211+
deleteFileOfInterest :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> IO [Key]
212+
deleteFileOfInterest recorder state f = do
213+
OfInterestCabalVar var <- Shake.getIdeGlobalState state
214+
files <- modifyVar' var $ HashMap.delete f
215+
log' Debug $ LogFOI files
216+
return [toKey IsFileOfInterest f]
217+
where
218+
log' = logWith recorder

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

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
module Main where
2+
3+
main = undefined

‎src/HlsPlugins.hs

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,9 @@ import qualified Ide.Plugin.CallHierarchy as CallHierarchy
2323
#if hls_cabal
2424
import qualified Ide.Plugin.Cabal as Cabal
2525
#endif
26+
#if hls_cabal_project
27+
import qualified Ide.Plugin.CabalProject as CabalProject
28+
#endif
2629
#if hls_class
2730
import qualified Ide.Plugin.Class as Class
2831
#endif
@@ -154,6 +157,9 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins
154157
let pId = "cabal" in Cabal.descriptor (pluginRecorder pId) pId :
155158
let caId = "cabalHaskellIntegration" in Cabal.haskellInteractionDescriptor (pluginRecorder caId) caId :
156159
#endif
160+
#if hls_cabal_project
161+
let pId = "cabalProject" in CabalProject.descriptor (pluginRecorder pId) pId :
162+
#endif
157163
#if hls_pragmas
158164
Pragmas.suggestPragmaDescriptor "pragmas-suggest" :
159165
Pragmas.completionDescriptor "pragmas-completion" :

‎test.cpp

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
#include <iostream>
2+
int main() { std::cout << "OK
3+
"; return 0; }

0 commit comments

Comments
 (0)