Merge remote-tracking branch 'prezi/master'

Conflicts:
	Language/Haskell/GhcMod/CabalHelper.hs
This commit is contained in:
Daniel Gröber 2015-05-20 11:37:17 +02:00
commit a2abad53ac
7 changed files with 70 additions and 3 deletions

View File

@ -102,13 +102,20 @@ withCabal action = do
opts <- options
liftIO $ whenM (isSetupConfigOutOfDate <$> getCurrentWorld crdl) $
withDirectory_ (cradleRootDir crdl) $ do
let progOpts =
let pkgDbArgs = "--package-db=clear" : map pkgDbArg (cradlePkgDbStack crdl)
progOpts =
[ "--with-ghc=" ++ T.ghcProgram opts ]
-- Only pass ghc-pkg if it was actually set otherwise we
-- might break cabal's guessing logic
++ if T.ghcPkgProgram opts /= T.ghcPkgProgram defaultOptions
then [ "--with-ghc-pkg=" ++ T.ghcPkgProgram opts ]
else []
++ pkgDbArgs
void $ readProcess (T.cabalProgram opts) ("configure":progOpts) ""
writeAutogenFiles $ cradleRootDir crdl </> "dist"
action
pkgDbArg :: GhcPkgDb -> String
pkgDbArg GlobalDb = "--package-db=global"
pkgDbArg UserDb = "--package-db=user"
pkgDbArg (PackageDb p) = "--package-db=" ++ p

View File

@ -28,7 +28,7 @@ findCradle = findCradle' =<< getCurrentDirectory
findCradle' :: FilePath -> IO Cradle
findCradle' dir = run $ do
(cabalCradle dir `mplus` sandboxCradle dir `mplus` plainCradle dir)
(customCradle dir `mplus` cabalCradle dir `mplus` sandboxCradle dir `mplus` plainCradle dir)
where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
findSpecCradle :: FilePath -> IO Cradle
@ -52,6 +52,21 @@ fillTempDir crdl = do
tmpDir <- liftIO $ newTempDir (cradleRootDir crdl)
return crdl { cradleTempDir = tmpDir }
customCradle :: FilePath -> MaybeT IO Cradle
customCradle wdir = do
cabalFile <- MaybeT $ findCabalFile wdir
let cabalDir = takeDirectory cabalFile
cradleFile <- MaybeT $ findCradleFile cabalDir
tmpDir <- liftIO $ newTempDir cabalDir
pkgDbStack <- liftIO $ parseCradle cradleFile
return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = cabalDir
, cradleTempDir = tmpDir
, cradleCabalFile = Just cabalFile
, cradlePkgDbStack = pkgDbStack
}
cabalCradle :: FilePath -> MaybeT IO Cradle
cabalCradle wdir = do
cabalFile <- MaybeT $ findCabalFile wdir
@ -95,3 +110,14 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the
-> IO [GhcPkgDb]
getPackageDbStack cdir =
([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir
parseCradle :: FilePath -> IO [GhcPkgDb]
parseCradle path = do
source <- readFile path
return $ parseCradle' source
where
parseCradle' source = map parsePkgDb $ filter (not . null) $ lines source
parsePkgDb "global" = GlobalDb
parsePkgDb "user" = UserDb
parsePkgDb s = PackageDb s

View File

@ -35,6 +35,7 @@ import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Error
import Language.Haskell.GhcMod.Caching
import qualified Language.Haskell.GhcMod.Utils as U
import Utils (mightExist)
-- | Guaranteed to be a path to a directory with no trailing slash.
type DirPath = FilePath
@ -193,7 +194,6 @@ cabalBuildPlatform = unsafePerformIO $ buildPlatform
packageCache :: String
packageCache = "package.cache"
-- | Filename of the symbol table cache file.
symbolCache :: Cradle -> FilePath
symbolCache crdl = cradleTempDir crdl </> symbolCacheFile
@ -206,3 +206,10 @@ resolvedComponentsCacheFile = setupConfigPath <.> "ghc-mod.resolved-components"
cabalHelperCacheFile :: String
cabalHelperCacheFile = setupConfigPath <.> "ghc-mod.cabal-helper"
-- | @findCradleFile dir@. Searches for a @.ghc-mod.cradle@ file in @dir@.
-- If it exists in the given directory it is returned otherwise @findCradleFile@ returns @Nothing@
findCradleFile :: FilePath -> IO (Maybe FilePath)
findCradleFile directory = do
let path = directory </> "ghc-mod.cradle"
mightExist path

View File

@ -44,6 +44,19 @@ Make sure you're not using the MELPA version of `ghc.el` otherwise you might get
all sorts of nasty conflicts.
## Custom ghc-mod cradle
To customize the package databases used by `ghc-mod`, put a file called `ghc-mod.cradle` beside the `.cabal` file with the following syntax:
```
temp directory root
package db 1
...
package db n
```
each package database line is either a *path* to a package database, or `global` or `user`.
## IRC
If you have any problems, suggestions, comments swing by

View File

@ -72,3 +72,11 @@ spec = do
Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
cradlePkgDbStack res `shouldBe` [GlobalDb, UserDb]
it "uses the custom cradle file if present" $ do
withDirectory "test/data/custom-cradle" $ \dir -> do
res <- relativeCradle dir <$> findCradle
cradleCurrentDir res `shouldBe` "test" </> "data" </> "custom-cradle"
cradleRootDir res `shouldBe` "test" </> "data" </> "custom-cradle"
cradleCabalFile res `shouldBe` Just ("test" </> "data" </> "custom-cradle" </> "dummy.cabal")
cradlePkgDbStack res `shouldBe` [PackageDb "a/packages", GlobalDb, PackageDb "b/packages", UserDb, PackageDb "c/packages"]

View File

@ -0,0 +1 @@
dummy

View File

@ -0,0 +1,5 @@
a/packages
global
b/packages
user
c/packages