From c45a7f4b524e1b05fc6b7e70f0bbda6388a92eba Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= <dxld@darkboxed.org>
Date: Tue, 5 May 2015 14:44:42 +0200
Subject: [PATCH] Fix caching for getGhcPkgOptions

---
 Language/Haskell/GhcMod/CabalHelper.hs | 32 +++++++++++++++-----------
 Language/Haskell/GhcMod/Modules.hs     |  2 +-
 Language/Haskell/GhcMod/Target.hs      |  4 ++--
 Language/Haskell/GhcMod/Types.hs       |  5 ++--
 4 files changed, 24 insertions(+), 19 deletions(-)

diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs
index b229a2a..7c6de37 100644
--- a/Language/Haskell/GhcMod/CabalHelper.hs
+++ b/Language/Haskell/GhcMod/CabalHelper.hs
@@ -38,11 +38,9 @@ import Paths_ghc_mod as GhcMod
 
 -- | Only package related GHC options, sufficient for things that don't need to
 -- access home modules
-getGhcPkgOptions :: (MonadIO m, GmEnv m) => m [(ChComponentName, [GHCOption])]
-getGhcPkgOptions = do
-  Cradle {..} <- cradle
-  let distdir = cradleRootDir </> "dist"
-  runQuery distdir ghcPkgOptions
+getGhcPkgOptions :: (MonadIO m, GmEnv m, GmLog m)
+                 => m [(ChComponentName, [GHCOption])]
+getGhcPkgOptions = map (\c -> (gmcName c, gmcGhcPkgOpts c)) `liftM` getComponents
 
 helperProgs :: Options -> Programs
 helperProgs opts = Programs {
@@ -76,25 +74,31 @@ cabalHelperCache = Cached {
     cacheFile = cabalHelperCacheFile,
     cachedAction = \ _ (progs, root, _) _ ->
       runQuery' progs root $ do
-        q <- liftM5 join5
+        q <- liftM7 join7
                ghcOptions
+               ghcPkgOptions
                ghcSrcOptions
                ghcLangOptions
                entrypoints
+               entrypoints
                sourceDirs
-        let cs = flip map q $ \(cn, (opts, (srcOpts, (langOpts, (ep, srcDirs))))) ->
-                   GmComponent cn opts srcOpts langOpts ep ep srcDirs mempty
+        let cs = flip map q $ curry8 (GmComponent mempty)
         return ([setupConfigPath], cs)
   }
  where
-   join5 a b c d = join' a . join' b . join' c . join' d
+   curry8 fn (a, (b, (c, (d, (e, (f, (g, h))))))) = fn a b c d e f g h
+
+   liftM7 fn ma mb mc md me mf mg = do
+     a <- ma; b <- mb; c <- mc; d <- md; e <- me; f <- mf; g <- mg
+     return (fn a b c d e f g)
+
+   join7 a b c d e f = join' a . join' b . join' c . join' d . join' e . join' f
    join' :: Eq a => [(a,b)] -> [(a,c)] -> [(a,(b,c))]
    join' lb lc = [ (a, (b, c))
-                | (a, b) <- lb
-                , (a', c) <- lc
-                , a == a'
-                ]
-
+                 | (a, b) <- lb
+                 , (a', c) <- lc
+                 , a == a'
+                 ]
 
 withCabal :: (MonadIO m, GmEnv m) => m a -> m a
 withCabal action = do
diff --git a/Language/Haskell/GhcMod/Modules.hs b/Language/Haskell/GhcMod/Modules.hs
index d489138..03c69a8 100644
--- a/Language/Haskell/GhcMod/Modules.hs
+++ b/Language/Haskell/GhcMod/Modules.hs
@@ -14,7 +14,7 @@ import qualified GHC as G
 ----------------------------------------------------------------
 
 -- | Listing installed modules.
-modules :: (IOish m, GmEnv m) => m String
+modules :: (IOish m, GmEnv m, GmLog m) => m String
 modules = do
   Options { detailed } <- options
   df <- runGmPkgGhc G.getSessionDynFlags
diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs
index 790a581..d6b830a 100644
--- a/Language/Haskell/GhcMod/Target.hs
+++ b/Language/Haskell/GhcMod/Target.hs
@@ -82,7 +82,7 @@ runLightGhc env action = do
   renv <- newIORef env
   flip runReaderT renv $ unLightGhc action
 
-runGmPkgGhc :: (IOish m, GmEnv m) => LightGhc a -> m a
+runGmPkgGhc :: (IOish m, GmEnv m, GmLog m) => LightGhc a -> m a
 runGmPkgGhc action = do
     pkgOpts <- packageGhcOptions
     withLightHscEnv pkgOpts $ \env -> liftIO $ runLightGhc env action
@@ -258,7 +258,7 @@ findCandidates scns = foldl1 Set.intersection scns
 pickComponent :: Set ChComponentName -> ChComponentName
 pickComponent scn = Set.findMin scn
 
-packageGhcOptions :: (MonadIO m, GmEnv m) => m [GHCOption]
+packageGhcOptions :: (MonadIO m, GmEnv m, GmLog m) => m [GHCOption]
 packageGhcOptions = do
     crdl <- cradle
     case cradleCabalFile crdl of
diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs
index 54a1c44..a90d01c 100644
--- a/Language/Haskell/GhcMod/Types.hs
+++ b/Language/Haskell/GhcMod/Types.hs
@@ -210,14 +210,15 @@ instance Monoid GmModuleGraph where
 data GmComponentType = GMCRaw
                      | GMCResolved
 data GmComponent (t :: GmComponentType) eps = GmComponent {
+      gmcHomeModuleGraph :: GmModuleGraph,
       gmcName            :: ChComponentName,
       gmcGhcOpts         :: [GHCOption],
+      gmcGhcPkgOpts      :: [GHCOption],
       gmcGhcSrcOpts      :: [GHCOption],
       gmcGhcLangOpts     :: [GHCOption],
       gmcRawEntrypoints  :: ChEntrypoint,
       gmcEntrypoints     :: eps,
-      gmcSourceDirs      :: [FilePath],
-      gmcHomeModuleGraph :: GmModuleGraph
+      gmcSourceDirs      :: [FilePath]
     } deriving (Eq, Ord, Show, Read, Generic, Functor)
 
 instance Serialize eps => Serialize (GmComponent t eps)