diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs index b229a2a..1ea7a55 100644 --- a/Language/Haskell/GhcMod/CabalHelper.hs +++ b/Language/Haskell/GhcMod/CabalHelper.hs @@ -95,20 +95,26 @@ cabalHelperCache = Cached { , a == a' ] - withCabal :: (MonadIO m, GmEnv m) => m a -> m a withCabal action = do crdl <- cradle 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..e0a691a 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,21 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the -> IO [GhcPkgDb] getPackageDbStack cdir = ([GlobalDb] ++) . maybe [UserDb] return <$> getSandboxDb cdir + +-- Just for testing +findCradleWithoutSandbox :: IO Cradle +findCradleWithoutSandbox = do + cradle <- findCradle + return cradle { cradlePkgDbStack = [GlobalDb]} -- FIXME + + +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..00ad384 100644 --- a/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/Language/Haskell/GhcMod/PathsAndFiles.hs @@ -193,7 +193,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 +205,13 @@ 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" + exists <- doesFileExist $ path + case exists of + True -> return $ Just path + False -> return Nothing diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 54a1c44..84385a1 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -272,7 +272,7 @@ data GhcModError | GMECabalStateFile GMConfigStateFileError -- ^ Reading Cabal's state configuration file falied somehow. - deriving (Eq,Show,Typeable) + deriving (Eq,Show,Typeable) instance Error GhcModError where noMsg = GMENoMsg diff --git a/README.md b/README.md index 2065673..74aa472 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..8e7f733 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -71,4 +71,11 @@ spec = do cradleCabalFile res `shouldBe` Just ("test" "data" "broken-sandbox" "dummy.cabal") + 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"] cradlePkgDbStack res `shouldBe` [GlobalDb, UserDb] 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 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