hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix ghc-modi not working in non-cabal projects

Browse Source
This commit is contained in:
Daniel Gröber 2015-08-12 09:04:35 +02:00
parent 9b286cc4e1
commit a94d8977a9
2 changed files with 20 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
Language/Haskell/GhcMod/GhcPkg.hs
View File

@ -19,6 +19,7 @@ import Prelude
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.CabalHelper import Language.Haskell.GhcMod.CabalHelper
import Language.Haskell.GhcMod.PathsAndFiles
ghcVersion :: Int ghcVersion :: Int
ghcVersion = read cProjectVersionInt ghcVersion = read cProjectVersionInt
@ -59,7 +60,16 @@ ghcDbOpt (PackageDb pkgDb)
getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath] getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath]
getPackageCachePaths sysPkgCfg = do getPackageCachePaths sysPkgCfg = do
pkgDbStack <- getPackageDbStack crdl <- cradle
pkgDbStack <- if isJust $ cradleCabalFile crdl
then do
getPackageDbStack
else do
mdb <- liftIO $ getSandboxDb $ cradleRootDir crdl
return $ case mdb of
Just db -> [db]
Nothing -> [GlobalDb, UserDb]
catMaybes <$> (liftIO . resolvePackageConfig sysPkgCfg) `mapM` pkgDbStack catMaybes <$> (liftIO . resolvePackageConfig sysPkgCfg) `mapM` pkgDbStack
-- TODO: use PkgConfRef -- TODO: use PkgConfRef

20
Language/Haskell/GhcMod/PathsAndFiles.hs
View File

@ -29,7 +29,7 @@ import Data.Traversable hiding (mapM)
import Distribution.Helper (buildPlatform) import Distribution.Helper (buildPlatform)
import System.Directory import System.Directory
import System.FilePath import System.FilePath
import System.IO.Unsafe import System.Process
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Error
@ -78,13 +78,14 @@ getSandboxDb :: FilePath
-> IO (Maybe GhcPkgDb) -> IO (Maybe GhcPkgDb)
getSandboxDb d = do getSandboxDb d = do
mConf <- traverse readFile =<< mightExist (d </> "cabal.sandbox.config") mConf <- traverse readFile =<< mightExist (d </> "cabal.sandbox.config")
return $ PackageDb . fixPkgDbVer <$> (extractSandboxDbDir =<< mConf) bp <- buildPlatform readProcess
return $ PackageDb . fixPkgDbVer bp <$> (extractSandboxDbDir =<< mConf)
where where
fixPkgDbVer dir = fixPkgDbVer bp dir =
case takeFileName dir == ghcSandboxPkgDbDir of case takeFileName dir == ghcSandboxPkgDbDir bp of
True -> dir True -> dir
False -> takeDirectory dir </> ghcSandboxPkgDbDir False -> takeDirectory dir </> ghcSandboxPkgDbDir bp
-- | Extract the sandbox package db directory from the cabal.sandbox.config -- | Extract the sandbox package db directory from the cabal.sandbox.config
-- file. Exception is thrown if the sandbox config file is broken. -- file. Exception is thrown if the sandbox config file is broken.
@ -190,12 +191,9 @@ setupConfigPath = "dist/setup-config" -- localBuildInfoFile defaultDistPref
macrosHeaderPath :: FilePath macrosHeaderPath :: FilePath
macrosHeaderPath = "dist/build/autogen/cabal_macros.h" macrosHeaderPath = "dist/build/autogen/cabal_macros.h"
ghcSandboxPkgDbDir :: String ghcSandboxPkgDbDir :: String -> String
ghcSandboxPkgDbDir = ghcSandboxPkgDbDir buildPlatf = do
cabalBuildPlatform ++ "-ghc-" ++ cProjectVersion ++ "-packages.conf.d" buildPlatf ++ "-ghc-" ++ cProjectVersion ++ "-packages.conf.d"
cabalBuildPlatform :: String
cabalBuildPlatform = unsafePerformIO $ buildPlatform
packageCache :: String packageCache :: String
packageCache = "package.cache" packageCache = "package.cache"