[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.
haskell · Oct 24, 2021 · 8367bb4 · 8367bb4
1 parent 82517c8
commit 8367bb4
Show file tree

Hide file tree

Showing 3 changed files with 40 additions and 31 deletions.
diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Database.hs b/hls-graph/src/Development/IDE/Graph/Internal/Database.hs
@@ -11,7 +11,7 @@
 {-# LANGUAGE TupleSections              #-}
 {-# LANGUAGE TypeFamilies               #-}
 
-module Development.IDE.Graph.Internal.Database (newDatabase, incDatabase, build) where
+module Development.IDE.Graph.Internal.Database (newDatabase, incDatabase, build, getDirtySet) where
 
 import           Control.Concurrent.Async
 import           Control.Concurrent.Extra
@@ -46,15 +46,13 @@ newDatabase databaseExtra databaseRules = do
     databaseValues <- Ids.empty
     databaseReverseDeps <- Ids.empty
     databaseReverseDepsLock <- newLock
-    databaseDirtySet <- newIORef Nothing
     pure Database{..}
 
 -- | Increment the step and mark dirty
 incDatabase :: Database -> Maybe [Key] -> IO ()
 -- all keys are dirty
 incDatabase db Nothing = do
     modifyIORef' (databaseStep db) $ \(Step i) -> Step $ i + 1
-    writeIORef (databaseDirtySet db) Nothing
     withLock (databaseLock db) $
         Ids.forMutate (databaseValues db) $ \_ -> second $ \case
             Clean x       -> Dirty (Just x)
@@ -66,7 +64,6 @@ incDatabase db (Just kk) = do
     intern <- readIORef (databaseIds db)
     let dirtyIds = mapMaybe (`Intern.lookup` intern) kk
     transitiveDirtyIds <- transitiveDirtySet db dirtyIds
-    modifyIORef (databaseDirtySet db) (\dd -> Just $ fromMaybe mempty dd <> transitiveDirtyIds)
     withLock (databaseLock db) $
         Ids.forMutate (databaseValues db) $ \i -> \case
             (k, Running _ _ x) -> (k, Dirty x)
@@ -182,6 +179,15 @@ compute db@Database{..} key id mode result = do
         Ids.insert databaseValues id (key, Clean res)
     pure res
 
+-- | Returns the set of dirty keys annotated with their age (in # of builds)
+getDirtySet :: Database -> IO [(Id,(Key, Int))]
+getDirtySet db = do
+    Step curr <- readIORef (databaseStep db)
+    dbContents <- Ids.toList (databaseValues db)
+    let calcAge Result{resultBuilt = Step x} = curr - x
+        calcAgeStatus (Dirty x)=calcAge <$> x
+        calcAgeStatus _         = Nothing
+    return $ mapMaybe ((secondM.secondM) calcAgeStatus) dbContents
 --------------------------------------------------------------------------------
 -- Lazy IO trick
 

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs b/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs
@@ -7,47 +7,51 @@
 module Development.IDE.Graph.Internal.Profile (writeProfile) where
 
 import           Data.Bifunctor
-import qualified Data.ByteString.Lazy.Char8           as LBS
+import qualified Data.ByteString.Lazy.Char8              as LBS
 import           Data.Char
-import           Data.Dynamic                         (toDyn)
-import qualified Data.HashMap.Strict                  as Map
+import           Data.Dynamic                            (toDyn)
+import qualified Data.HashMap.Strict                     as Map
 import           Data.IORef
-import           Data.IntMap                          (IntMap)
-import qualified Data.IntMap                          as IntMap
-import qualified Data.IntSet                          as Set
-import           Data.List                            (dropWhileEnd, foldl',
-                                                       intercalate, partition,
-                                                       sort, sortBy)
-import           Data.List.Extra                      (nubOrd)
+import           Data.IntMap                             (IntMap)
+import qualified Data.IntMap                             as IntMap
+import qualified Data.IntSet                             as Set
+import           Data.List                               (dropWhileEnd, foldl',
+                                                          intercalate,
+                                                          partition, sort,
+                                                          sortBy)
+import           Data.List.Extra                         (nubOrd)
 import           Data.Maybe
-import           Data.Time                            (defaultTimeLocale,
-                                                       formatTime,
-                                                       getCurrentTime,
-                                                       iso8601DateFormat)
+import           Data.Time                               (defaultTimeLocale,
+                                                          formatTime,
+                                                          getCurrentTime,
+                                                          iso8601DateFormat)
 import           Development.IDE.Graph.Classes
-import qualified Development.IDE.Graph.Internal.Ids   as Ids
+import           Development.IDE.Graph.Internal.Database (getDirtySet)
+import qualified Development.IDE.Graph.Internal.Ids      as Ids
 import           Development.IDE.Graph.Internal.Paths
 import           Development.IDE.Graph.Internal.Types
-import qualified Language.Javascript.DGTable          as DGTable
-import qualified Language.Javascript.Flot             as Flot
-import qualified Language.Javascript.JQuery           as JQuery
-import           Numeric.Extra                        (showDP)
+import qualified Language.Javascript.DGTable             as DGTable
+import qualified Language.Javascript.Flot                as Flot
+import qualified Language.Javascript.JQuery              as JQuery
+import           Numeric.Extra                           (showDP)
 import           System.FilePath
-import           System.IO.Unsafe                     (unsafePerformIO)
-import           System.Time.Extra                    (Seconds)
+import           System.IO.Unsafe                        (unsafePerformIO)
+import           System.Time.Extra                       (Seconds)
 
 #ifdef FILE_EMBED
 import           Data.FileEmbed
-import           Language.Haskell.TH.Syntax           (runIO)
+import           Language.Haskell.TH.Syntax              (runIO)
 #endif
 
 -- | Generates an report given some build system profiling data.
 writeProfile :: FilePath -> Database -> IO ()
 writeProfile out db = do
-    dirtyKeys <- readIORef (databaseDirtySet db)
     (report, mapping) <- toReport db
-    let dirtyKeysMapped = mapMaybe (`IntMap.lookup` mapping) . Set.toList <$> dirtyKeys
-    rpt <- generateHTML (sort <$> dirtyKeysMapped) report
+    dirtyKeysMapped <- do
+        dirtyIds <- Set.fromList . fmap fst <$> getDirtySet db
+        let dirtyKeysMapped = mapMaybe (`IntMap.lookup` mapping) . Set.toList $ dirtyIds
+        return $ Just $ sort dirtyKeysMapped
+    rpt <- generateHTML dirtyKeysMapped report
     LBS.writeFile out rpt
 
 data ProfileEntry = ProfileEntry

diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs
@@ -10,6 +10,7 @@ module Development.IDE.Graph.Internal.Types where
 import           Control.Applicative
 import           Control.Concurrent.Extra
 import           Control.Monad.Catch
+-- Needed in GHC 8.6.5
 import           Control.Monad.Fail
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Reader
@@ -81,8 +82,6 @@ data Database = Database {
     databaseExtra           :: Dynamic,
     databaseRules           :: TheRules,
     databaseStep            :: !(IORef Step),
-    -- | Nothing means that everything is dirty
-    databaseDirtySet        :: IORef (Maybe IntSet),
     -- Hold the lock while mutating Ids/Values
     databaseLock            :: !Lock,
     databaseIds             :: !(IORef (Intern Key)),