diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs index d5a1f3f..a8a5ec7 100644 --- a/Language/Haskell/GhcMod/CabalHelper.hs +++ b/Language/Haskell/GhcMod/CabalHelper.hs @@ -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 diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index 8aca44a..7784631 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -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 diff --git a/Language/Haskell/GhcMod/PathsAndFiles.hs b/Language/Haskell/GhcMod/PathsAndFiles.hs index 32938d6..0dcc6f8 100644 --- a/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/Language/Haskell/GhcMod/PathsAndFiles.hs @@ -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 diff --git a/README.md b/README.md index 2065673..3eb99f4 100644 --- a/README.md +++ b/README.md @@ -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 diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index f39f277..97fc81d 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -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"] diff --git a/test/data/custom-cradle/dummy.cabal b/test/data/custom-cradle/dummy.cabal new file mode 100644 index 0000000..421376d --- /dev/null +++ b/test/data/custom-cradle/dummy.cabal @@ -0,0 +1 @@ +dummy diff --git a/test/data/custom-cradle/ghc-mod.cradle b/test/data/custom-cradle/ghc-mod.cradle new file mode 100644 index 0000000..38259f1 --- /dev/null +++ b/test/data/custom-cradle/ghc-mod.cradle @@ -0,0 +1,5 @@ +a/packages +global +b/packages +user +c/packages