diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index 8fec598..766c9af 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -40,15 +40,15 @@ import System.FilePath (dropExtension, takeFileName, ()) -- | Getting necessary 'CompilerOptions' from three information sources. getCompilerOptions :: [GHCOption] -> Cradle -> PackageDescription -> IO CompilerOptions getCompilerOptions ghcopts cradle pkgDesc = do - gopts <- getGHCOptions ghcopts cradle cdir $ head buildInfos + gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos return $ CompilerOptions gopts idirs depPkgs where wdir = cradleCurrentDir cradle - Just cdir = cradleCabalDir cradle + rdir = cradleRootDir cradle Just cfile = cradleCabalFile cradle pkgs = cradlePackages cradle buildInfos = cabalAllBuildInfo pkgDesc - idirs = includeDirectories cdir wdir $ cabalSourceDirs buildInfos + idirs = includeDirectories rdir wdir $ cabalSourceDirs buildInfos depPkgs = attachPackageIds pkgs $ removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos ---------------------------------------------------------------- @@ -109,8 +109,8 @@ parseCabalFile file = do ---------------------------------------------------------------- getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption] -getGHCOptions ghcopts cradle cdir binfo = do - cabalCpp <- cabalCppOptions cdir +getGHCOptions ghcopts cradle rdir binfo = do + cabalCpp <- cabalCppOptions rdir let cpps = map ("-optP" ++) $ P.cppOptions binfo ++ cabalCpp return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps where diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index ed89fc3..e51a1b5 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -7,11 +7,13 @@ module Language.Haskell.GhcMod.Cradle ( , getPackageDbPackages , userPackageDbOptsForGhc , userPackageDbOptsForGhcPkg + , getSandboxDir ) where import Control.Applicative ((<$>)) import Control.Exception (SomeException(..)) import qualified Control.Exception as E +import Control.Exception.IOChoice ((||>)) import Control.Monad (filterM) import Data.Char (isSpace) import Data.List (isPrefixOf, isSuffixOf, tails) @@ -28,29 +30,41 @@ import System.FilePath ((), takeDirectory, takeFileName) findCradle :: IO Cradle findCradle = do wdir <- getCurrentDirectory - findCradle' wdir `E.catch` handler wdir - where - handler :: FilePath -> SomeException -> IO Cradle - handler wdir _ = return Cradle { + cabalCradle wdir ||> sandboxCradle wdir ||> plainCradle wdir + +cabalCradle :: FilePath -> IO Cradle +cabalCradle wdir = do + (rdir,cfile) <- cabalDir wdir + pkgDbOpts <- getPackageDb rdir + return Cradle { cradleCurrentDir = wdir - , cradleCabalDir = Nothing - , cradleCabalFile = Nothing - , cradlePackageDb = Nothing + , cradleRootDir = rdir + , cradleCabalFile = Just cfile + , cradlePackageDb = pkgDbOpts , cradlePackages = [] } -findCradle' :: FilePath -> IO Cradle -findCradle' wdir = do - (cdir,cfile) <- cabalDir wdir - pkgDbOpts <- getPackageDb cdir +sandboxCradle :: FilePath -> IO Cradle +sandboxCradle wdir = do + rdir <- getSandboxDir wdir + pkgDbOpts <- getPackageDb rdir return Cradle { cradleCurrentDir = wdir - , cradleCabalDir = Just cdir - , cradleCabalFile = Just cfile + , cradleRootDir = rdir + , cradleCabalFile = Nothing , cradlePackageDb = pkgDbOpts , cradlePackages = [] } +plainCradle :: FilePath -> IO Cradle +plainCradle wdir = return Cradle { + cradleCurrentDir = wdir + , cradleRootDir = wdir + , cradleCabalFile = Nothing + , cradlePackageDb = Nothing + , cradlePackages = [] + } + -- Just for testing findCradleWithoutSandbox :: IO Cradle findCradleWithoutSandbox = do @@ -203,3 +217,16 @@ nameKeyLength = length nameKey idKeyLength :: Int idKeyLength = length idKey + +getSandboxDir :: FilePath -> IO FilePath +getSandboxDir dir = do + exist <- doesFileExist sfile + if exist then + return dir + else if dir == dir' then + E.throwIO $ userError "sandbox not found" + else + getSandboxDir dir' + where + sfile = dir configFile + dir' = takeDirectory dir diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index 4e84c64..fa7139f 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -44,8 +44,7 @@ debug opt cradle fileName = do where currentDir = cradleCurrentDir cradle mCabalFile = cradleCabalFile cradle - mCabalDir = cradleCabalDir cradle - rootDir = fromMaybe currentDir mCabalDir + rootDir = cradleRootDir cradle cabal = isJust mCabalFile cabalFile = fromMaybe "" mCabalFile origGopts = ghcOpts opt @@ -68,8 +67,4 @@ root :: Options -> Cradle -> FilePath -- ^ A target file. -> Ghc String -root _ cradle _ = return $ rootDir ++ "\n" - where - currentDir = cradleCurrentDir cradle - mCabalDir = cradleCabalDir cradle - rootDir = fromMaybe currentDir mCabalDir +root _ cradle _ = return $ cradleRootDir cradle ++ "\n" diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs index 34ba110..f4dcb1e 100644 --- a/Language/Haskell/GhcMod/GHCApi.hs +++ b/Language/Haskell/GhcMod/GHCApi.hs @@ -21,6 +21,7 @@ import Exception (ghandle, SomeException(..)) import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..)) import qualified GHC as G import Language.Haskell.GhcMod.CabalApi +import Language.Haskell.GhcMod.Cradle (userPackageDbOptsForGhc) import Language.Haskell.GhcMod.ErrMsg import Language.Haskell.GhcMod.GHCChoice import qualified Language.Haskell.GhcMod.Gap as Gap @@ -74,8 +75,8 @@ data Build = CabalPkg | SingleFile deriving Eq -- provided. initializeFlagsWithCradle :: GhcMonad m => Options -> Cradle -> [GHCOption] -> Bool -> m (LogReader, Maybe PackageDescription) initializeFlagsWithCradle opt cradle ghcopts logging - | cabal = withCabal |||> withoutCabal - | otherwise = withoutCabal + | cabal = withCabal |||> withSandbox + | otherwise = withSandbox where mCradleFile = cradleCabalFile cradle cabal = isJust mCradleFile @@ -84,11 +85,16 @@ initializeFlagsWithCradle opt cradle ghcopts logging compOpts <- liftIO $ getCompilerOptions ghcopts cradle pkgDesc logger <- initSession CabalPkg opt compOpts logging return (logger, Just pkgDesc) - withoutCabal = do + withSandbox = do logger <- initSession SingleFile opt compOpts logging return (logger, Nothing) where - compOpts = CompilerOptions ghcopts importDirs [] + pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle + compOpts + | pkgDb == [] = CompilerOptions ghcopts importDirs [] + | otherwise = CompilerOptions (ghcopts ++ pkgDb) [wdir,rdir] [] + wdir = cradleCurrentDir cradle + rdir = cradleRootDir cradle ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 001ef5a..10f2a92 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -83,15 +83,15 @@ addNewLine = (++ "\n") -- | The environment where this library is used. data Cradle = Cradle { -- | The directory where this library is executed. - cradleCurrentDir :: FilePath - -- | The directory where a cabal file is found. - , cradleCabalDir :: Maybe FilePath + cradleCurrentDir :: FilePath + -- | The project root directory. + , cradleRootDir :: FilePath -- | The file name of the found cabal file. - , cradleCabalFile :: Maybe FilePath + , cradleCabalFile :: Maybe FilePath -- | User package db. (\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\") - , cradlePackageDb :: Maybe FilePath + , cradlePackageDb :: Maybe FilePath -- | Dependent packages. - , cradlePackages :: [Package] + , cradlePackages :: [Package] } deriving (Eq, Show) ---------------------------------------------------------------- diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index 13cf55f..a7cc247 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -19,7 +19,7 @@ spec = do res <- findCradle res `shouldBe` Cradle { cradleCurrentDir = curDir - , cradleCabalDir = Nothing + , cradleRootDir = curDir , cradleCabalFile = Nothing , cradlePackageDb = Nothing , cradlePackages = [] @@ -29,7 +29,7 @@ spec = do res <- relativeCradle dir <$> findCradle res `shouldBe` Cradle { cradleCurrentDir = "test" "data" "subdir1" "subdir2" - , cradleCabalDir = Just ("test" "data") + , cradleRootDir = "test" "data" , cradleCabalFile = Just ("test" "data" "cabalapi.cabal") , cradlePackageDb = Just ("test" "data" ".cabal-sandbox" "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d") , cradlePackages = [] @@ -39,7 +39,7 @@ spec = do res <- relativeCradle dir <$> findCradle res `shouldBe` Cradle { cradleCurrentDir = "test" "data" "broken-sandbox" - , cradleCabalDir = Just ("test" "data" "broken-sandbox") + , cradleRootDir = "test" "data" "broken-sandbox" , cradleCabalFile = Just ("test" "data" "broken-sandbox" "dummy.cabal") , cradlePackageDb = Nothing , cradlePackages = [] @@ -60,9 +60,9 @@ spec = do relativeCradle :: FilePath -> Cradle -> Cradle relativeCradle dir cradle = cradle { - cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle - , cradleCabalDir = toRelativeDir dir <$> cradleCabalDir cradle - , cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle + cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle + , cradleRootDir = toRelativeDir dir $ cradleRootDir cradle + , cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle } -- Work around GHC 7.2.2 where `canonicalizePath "/"` returns "/.".