Refactor L.H.G.Caching
This commit is contained in:
parent
baf557d5bf
commit
bed42f10fe
@ -10,18 +10,46 @@ import Utils (TimedFile(..), timeMaybe, mightExist)
|
||||
import Language.Haskell.GhcMod.Monad.Types
|
||||
import Language.Haskell.GhcMod.Logging
|
||||
|
||||
data Cached m d a =
|
||||
Cached { cacheFile :: FilePath,
|
||||
cachedAction :: TimedCacheFiles -> d -> Maybe a -> m ([FilePath], a)
|
||||
-- ^ The cached action, will only run if
|
||||
-- * The cache doesn\'t exist yet
|
||||
-- * The cache exists and 'inputData' changed
|
||||
-- * any files in 'inputFiles' are older than 'cacheFile'.
|
||||
data Cached m d a = Cached {
|
||||
cacheFile :: FilePath,
|
||||
|
||||
|
||||
cachedAction :: TimedCacheFiles
|
||||
-> d
|
||||
-> Maybe a
|
||||
-> m ([FilePath], a)
|
||||
|
||||
-- ^ @cachedAction tcf data ma@
|
||||
--
|
||||
-- * @tcf@: Input file timestamps. Not technically necessary, just an
|
||||
-- optimizazion when knowing which input files changed can make updating the
|
||||
-- cache faster
|
||||
--
|
||||
-- * @data@: Arbitrary static input data can be used to invalidate the cache
|
||||
-- using something other than file timestamps i.e. environment tool version
|
||||
-- numbers
|
||||
--
|
||||
-- * @ma@: Cached data if it existed
|
||||
--
|
||||
-- Returns:
|
||||
--
|
||||
-- * @fst@: Input files used in generating the cache
|
||||
--
|
||||
-- * @snd@: Cache data, will be stored alongside the static input data in the
|
||||
-- 'cacheFile'
|
||||
--
|
||||
-- The cached action, will only run if one of the following is true:
|
||||
--
|
||||
-- * 'cacheFile' doesn\'t exist yet
|
||||
-- * 'cacheFile' exists and 'inputData' changed
|
||||
-- * any files returned by the cached action changed
|
||||
}
|
||||
|
||||
data TimedCacheFiles =
|
||||
TimedCacheFiles { tcCacheFile :: Maybe TimedFile,
|
||||
data TimedCacheFiles = TimedCacheFiles {
|
||||
tcCacheFile :: Maybe TimedFile,
|
||||
-- ^ 'cacheFile' timestamp
|
||||
tcFiles :: [TimedFile]
|
||||
-- ^ Timestamped files returned by the cached action
|
||||
}
|
||||
|
||||
-- | Cache a MonadIO action with proper invalidation.
|
||||
@ -33,20 +61,18 @@ cached :: forall m a d. (MonadIO m, GmLog m, Serialize a, Eq d, Serialize d)
|
||||
cached dir cd d = do
|
||||
mcc <- readCache
|
||||
tcfile <- liftIO $ timeMaybe (cacheFile cd)
|
||||
let defTcf = TimedCacheFiles tcfile []
|
||||
|
||||
case mcc of
|
||||
Nothing -> writeCache defTcf Nothing "cache missing"
|
||||
Nothing ->
|
||||
writeCache (TimedCacheFiles tcfile []) Nothing "cache missing"
|
||||
Just (ifs, d', a) | d /= d' -> do
|
||||
tcf <- timeCacheInput dir (cacheFile cd) ifs
|
||||
writeCache tcf (Just a) "input data changed"
|
||||
Just (ifs, _, a) -> do
|
||||
tcf <- timeCacheInput dir (cacheFile cd) ifs
|
||||
let invifs = invalidatingInputFiles tcf
|
||||
case invifs of
|
||||
Nothing -> writeCache tcf (Just a) "cache missing, existed a sec ago WTF?"
|
||||
case invalidatingInputFiles tcf of
|
||||
Just [] -> return a
|
||||
Just _ -> writeCache tcf (Just a) "input files changed"
|
||||
Nothing -> writeCache tcf (Just a) "cache missing, existed a sec ago WTF?"
|
||||
|
||||
where
|
||||
writeCache tcf ma cause = do
|
||||
|
Loading…
Reference in New Issue
Block a user