Skip to content

Commit 00add61

Browse files
pepeiborrapepeiborra
committed
[hls-graph] clean up databaseDirtySet
When I ported https://github.com/ndmitchell/shake/pull/802/files to hls-graph, I changed the encoding of the dirty set. Instead, Dirty became a constructor in the Status union. But the databaseDirtySet stayed around accidentally, leading to some confusion.
1 parent d44a706 commit 00add61

File tree

3 files changed

+40
-31
lines changed

3 files changed

+40
-31
lines changed

‎hls-graph/src/Development/IDE/Graph/Internal/Database.hs

Lines changed: 10 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@
1111
{-# LANGUAGE TupleSections #-}
1212
{-# LANGUAGE TypeFamilies #-}
1313

14-
module Development.IDE.Graph.Internal.Database (newDatabase, incDatabase, build) where
14+
module Development.IDE.Graph.Internal.Database (newDatabase, incDatabase, build, getDirtySet) where
1515

1616
import Control.Concurrent.Async
1717
import Control.Concurrent.Extra
@@ -46,15 +46,13 @@ newDatabase databaseExtra databaseRules = do
4646
databaseValues <- Ids.empty
4747
databaseReverseDeps <- Ids.empty
4848
databaseReverseDepsLock <- newLock
49-
databaseDirtySet <- newIORef Nothing
5049
pure Database{..}
5150

5251
-- | Increment the step and mark dirty
5352
incDatabase :: Database -> Maybe [Key] -> IO ()
5453
-- all keys are dirty
5554
incDatabase db Nothing = do
5655
modifyIORef' (databaseStep db) $ \(Step i) -> Step $ i + 1
57-
writeIORef (databaseDirtySet db) Nothing
5856
withLock (databaseLock db) $
5957
Ids.forMutate (databaseValues db) $ \_ -> second $ \case
6058
Clean x -> Dirty (Just x)
@@ -66,7 +64,6 @@ incDatabase db (Just kk) = do
6664
intern <- readIORef (databaseIds db)
6765
let dirtyIds = mapMaybe (`Intern.lookup` intern) kk
6866
transitiveDirtyIds <- transitiveDirtySet db dirtyIds
69-
modifyIORef (databaseDirtySet db) (\dd -> Just $ fromMaybe mempty dd <> transitiveDirtyIds)
7067
withLock (databaseLock db) $
7168
Ids.forMutate (databaseValues db) $ \i -> \case
7269
(k, Running _ _ x) -> (k, Dirty x)
@@ -182,6 +179,15 @@ compute db@Database{..} key id mode result = do
182179
Ids.insert databaseValues id (key, Clean res)
183180
pure res
184181

182+
-- | Returns the set of dirty keys annotated with their age (in # of builds)
183+
getDirtySet :: Database -> IO [(Id,(Key, Int))]
184+
getDirtySet db = do
185+
Step curr <- readIORef (databaseStep db)
186+
dbContents <- Ids.toList (databaseValues db)
187+
let calcAge Result{resultBuilt = Step x} = curr - x
188+
calcAgeStatus (Dirty x)=calcAge <$> x
189+
calcAgeStatus _ = Nothing
190+
return $ mapMaybe ((secondM.secondM) calcAgeStatus) dbContents
185191
--------------------------------------------------------------------------------
186192
-- Lazy IO trick
187193

‎hls-graph/src/Development/IDE/Graph/Internal/Profile.hs

Lines changed: 29 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -7,47 +7,51 @@
77
module Development.IDE.Graph.Internal.Profile (writeProfile) where
88

99
import Data.Bifunctor
10-
import qualified Data.ByteString.Lazy.Char8 as LBS
10+
import qualified Data.ByteString.Lazy.Char8 as LBS
1111
import Data.Char
12-
import Data.Dynamic (toDyn)
13-
import qualified Data.HashMap.Strict as Map
12+
import Data.Dynamic (toDyn)
13+
import qualified Data.HashMap.Strict as Map
1414
import Data.IORef
15-
import Data.IntMap (IntMap)
16-
import qualified Data.IntMap as IntMap
17-
import qualified Data.IntSet as Set
18-
import Data.List (dropWhileEnd, foldl',
19-
intercalate, partition,
20-
sort, sortBy)
21-
import Data.List.Extra (nubOrd)
15+
import Data.IntMap (IntMap)
16+
import qualified Data.IntMap as IntMap
17+
import qualified Data.IntSet as Set
18+
import Data.List (dropWhileEnd, foldl',
19+
intercalate,
20+
partition, sort,
21+
sortBy)
22+
import Data.List.Extra (nubOrd)
2223
import Data.Maybe
23-
import Data.Time (defaultTimeLocale,
24-
formatTime,
25-
getCurrentTime,
26-
iso8601DateFormat)
24+
import Data.Time (defaultTimeLocale,
25+
formatTime,
26+
getCurrentTime,
27+
iso8601DateFormat)
2728
import Development.IDE.Graph.Classes
28-
import qualified Development.IDE.Graph.Internal.Ids as Ids
29+
import Development.IDE.Graph.Internal.Database (getDirtySet)
30+
import qualified Development.IDE.Graph.Internal.Ids as Ids
2931
import Development.IDE.Graph.Internal.Paths
3032
import Development.IDE.Graph.Internal.Types
31-
import qualified Language.Javascript.DGTable as DGTable
32-
import qualified Language.Javascript.Flot as Flot
33-
import qualified Language.Javascript.JQuery as JQuery
34-
import Numeric.Extra (showDP)
33+
import qualified Language.Javascript.DGTable as DGTable
34+
import qualified Language.Javascript.Flot as Flot
35+
import qualified Language.Javascript.JQuery as JQuery
36+
import Numeric.Extra (showDP)
3537
import System.FilePath
36-
import System.IO.Unsafe (unsafePerformIO)
37-
import System.Time.Extra (Seconds)
38+
import System.IO.Unsafe (unsafePerformIO)
39+
import System.Time.Extra (Seconds)
3840

3941
#ifdef FILE_EMBED
4042
import Data.FileEmbed
41-
import Language.Haskell.TH.Syntax (runIO)
43+
import Language.Haskell.TH.Syntax (runIO)
4244
#endif
4345

4446
-- | Generates an report given some build system profiling data.
4547
writeProfile :: FilePath -> Database -> IO ()
4648
writeProfile out db = do
47-
dirtyKeys <- readIORef (databaseDirtySet db)
4849
(report, mapping) <- toReport db
49-
let dirtyKeysMapped = mapMaybe (`IntMap.lookup` mapping) . Set.toList <$> dirtyKeys
50-
rpt <- generateHTML (sort <$> dirtyKeysMapped) report
50+
dirtyKeysMapped <- do
51+
dirtyIds <- Set.fromList . fmap fst <$> getDirtySet db
52+
let dirtyKeysMapped = mapMaybe (`IntMap.lookup` mapping) . Set.toList $ dirtyIds
53+
return $ Just $ sort dirtyKeysMapped
54+
rpt <- generateHTML dirtyKeysMapped report
5155
LBS.writeFile out rpt
5256

5357
data ProfileEntry = ProfileEntry

‎hls-graph/src/Development/IDE/Graph/Internal/Types.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ module Development.IDE.Graph.Internal.Types where
1010
import Control.Applicative
1111
import Control.Concurrent.Extra
1212
import Control.Monad.Catch
13+
-- Needed in GHC 8.6.5
1314
import Control.Monad.Fail
1415
import Control.Monad.IO.Class
1516
import Control.Monad.Trans.Reader
@@ -81,8 +82,6 @@ data Database = Database {
8182
databaseExtra :: Dynamic,
8283
databaseRules :: TheRules,
8384
databaseStep :: !(IORef Step),
84-
-- | Nothing means that everything is dirty
85-
databaseDirtySet :: IORef (Maybe IntSet),
8685
-- Hold the lock while mutating Ids/Values
8786
databaseLock :: !Lock,
8887
databaseIds :: !(IORef (Intern Key)),

0 commit comments

Comments
 (0)