Merge remote-tracking branch 'upstream/no-set'

Conflicts:
	Language/Haskell/GhcMod/Find.hs

Language/Haskell/GhcMod/Find.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, BangPatterns #-}
 
 module Language.Haskell.GhcMod.Find
 #ifndef SPEC
@@ -10,28 +10,26 @@ module Language.Haskell.GhcMod.Find
   , dumpSymbol
   , findSymbol
   , lookupSym
+  , isOutdated
   )
 #endif
   where
 
-import Config (cProjectVersion,cTargetPlatformString)
 import Control.Applicative ((<$>))
 import Control.Monad (when, void)
 import Control.Monad.Error.Class
 import Data.Function (on)
 import Data.List (groupBy, sort)
-import Data.List.Split (splitOn)
 import Data.Maybe (fromMaybe)
-import DynFlags (DynFlags(..), systemPackageConfig)
-import Exception (handleIO)
 import qualified GHC as G
 import Language.Haskell.GhcMod.Convert
+import Language.Haskell.GhcMod.GhcPkg
 import Language.Haskell.GhcMod.Monad
-import Language.Haskell.GhcMod.Utils
 import Language.Haskell.GhcMod.Types
+import Language.Haskell.GhcMod.Utils
 import Name (getOccString)
-import System.Directory (doesDirectoryExist, getAppUserDataDirectory, doesFileExist, getModificationTime)
-import System.FilePath ((</>))
+import System.Directory (doesFileExist, getModificationTime)
+import System.FilePath ((</>), takeDirectory)
 import System.IO
 
 #ifndef MIN_VERSION_containers
@@ -51,8 +49,14 @@ import qualified Data.Map as M
 -- | Type of function and operation names.
 type Symbol = String
 -- | Database from 'Symbol' to \['ModuleString'\].
-newtype SymbolDb = SymbolDb (Map Symbol [ModuleString])
-    deriving (Show)
+data SymbolDb = SymbolDb {
+    table :: Map Symbol [ModuleString]
+  , packageCachePath :: FilePath
+  , symbolDbCachePath :: FilePath
+  } deriving (Show)
+
+isOutdated :: SymbolDb -> IO Bool
+isOutdated db = symbolDbCachePath db `isOlderThan` packageCachePath db
 
 ----------------------------------------------------------------
 
@@ -65,12 +69,6 @@ symbolCacheVersion = 0
 symbolCache :: String
 symbolCache = "ghc-mod-"++ show symbolCacheVersion ++".cache"
 
-packageCache :: String
-packageCache = "package.cache"
-
-packageConfDir :: String
-packageConfDir = "package.conf.d"
-
 ----------------------------------------------------------------
 
 -- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\]
@@ -84,19 +82,21 @@ lookupSymbol :: IOish m => Symbol -> SymbolDb -> GhcModT m String
 lookupSymbol sym db = convert' $ lookupSym sym db
 
 lookupSym :: Symbol -> SymbolDb -> [ModuleString]
-lookupSym sym (SymbolDb db) = fromMaybe [] $ M.lookup sym db
+lookupSym sym db = fromMaybe [] $ M.lookup sym $ table db
 
 ---------------------------------------------------------------
 
 -- | Loading a file and creates 'SymbolDb'.
 loadSymbolDb :: (IOish m, MonadError GhcModError m) => m SymbolDb
-loadSymbolDb = SymbolDb <$> readSymbolDb
-
-readSymbolDb :: (IOish m, MonadError GhcModError m) => m (Map Symbol [ModuleString])
-readSymbolDb = do
+loadSymbolDb = do
     ghcMod <- liftIO ghcModExecutable
     file <- chop <$> readProcess' ghcMod ["dumpsym"]
-    M.fromAscList . map conv . lines <$> liftIO (readFile file)
+    !db <- M.fromAscList . map conv . lines <$> liftIO (readFile file)
+    return $ SymbolDb {
+        table = db
+      , packageCachePath = takeDirectory file </> packageCache
+      , symbolDbCachePath = file
+      }
   where
     conv :: String -> (Symbol,[ModuleString])
     conv = read
@@ -106,24 +106,18 @@ readSymbolDb = do
 ----------------------------------------------------------------
 -- used 'ghc-mod dumpsym'
 
-getSymbolCachePath :: IOish m => GhcModT m FilePath
-getSymbolCachePath = do
-    u:_ <- filter (/= GlobalDb) . cradlePkgDbStack <$> cradle
-    Just db <- (liftIO . flip resolvePackageDb u) =<< G.getSessionDynFlags
-    return db
-  `catchError` const (fail "Couldn't find non-global package database for symbol cache")
-
 -- | Dumping a set of ('Symbol',\['ModuleString'\]) to a file
 --   if the file does not exist or is invalid.
 --   The file name is printed.
 
 dumpSymbol :: IOish m => GhcModT m String
 dumpSymbol = do
-    dir <- getSymbolCachePath
+    crdl <- cradle
+    dir <- liftIO $ getPackageCachePath crdl
     let cache = dir </> symbolCache
         pkgdb = dir </> packageCache
 
-    create <- liftIO $ cache `isNewerThan` pkgdb
+    create <- liftIO $ cache `isOlderThan` pkgdb
     when create $ (liftIO . writeSymbolCache cache) =<< getSymbolTable
     return $ unlines [cache]
 
@@ -134,15 +128,15 @@ writeSymbolCache cache sm =
   void . withFile cache WriteMode $ \hdl ->
       mapM (hPrint hdl) sm
 
-isNewerThan :: FilePath -> FilePath -> IO Bool
-isNewerThan ref file = do
-    exist <- doesFileExist ref
+isOlderThan :: FilePath -> FilePath -> IO Bool
+isOlderThan cache file = do
+    exist <- doesFileExist cache
     if not exist then
         return True
       else do
-        tRef <- getModificationTime ref
+        tCache <- getModificationTime cache
         tFile <- getModificationTime file
-        return $ tRef <= tFile -- including equal just in case
+        return $ tCache <= tFile -- including equal just in case
 
 -- | Browsing all functions in all system/user modules.
 getSymbolTable :: IOish m => GhcModT m [(Symbol,[ModuleString])]
@@ -171,16 +165,3 @@ collectModules :: [(Symbol,ModuleString)]
 collectModules = map tieup . groupBy ((==) `on` fst) . sort
   where
     tieup x = (head (map fst x), map snd x)
-
---- Copied from ghc module `Packages' unfortunately it's not exported :/
-resolvePackageDb :: DynFlags -> GhcPkgDb -> IO (Maybe FilePath)
-resolvePackageDb df GlobalDb         = return $ Just (systemPackageConfig df)
-resolvePackageDb _  (PackageDb name) = return $ Just name
-resolvePackageDb _  UserDb           = handleIO (\_ -> return Nothing) $ do
-    appdir <- getAppUserDataDirectory "ghc"
-    let dir = appdir </> (target_arch ++ '-':target_os ++ '-':cProjectVersion)
-        pkgconf = dir </> packageConfDir
-    exist <- doesDirectoryExist pkgconf
-    return $ if exist then Just pkgconf else Nothing
-  where
-    [target_arch,_,target_os] = splitOn "-" cTargetPlatformString