From 39a8ded102bcc33d8bbfd1d9253f2954431c5400 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Sun, 12 Apr 2015 02:39:18 +0200
Subject: [PATCH] Fix resolved component caching

---
 Language/Haskell/GhcMod/CabalHelper.hs |  2 +-
 Language/Haskell/GhcMod/Caching.hs     | 17 +++++++++--------
 Language/Haskell/GhcMod/Target.hs      | 26 +++++++++++++++++++-------
 3 files changed, 29 insertions(+), 16 deletions(-)

diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs
index ed0bc5c..b229a2a 100644
--- a/Language/Haskell/GhcMod/CabalHelper.hs
+++ b/Language/Haskell/GhcMod/CabalHelper.hs
@@ -74,7 +74,7 @@ cabalHelperCache :: MonadIO m => Cached m
                       [GmComponent GMCRaw ChEntrypoint]
 cabalHelperCache = Cached {
     cacheFile = cabalHelperCacheFile,
-    cachedAction = \ _ (progs, root, _) ->
+    cachedAction = \ _ (progs, root, _) _ ->
       runQuery' progs root $ do
         q <- liftM5 join5
                ghcOptions
diff --git a/Language/Haskell/GhcMod/Caching.hs b/Language/Haskell/GhcMod/Caching.hs
index db07af4..54892c9 100644
--- a/Language/Haskell/GhcMod/Caching.hs
+++ b/Language/Haskell/GhcMod/Caching.hs
@@ -5,6 +5,7 @@ import Data.Maybe
 import Data.Serialize
 import qualified Data.ByteString as BS
 import System.FilePath
+import Utils (TimedFile(..), timeMaybe, mightExist)
 
 import Language.Haskell.GhcMod.Monad.Types
 import Language.Haskell.GhcMod.Logging
@@ -13,7 +14,7 @@ import Utils
 
 data Cached m d a =
      Cached { cacheFile       :: FilePath,
-              cachedAction    :: TimedCacheFiles -> d -> m ([FilePath], a)
+              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
@@ -37,21 +38,21 @@ cached dir cd d = do
     let defTcf = TimedCacheFiles tcfile []
 
     case mcc of
-      Nothing -> writeCache defTcf "cache missing"
-      Just (ifs, d', _) | d /= d' -> do
+      Nothing -> writeCache defTcf Nothing "cache missing"
+      Just (ifs, d', a) | d /= d' -> do
           tcf <- timeCacheInput dir (cacheFile cd) ifs
-          writeCache tcf "input data changed"
+          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 "cache missing, existed a sec ago WTF?"
+                      Nothing -> writeCache tcf (Just a) "cache missing, existed a sec ago WTF?"
                       Just [] -> return a
-                      Just _ -> writeCache tcf "input files changed"
+                      Just _ -> writeCache tcf (Just a) "input files changed"
 
  where
-   writeCache tcf cause = do
-     (ifs', a) <- (cachedAction cd) tcf d
+   writeCache tcf ma cause = do
+     (ifs', a) <- (cachedAction cd) tcf d ma
      gmLog GmDebug "" $ (text "regenerating cache") <+>: text (cacheFile cd)
                                                     <+> parens (text cause)
      liftIO $ BS.writeFile (dir </> cacheFile cd) $ encode (ifs', d, a)
diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs
index f3712a3..06ebf28 100644
--- a/Language/Haskell/GhcMod/Target.hs
+++ b/Language/Haskell/GhcMod/Target.hs
@@ -191,17 +191,29 @@ targetGhcOptions crdl sefnmn = do
             return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs
 
 resolvedComponentsCache :: IOish m => Cached (GhcModT m)
-    [GmComponent GMCRaw(Set.Set ModulePath)]
+    [GmComponent GMCRaw (Set.Set ModulePath)]
     (Map.Map ChComponentName (GmComponent GMCResolved (Set.Set ModulePath)))
 resolvedComponentsCache = Cached {
     cacheFile  = resolvedComponentsCacheFile,
-    cachedAction = \tcfs comps -> do
+    cachedAction = \tcfs comps ma -> do
         Cradle {..} <- cradle
-        let changedFiles =
-                filter (/= cradleRootDir </> setupConfigPath) $ map tfPath $ tcFiles tcfs
-            mums = if null changedFiles
-                     then Nothing
-                     else Just $ map Left changedFiles
+        let mums =
+              case invalidatingInputFiles tcfs of
+                Nothing -> Nothing
+                Just iifs ->
+                  let
+                      filterOutSetupCfg =
+                          filter (/= cradleRootDir </> setupConfigPath)
+                      changedFiles = filterOutSetupCfg iifs
+                  in if null changedFiles
+                       then Nothing
+                       else Just $ map Left changedFiles
+
+        case ma of
+          Just mcs -> gmsGet >>= \s -> gmsPut s { gmComponents = mcs }
+          Nothing -> return ()
+
+--        liftIO $ print ("changed files", mums :: Maybe [Either FilePath ()])
 
         mcs <- resolveGmComponents mums comps
         return (setupConfigPath:flatten mcs , mcs)