Fix resolved component caching

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

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)

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)