hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add version header to caches

Browse Source
This commit is contained in:
Daniel Gröber 2015-08-10 05:00:58 +02:00
parent c71528c574
commit bb22b643e9
1 changed files with 15 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Language/Haskell/GhcMod/Caching.hs
View File

@ -1,11 +1,16 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.GhcMod.Caching where module Language.Haskell.GhcMod.Caching where
import Control.Arrow (first)
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.Maybe import Data.Maybe
import Data.Serialize import Data.Serialize
import Data.Version
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import System.FilePath import System.FilePath
import Utils (TimedFile(..), timeMaybe, mightExist) import Utils (TimedFile(..), timeMaybe, mightExist)
import Paths_ghc_mod (version)
import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Logging import Language.Haskell.GhcMod.Logging
@ -63,7 +68,7 @@ cached dir cd d = do
tcfile <- liftIO $ timeMaybe (cacheFile cd) tcfile <- liftIO $ timeMaybe (cacheFile cd)
case mcc of case mcc of
Nothing -> Nothing ->
writeCache (TimedCacheFiles tcfile []) Nothing "cache missing" writeCache (TimedCacheFiles tcfile []) Nothing "cache missing or unreadable"
Just (ifs, d', a) | d /= d' -> do Just (ifs, d', a) | d /= d' -> do
tcf <- timeCacheInput dir (cacheFile cd) ifs tcf <- timeCacheInput dir (cacheFile cd) ifs
writeCache tcf (Just a) $ "input data changed" -- ++ " was: " ++ show d ++ " is: " ++ show d' writeCache tcf (Just a) $ "input data changed" -- ++ " was: " ++ show d ++ " is: " ++ show d'
@ -75,11 +80,14 @@ cached dir cd d = do
Nothing -> writeCache tcf (Just a) "cache missing, existed a sec ago WTF?" Nothing -> writeCache tcf (Just a) "cache missing, existed a sec ago WTF?"
where where
cacheHeader = BS8.pack $ "Written by ghc-mod " ++ showVersion version ++ "\n"
writeCache tcf ma cause = do writeCache tcf ma cause = do
(ifs', a) <- (cachedAction cd) tcf d ma (ifs', a) <- (cachedAction cd) tcf d ma
gmLog GmDebug "" $ (text "regenerating cache") <+>: text (cacheFile cd) gmLog GmDebug "" $ (text "regenerating cache") <+>: text (cacheFile cd)
<+> parens (text cause) <+> parens (text cause)
liftIO $ BS.writeFile (dir </> cacheFile cd) $ encode (ifs', d, a) liftIO $ BS.writeFile (dir </> cacheFile cd) $
BS.append cacheHeader $ encode (ifs', d, a)
return a return a
readCache :: m (Maybe ([FilePath], d, a)) readCache :: m (Maybe ([FilePath], d, a))
@ -90,7 +98,11 @@ cached dir cd d = do
readCache' f = do readCache' f = do
gmLog GmDebug "" $ (text "reading cache") <+>: text (cacheFile cd) gmLog GmDebug "" $ (text "reading cache") <+>: text (cacheFile cd)
cc <- liftIO $ BS.readFile f cc <- liftIO $ BS.readFile f
return $ either (const Nothing) Just $ decode cc case first BS8.words $ BS8.span (/='\n') cc of
(["Written", "by", "ghc-mod", ver], rest)
| BS8.unpack ver == showVersion version ->
return $ either (const Nothing) Just $ decode $ BS.drop 1 rest
_ -> return Nothing
timeCacheInput :: MonadIO m => FilePath -> FilePath -> [FilePath] -> m TimedCacheFiles timeCacheInput :: MonadIO m => FilePath -> FilePath -> [FilePath] -> m TimedCacheFiles
timeCacheInput dir cfile ifs = liftIO $ do timeCacheInput dir cfile ifs = liftIO $ do