moving PackageDb stuff to GhcPkg.

Language/Haskell/GhcMod/Find.hs

@@ -15,23 +15,20 @@ module Language.Haskell.GhcMod.Find
 #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.Directory (doesFileExist, getModificationTime)
 import System.FilePath ((</>), takeDirectory)
 import System.IO
 import System.Environment
@@ -73,12 +70,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'\]
@@ -137,20 +128,15 @@ ghcModExecutable = do _ <- getExecutablePath' -- get rid of unused warning when
 ----------------------------------------------------------------
 -- 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
+    dflags <- G.getSessionDynFlags
+    dir <- liftIO $ getPackageCachePath crdl dflags
     let cache = dir </> symbolCache
         pkgdb = dir </> packageCache
 
@@ -202,16 +188,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

Language/Haskell/GhcMod/GhcPkg.hs

@@ -8,9 +8,12 @@ module Language.Haskell.GhcMod.GhcPkg (
   , fromInstalledPackageId'
   , getSandboxDb
   , getPackageDbStack
+  , getPackageCachePath
+  , packageCache
+  , packageConfDir
   ) where
 
-import Config (cProjectVersionInt)
+import Config (cProjectVersion, cTargetPlatformString, cProjectVersionInt)
 import Control.Applicative ((<$>))
 import Control.Exception (SomeException(..))
 import qualified Control.Exception as E
@@ -18,8 +21,11 @@ import Data.Char (isSpace)
 import Data.List (isPrefixOf, intercalate)
 import Data.List.Split (splitOn)
 import Distribution.Package (InstalledPackageId(..))
+import DynFlags (DynFlags(..), systemPackageConfig)
+import Exception (handleIO)
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
+import System.Directory (doesDirectoryExist, getAppUserDataDirectory)
 import System.FilePath ((</>))
 
 ghcVersion :: Int
@@ -46,6 +52,8 @@ getSandboxDbDir sconf = do
     parse = head . filter (key `isPrefixOf`) . lines
     extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop keyLen
 
+----------------------------------------------------------------
+
 getPackageDbStack :: FilePath -- ^ Project Directory (where the
                                  -- cabal.sandbox.config file would be if it
                                  -- exists)
@@ -54,6 +62,8 @@ getPackageDbStack cdir =
     (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db])
       `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb]
 
+----------------------------------------------------------------
+
 fromInstalledPackageId' :: InstalledPackageId -> Maybe Package
 fromInstalledPackageId' pid = let
     InstalledPackageId pkg = pid
@@ -68,6 +78,8 @@ fromInstalledPackageId pid =
       Nothing -> error $
         "fromInstalledPackageId: `"++show pid++"' is not a valid package-id"
 
+----------------------------------------------------------------
+
 -- | Get options needed to add a list of package dbs to ghc-pkg's db stack
 ghcPkgDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
                   -> [String]
@@ -78,6 +90,8 @@ ghcDbStackOpts :: [GhcPkgDb] -- ^ Package db stack
                -> [String]
 ghcDbStackOpts dbs = ghcDbOpt `concatMap` dbs
 
+----------------------------------------------------------------
+
 ghcPkgDbOpt :: GhcPkgDb -> [String]
 ghcPkgDbOpt GlobalDb = ["--global"]
 ghcPkgDbOpt UserDb   = ["--user"]
@@ -95,3 +109,31 @@ ghcDbOpt UserDb
 ghcDbOpt (PackageDb pkgDb)
   | ghcVersion < 706 = ["-no-user-package-conf", "-package-conf", pkgDb]
   | otherwise        = ["-no-user-package-db",   "-package-db",   pkgDb]
+
+----------------------------------------------------------------
+
+packageCache :: String
+packageCache = "package.cache"
+
+packageConfDir :: String
+packageConfDir = "package.conf.d"
+
+-- fixme: error handling
+getPackageCachePath :: Cradle -> DynFlags -> IO FilePath
+getPackageCachePath crdl df = do
+    let u:_ = filter (/= GlobalDb) $ cradlePkgDbStack crdl
+    Just db <- resolvePath df u
+    return db
+
+--- Copied from ghc module `Packages' unfortunately it's not exported :/
+resolvePath :: DynFlags -> GhcPkgDb -> IO (Maybe FilePath)
+resolvePath df GlobalDb         = return $ Just (systemPackageConfig df)
+resolvePath _  (PackageDb name) = return $ Just name
+resolvePath _  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