Skip to content

Commit 368705a

Browse files
committed
Add cabal files of interest and kick function
Configure a "kick" function for cabal files that is run when the shake queue needs to be restarted. Copy pastes from ghcide and 'files of interest'. Maybe more abstraction needed.
1 parent 408b813 commit 368705a

File tree

2 files changed

+91
-3
lines changed

2 files changed

+91
-3
lines changed

plugins/hls-cabal-plugin/hls-cabal-plugin.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ library
3838
, ghcide ^>= 1.8
3939
, hashable
4040
, hls-plugin-api ^>=1.5
41+
, hls-graph ^>=1.8
4142
, lsp ^>=1.6.0.0
4243
, lsp-types ^>=1.6.0.0
4344
, regex-tdfa ^>=1.3.1

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

Lines changed: 90 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -6,23 +6,29 @@
66
{-# LANGUAGE LambdaCase #-}
77
{-# LANGUAGE NamedFieldPuns #-}
88
{-# LANGUAGE OverloadedStrings #-}
9+
{-# LANGUAGE TupleSections #-}
910
{-# LANGUAGE TypeFamilies #-}
1011

11-
module Ide.Plugin.Cabal where
12+
module Ide.Plugin.Cabal (descriptor, Log(..)) where
1213

1314
import Control.Concurrent.STM
14-
import Control.DeepSeq (NFData)
15+
import Control.Concurrent.Strict
16+
import Control.DeepSeq
1517
import Control.Monad.Extra
1618
import Control.Monad.IO.Class
1719
import qualified Data.ByteString as BS
1820
import Data.Hashable
21+
import Data.HashMap.Strict (HashMap)
22+
import qualified Data.HashMap.Strict as HashMap
1923
import qualified Data.List.NonEmpty as NE
2024
import Data.Maybe (mapMaybe)
25+
import qualified Data.Text as T
2126
import qualified Data.Text.Encoding as Encoding
2227
import Data.Typeable
2328
import Development.IDE as D
2429
import Development.IDE.Core.Shake (restartShakeSession)
2530
import qualified Development.IDE.Core.Shake as Shake
31+
import Development.IDE.Graph (alwaysRerun)
2632
import GHC.Generics
2733
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
2834
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
@@ -69,24 +75,28 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId)
6975
\ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do
7076
whenUriFile _uri $ \file -> do
7177
log' Debug $ LogDocOpened _uri
78+
addFileOfInterest ide file Modified{firstOpen=True}
7279
restartCabalShakeSession ide vfs file "(opened)"
7380

7481
, mkPluginNotificationHandler LSP.STextDocumentDidChange $
7582
\ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
7683
whenUriFile _uri $ \file -> do
7784
log' Debug $ LogDocModified _uri
85+
addFileOfInterest ide file Modified{firstOpen=False}
7886
restartCabalShakeSession ide vfs file "(changed)"
7987

8088
, mkPluginNotificationHandler LSP.STextDocumentDidSave $
8189
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
8290
whenUriFile _uri $ \file -> do
8391
log' Debug $ LogDocSaved _uri
92+
addFileOfInterest ide file OnDisk
8493
restartCabalShakeSession ide vfs file "(saved)"
8594

8695
, mkPluginNotificationHandler LSP.STextDocumentDidClose $
8796
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
8897
whenUriFile _uri $ \file -> do
8998
log' Debug $ LogDocClosed _uri
99+
deleteFileOfInterest ide file
90100
restartCabalShakeSession ide vfs file "(closed)"
91101
]
92102
}
@@ -103,7 +113,71 @@ restartCabalShakeSession :: IdeState -> VFS.VFS -> NormalizedFilePath -> String
103113
restartCabalShakeSession ide vfs file actionMsg = do
104114
join $ atomically $ Shake.recordDirtyKeys (shakeExtras ide) GetModificationTime [file]
105115
restartShakeSession (shakeExtras ide) (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) []
106-
join $ Shake.shakeEnqueue (shakeExtras ide) $ Shake.mkDelayedAction "cabal parse modified" Info $ void $ use ParseCabal file
116+
117+
-- ----------------------------------------------------------------
118+
-- Cabal file of Interset rules and global variable
119+
-- ----------------------------------------------------------------
120+
121+
newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath FileOfInterestStatus))
122+
123+
instance Shake.IsIdeGlobal OfInterestCabalVar
124+
125+
data IsCabalFileOfInterest = IsCabalFileOfInterest
126+
deriving (Eq, Show, Typeable, Generic)
127+
instance Hashable IsCabalFileOfInterest
128+
instance NFData IsCabalFileOfInterest
129+
130+
type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult
131+
132+
data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus
133+
deriving (Eq, Show, Typeable, Generic)
134+
instance Hashable CabalFileOfInterestResult
135+
instance NFData CabalFileOfInterestResult
136+
137+
-- | The rule that initialises the files of interest state.
138+
ofInterestRules :: Recorder (WithPriority Log) -> Rules ()
139+
ofInterestRules recorder = do
140+
Shake.addIdeGlobal . OfInterestCabalVar =<< liftIO (newVar HashMap.empty)
141+
Shake.defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \IsCabalFileOfInterest f -> do
142+
alwaysRerun
143+
filesOfInterest <- getCabalFilesOfInterestUntracked
144+
let foi = maybe NotCabalFOI IsCabalFOI $ f `HashMap.lookup` filesOfInterest
145+
fp = summarize foi
146+
res = (Just fp, Just foi)
147+
return res
148+
where
149+
summarize NotCabalFOI = BS.singleton 0
150+
summarize (IsCabalFOI OnDisk) = BS.singleton 1
151+
summarize (IsCabalFOI (Modified False)) = BS.singleton 2
152+
summarize (IsCabalFOI (Modified True)) = BS.singleton 3
153+
154+
getCabalFilesOfInterestUntracked :: Action (HashMap NormalizedFilePath FileOfInterestStatus)
155+
getCabalFilesOfInterestUntracked = do
156+
OfInterestCabalVar var <- Shake.getIdeGlobalAction
157+
liftIO $ readVar var
158+
159+
getFilesOfInterest :: IdeState -> IO( HashMap NormalizedFilePath FileOfInterestStatus)
160+
getFilesOfInterest state = do
161+
OfInterestCabalVar var <- Shake.getIdeGlobalState state
162+
readVar var
163+
164+
addFileOfInterest :: IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
165+
addFileOfInterest state f v = do
166+
OfInterestCabalVar var <- Shake.getIdeGlobalState state
167+
(prev, files) <- modifyVar var $ \dict -> do
168+
let (prev, new) = HashMap.alterF (, Just v) f dict
169+
pure (new, (prev, new))
170+
when (prev /= Just v) $ do
171+
join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
172+
logDebug (ideLogger state) $
173+
"Set files of interest to: " <> T.pack (show files)
174+
175+
deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO ()
176+
deleteFileOfInterest state f = do
177+
OfInterestCabalVar var <- Shake.getIdeGlobalState state
178+
files <- modifyVar' var $ HashMap.delete f
179+
join $ atomically $ Shake.recordDirtyKeys (shakeExtras state) IsFileOfInterest [f]
180+
logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show files)
107181

108182
-- ----------------------------------------------------------------
109183
-- Plugin Rules
@@ -118,6 +192,7 @@ type instance RuleResult ParseCabal = ()
118192

119193
cabalRules :: Recorder (WithPriority Log) -> Rules ()
120194
cabalRules recorder = do
195+
ofInterestRules recorder
121196
define (cmapWithPrio LogShake recorder) $ \ParseCabal file -> do
122197
t <- use GetModificationTime file
123198
log' Debug $ LogModificationTime file t
@@ -138,9 +213,21 @@ cabalRules recorder = do
138213
Right _ -> do
139214
log' Debug $ LogDiagnostics file warningDiags
140215
pure (warningDiags, Just ())
216+
217+
action $ do
218+
-- Run the cabal kick. This code always runs when 'shakeRestart' is run.
219+
-- Must be careful to not impede the performance too much. Crucial to
220+
-- a snappy IDE experience.
221+
kick
141222
where
142223
log' = logWith recorder
143224

225+
-- | TODO: add documentation
226+
kick :: Action ()
227+
kick = do
228+
files <- HashMap.keys <$> getCabalFilesOfInterestUntracked
229+
void $ uses ParseCabal files
230+
144231
-- ----------------------------------------------------------------
145232
-- Code Actions
146233
-- ----------------------------------------------------------------

0 commit comments

Comments
 (0)