shakeGetDatabaseKeys

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

@@ -9,6 +9,7 @@ module Development.IDE.Graph.Database(
     shakeRunDatabaseForKeys,
     shakeProfileDatabase,
     shakeGetBuildStep,
+    shakeGetDatabaseKeys,
     shakeGetDirtySet,
     shakeLastBuildKeys
     ) where
@@ -47,6 +48,11 @@ shakeGetDirtySet :: ShakeDatabase -> IO [(Key, Int)]
 shakeGetDirtySet (ShakeDatabase _ _ db) =
     fmap snd <$> Development.IDE.Graph.Internal.Database.getDirtySet db
 
+-- | Returns ann approximation of the database keys,
+--   annotated with how long ago (in # builds) they were visited
+shakeGetDatabaseKeys :: ShakeDatabase -> IO [(Key, Int)]
+shakeGetDatabaseKeys (ShakeDatabase _ _ db) = getKeysAndVisitAge db
+
 -- | Returns the build number
 shakeGetBuildStep :: ShakeDatabase -> IO Int
 shakeGetBuildStep (ShakeDatabase _ _ db) = do

hls-graph/src/Development/IDE/Graph/Internal/Action.hs

@@ -16,6 +16,7 @@ module Development.IDE.Graph.Internal.Action
 , reschedule
 , runActions
 , Development.IDE.Graph.Internal.Action.getDirtySet
+, getKeysAndVisitedAge
 ) where
 
 import           Control.Concurrent.Async
@@ -130,3 +131,8 @@ getDirtySet  :: Action [(Key, Int)]
 getDirtySet = do
     db <- getDatabase
     liftIO $ fmap snd <$> Development.IDE.Graph.Internal.Database.getDirtySet db
+
+getKeysAndVisitedAge :: Action [(Key, Int)]
+getKeysAndVisitedAge = do
+    db <- getDatabase
+    liftIO $ Development.IDE.Graph.Internal.Database.getKeysAndVisitAge db

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, getDirtySet) where
+module Development.IDE.Graph.Internal.Database (newDatabase, incDatabase, build, getDirtySet, getKeysAndVisitAge) where
 
 import           Control.Concurrent.Async
 import           Control.Concurrent.Extra
@@ -188,6 +188,16 @@ getDirtySet db = do
         calcAgeStatus (Dirty x)=calcAge <$> x
         calcAgeStatus _         = Nothing
     return $ mapMaybe ((secondM.secondM) calcAgeStatus) dbContents
+
+-- | Returns ann approximation of the database keys,
+--   annotated with how long ago (in # builds) they were visited
+getKeysAndVisitAge :: Database -> IO [(Key, Int)]
+getKeysAndVisitAge db = do
+    values <- Ids.elems (databaseValues db)
+    Step curr <- readIORef (databaseStep db)
+    let keysWithVisitAge = mapMaybe (secondM (fmap getAge . getResult)) values
+        getAge Result{resultVisited = Step s} = curr - s
+    return keysWithVisitAge
 --------------------------------------------------------------------------------
 -- Lazy IO trick