From 57e2c112dc8f52ee031062a44a1ade6ac2c27c22 Mon Sep 17 00:00:00 2001
From: Sergey Vinokurov <serg.foo@gmail.com>
Date: Mon, 1 Jun 2015 15:59:38 +0300
Subject: [PATCH] Use package dbs defined by current cradle when dealing with
 SymbolDBs

---
 Language/Haskell/GhcMod/Find.hs | 67 +++++++++++++++++----------------
 src/Misc.hs                     |  2 +-
 2 files changed, 36 insertions(+), 33 deletions(-)

diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs
index 87fe3c6..039e83b 100644
--- a/Language/Haskell/GhcMod/Find.hs
+++ b/Language/Haskell/GhcMod/Find.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, BangPatterns #-}
+{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse #-}
 
 module Language.Haskell.GhcMod.Find
 #ifndef SPEC
@@ -16,21 +16,21 @@ module Language.Haskell.GhcMod.Find
   where
 
 import Control.Applicative ((<$>))
-import Control.Monad (when, void)
+import Control.Monad (when, void, (<=<))
 import Data.Function (on)
 import Data.List (groupBy, sort)
-import Data.Maybe (fromMaybe)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.Gap (listVisibleModules)
 import Language.Haskell.GhcMod.Monad
+import Language.Haskell.GhcMod.PathsAndFiles
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
-import Language.Haskell.GhcMod.PathsAndFiles
-import Language.Haskell.GhcMod.Gap (listVisibleModules)
+import Language.Haskell.GhcMod.World (timedPackageCaches)
 import Name (getOccString)
 import Module (moduleName)
 import System.Directory (doesFileExist, getModificationTime)
-import System.FilePath ((</>), takeDirectory)
+import System.FilePath ((</>))
 import System.IO
 
 #ifndef MIN_VERSION_containers
@@ -50,14 +50,14 @@ import qualified Data.Map as M
 -- | Type of function and operation names.
 type Symbol = String
 -- | Database from 'Symbol' to \['ModuleString'\].
-data SymbolDb = SymbolDb {
-    table :: Map Symbol [ModuleString]
-  , packageCachePath :: FilePath
+data SymbolDb = SymbolDb
+  { table             :: Map Symbol [ModuleString]
   , symbolDbCachePath :: FilePath
   } deriving (Show)
 
-isOutdated :: SymbolDb -> IO Bool
-isOutdated db = symbolDbCachePath db `isOlderThan` packageCachePath db
+isOutdated :: (GmEnv m, IOish m) => SymbolDb -> m Bool
+isOutdated db =
+  liftIO . (isOlderThan (symbolDbCachePath db) <=< timedPackageCaches) =<< cradle
 
 ----------------------------------------------------------------
 
@@ -72,7 +72,7 @@ lookupSymbol :: IOish m => Symbol -> SymbolDb -> GhcModT m String
 lookupSymbol sym db = convert' $ lookupSym sym db
 
 lookupSym :: Symbol -> SymbolDb -> [ModuleString]
-lookupSym sym db = fromMaybe [] $ M.lookup sym $ table db
+lookupSym sym db = M.findWithDefault [] sym $ table db
 
 ---------------------------------------------------------------
 
@@ -81,16 +81,16 @@ loadSymbolDb :: IOish m => GhcModT m SymbolDb
 loadSymbolDb = do
     ghcMod <- liftIO ghcModExecutable
     tmpdir <- cradleTempDir <$> cradle
-    file <- liftIO $ chop <$> readProcess ghcMod ["dumpsym", tmpdir] ""
-    !db <- M.fromAscList . map conv . lines <$> liftIO (readFile file)
-    return $ SymbolDb {
-        table = db
-      , packageCachePath = takeDirectory file </> packageCache
+    file   <- liftIO $ chop <$> readProcess ghcMod ["dumpsym", tmpdir] ""
+    !db    <- M.fromAscList . map conv . lines <$> liftIO (readFile file)
+    return $ SymbolDb
+      { table             = db
       , symbolDbCachePath = file
       }
   where
     conv :: String -> (Symbol,[ModuleString])
     conv = read
+    chop :: String -> String
     chop "" = ""
     chop xs = init xs
 
@@ -102,13 +102,15 @@ loadSymbolDb = do
 --   The file name is printed.
 
 dumpSymbol :: IOish m => FilePath -> GhcModT m String
-dumpSymbol dir = runGmPkgGhc $ do
-    let cache = dir </> symbolCacheFile
-        pkgdb = dir </> packageCache
-
-    create <- liftIO $ cache `isOlderThan` pkgdb
-    when create $ (liftIO . writeSymbolCache cache) =<< getGlobalSymbolTable
+dumpSymbol dir = do
+  crdl <- cradle
+  runGmPkgGhc $ do
+    create <- liftIO $ isOlderThan cache =<< timedPackageCaches crdl
+    when create $
+      liftIO . writeSymbolCache cache =<< getGlobalSymbolTable
     return $ unlines [cache]
+  where
+    cache = dir </> symbolCacheFile
 
 writeSymbolCache :: FilePath
                  -> [(Symbol,[ModuleString])]
@@ -117,15 +119,16 @@ writeSymbolCache cache sm =
   void . withFile cache WriteMode $ \hdl ->
       mapM (hPrint hdl) sm
 
-isOlderThan :: FilePath -> FilePath -> IO Bool
-isOlderThan cache file = do
-    exist <- doesFileExist cache
-    if not exist then
-        return True
-      else do
-        tCache <- getModificationTime cache
-        tFile <- getModificationTime file
-        return $ tCache <= tFile -- including equal just in case
+-- | Check whether given file is older than any file from the given set.
+-- Returns True if given file does not exist.
+isOlderThan :: FilePath -> [TimedFile] -> IO Bool
+isOlderThan cache files = do
+  exist <- doesFileExist cache
+  if not exist
+  then return True
+  else do
+    tCache <- getModificationTime cache
+    return $ any (tCache <=) $ map tfTime files -- including equal just in case
 
 -- | Browsing all functions in all system modules.
 getGlobalSymbolTable :: LightGhc [(Symbol,[ModuleString])]
diff --git a/src/Misc.hs b/src/Misc.hs
index f7f622e..2c646c6 100644
--- a/src/Misc.hs
+++ b/src/Misc.hs
@@ -75,7 +75,7 @@ getDb (SymDbReq ref _) = do
 
 checkDb :: IOish m => SymDbReq -> SymbolDb -> GhcModT m SymbolDb
 checkDb (SymDbReq ref act) db = do
-    outdated <- liftIO $ isOutdated db
+    outdated <- isOutdated db
     if outdated then do
         -- async and wait here is unnecessary because this is essentially
         -- synchronous. But Async can be used a cache.