6
6
{-# LANGUAGE LambdaCase #-}
7
7
{-# LANGUAGE NamedFieldPuns #-}
8
8
{-# LANGUAGE OverloadedStrings #-}
9
+ {-# LANGUAGE TupleSections #-}
9
10
{-# LANGUAGE TypeFamilies #-}
10
11
11
- module Ide.Plugin.Cabal where
12
+ module Ide.Plugin.Cabal ( descriptor , Log ( .. )) where
12
13
13
14
import Control.Concurrent.STM
14
- import Control.DeepSeq (NFData )
15
+ import Control.Concurrent.Strict
16
+ import Control.DeepSeq
15
17
import Control.Monad.Extra
16
18
import Control.Monad.IO.Class
17
19
import qualified Data.ByteString as BS
18
20
import Data.Hashable
21
+ import Data.HashMap.Strict (HashMap )
22
+ import qualified Data.HashMap.Strict as HashMap
19
23
import qualified Data.List.NonEmpty as NE
20
24
import Data.Maybe (mapMaybe )
25
+ import qualified Data.Text as T
21
26
import qualified Data.Text.Encoding as Encoding
22
27
import Data.Typeable
23
28
import Development.IDE as D
24
29
import Development.IDE.Core.Shake (restartShakeSession )
25
30
import qualified Development.IDE.Core.Shake as Shake
31
+ import Development.IDE.Graph (alwaysRerun )
26
32
import GHC.Generics
27
33
import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
28
34
import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
@@ -69,24 +75,28 @@ descriptor recorder plId = (defaultCabalPluginDescriptor plId)
69
75
\ ide vfs _ (DidOpenTextDocumentParams TextDocumentItem {_uri,_version}) -> liftIO $ do
70
76
whenUriFile _uri $ \ file -> do
71
77
log' Debug $ LogDocOpened _uri
78
+ addFileOfInterest ide file Modified {firstOpen= True }
72
79
restartCabalShakeSession ide vfs file " (opened)"
73
80
74
81
, mkPluginNotificationHandler LSP. STextDocumentDidChange $
75
82
\ ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier {_uri} _) -> liftIO $ do
76
83
whenUriFile _uri $ \ file -> do
77
84
log' Debug $ LogDocModified _uri
85
+ addFileOfInterest ide file Modified {firstOpen= False }
78
86
restartCabalShakeSession ide vfs file " (changed)"
79
87
80
88
, mkPluginNotificationHandler LSP. STextDocumentDidSave $
81
89
\ ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier {_uri} _) -> liftIO $ do
82
90
whenUriFile _uri $ \ file -> do
83
91
log' Debug $ LogDocSaved _uri
92
+ addFileOfInterest ide file OnDisk
84
93
restartCabalShakeSession ide vfs file " (saved)"
85
94
86
95
, mkPluginNotificationHandler LSP. STextDocumentDidClose $
87
96
\ ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier {_uri}) -> liftIO $ do
88
97
whenUriFile _uri $ \ file -> do
89
98
log' Debug $ LogDocClosed _uri
99
+ deleteFileOfInterest ide file
90
100
restartCabalShakeSession ide vfs file " (closed)"
91
101
]
92
102
}
@@ -103,7 +113,71 @@ restartCabalShakeSession :: IdeState -> VFS.VFS -> NormalizedFilePath -> String
103
113
restartCabalShakeSession ide vfs file actionMsg = do
104
114
join $ atomically $ Shake. recordDirtyKeys (shakeExtras ide) GetModificationTime [file]
105
115
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)
107
181
108
182
-- ----------------------------------------------------------------
109
183
-- Plugin Rules
@@ -118,6 +192,7 @@ type instance RuleResult ParseCabal = ()
118
192
119
193
cabalRules :: Recorder (WithPriority Log ) -> Rules ()
120
194
cabalRules recorder = do
195
+ ofInterestRules recorder
121
196
define (cmapWithPrio LogShake recorder) $ \ ParseCabal file -> do
122
197
t <- use GetModificationTime file
123
198
log' Debug $ LogModificationTime file t
@@ -138,9 +213,21 @@ cabalRules recorder = do
138
213
Right _ -> do
139
214
log' Debug $ LogDiagnostics file warningDiags
140
215
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
141
222
where
142
223
log' = logWith recorder
143
224
225
+ -- | TODO: add documentation
226
+ kick :: Action ()
227
+ kick = do
228
+ files <- HashMap. keys <$> getCabalFilesOfInterestUntracked
229
+ void $ uses ParseCabal files
230
+
144
231
-- ----------------------------------------------------------------
145
232
-- Code Actions
146
233
-- ----------------------------------------------------------------
0 commit comments