Merge pull request #249 from DanielG/dev-cabal1.16

Fix reading setup-config with Cabal <= 1.16
This commit is contained in:
Kazu Yamamoto 2014-05-10 07:14:47 +09:00
commit 4ec7a5e505
12 changed files with 195 additions and 119 deletions

View File

@ -0,0 +1,13 @@
-- | ComponentLocalBuildInfo for Cabal <= 1.16
module Language.Haskell.GhcMod.Cabal16 (
ComponentLocalBuildInfo
, componentPackageDeps
) where
import Distribution.Package (InstalledPackageId, PackageIdentifier)
-- From Cabal <= 1.16
data ComponentLocalBuildInfo = ComponentLocalBuildInfo {
componentPackageDeps :: [(InstalledPackageId, PackageIdentifier)]
}
deriving (Read, Show)

View File

@ -0,0 +1,7 @@
-- | ComponentLocalBuildInfo for Cabal >= 1.18
module Language.Haskell.GhcMod.Cabal18 (
ComponentLocalBuildInfo
, componentPackageDeps
) where
import Distribution.Simple.LocalBuildInfo (ComponentLocalBuildInfo(..))

View File

@ -7,28 +7,22 @@ module Language.Haskell.GhcMod.CabalApi (
, cabalDependPackages , cabalDependPackages
, cabalSourceDirs , cabalSourceDirs
, cabalAllTargets , cabalAllTargets
, cabalGetConfig
, cabalConfigPath
, cabalConfigDependencies , cabalConfigDependencies
) where ) where
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.Utils import Language.Haskell.GhcMod.CabalConfig
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Exception (SomeException(..))
import qualified Control.Exception as E import qualified Control.Exception as E
import Control.Monad (filterM,mplus) import Control.Monad (filterM)
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.Maybe (maybeToList) import Data.Maybe (maybeToList)
import Data.Set (fromList, toList) import Data.Set (fromList, toList)
import Data.List (find,tails,isPrefixOf,nub,stripPrefix)
import Distribution.ModuleName (ModuleName,toFilePath) import Distribution.ModuleName (ModuleName,toFilePath)
import Distribution.Package (Dependency(Dependency) import Distribution.Package (Dependency(Dependency)
, PackageName(PackageName) , PackageName(PackageName))
, InstalledPackageId(..)
, PackageIdentifier)
import qualified Distribution.Package as C import qualified Distribution.Package as C
import Distribution.PackageDescription (PackageDescription, BuildInfo, TestSuite, TestSuiteInterface(..), Executable) import Distribution.PackageDescription (PackageDescription, BuildInfo, TestSuite, TestSuiteInterface(..), Executable)
import qualified Distribution.PackageDescription as P import qualified Distribution.PackageDescription as P
@ -37,9 +31,6 @@ import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..)) import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..))
import Distribution.Simple.Program (ghcProgram) import Distribution.Simple.Program (ghcProgram)
import Distribution.Simple.Program.Types (programName, programFindVersion) import Distribution.Simple.Program.Types (programName, programFindVersion)
import Distribution.Simple.BuildPaths (defaultDistPref)
import Distribution.Simple.Configure (localBuildInfoFile)
import Distribution.Simple.LocalBuildInfo (ComponentLocalBuildInfo(..), ComponentName)
import Distribution.System (buildPlatform) import Distribution.System (buildPlatform)
import Distribution.Text (display) import Distribution.Text (display)
import Distribution.Verbosity (silent) import Distribution.Verbosity (silent)
@ -55,7 +46,7 @@ getCompilerOptions :: [GHCOption]
-> IO CompilerOptions -> IO CompilerOptions
getCompilerOptions ghcopts cradle pkgDesc = do getCompilerOptions ghcopts cradle pkgDesc = do
gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos
depPkgs <- cabalConfigDependencies (C.packageId pkgDesc) <$> cabalGetConfig cradle depPkgs <- cabalConfigDependencies cradle (C.packageId pkgDesc)
return $ CompilerOptions gopts idirs depPkgs return $ CompilerOptions gopts idirs depPkgs
where where
wdir = cradleCurrentDir cradle wdir = cradleCurrentDir cradle
@ -205,88 +196,3 @@ cabalAllTargets pd = do
getExecutableTarget exe = do getExecutableTarget exe = do
let maybeExes = [p </> e | p <- P.hsSourceDirs $ P.buildInfo exe, e <- [P.modulePath exe]] let maybeExes = [p </> e | p <- P.hsSourceDirs $ P.buildInfo exe, e <- [P.modulePath exe]]
liftIO $ filterM doesFileExist maybeExes liftIO $ filterM doesFileExist maybeExes
----------------------------------------------------------------
type CabalConfig = String
-- | Get file containing 'LocalBuildInfo' data. If it doesn't exist run @cabal
-- configure@ i.e. configure with default options like @cabal build@ would do.
cabalGetConfig :: Cradle -> IO CabalConfig
cabalGetConfig cradle =
readFile path `E.catch` (\(SomeException _) -> configure >> readFile path)
where
prjDir = cradleRootDir cradle
path = prjDir </> cabalConfigPath
configure =
withDirectory_ prjDir $ readProcess' "cabal" ["configure"]
-- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
cabalConfigPath :: FilePath
cabalConfigPath = localBuildInfoFile defaultDistPref
cabalConfigDependencies :: PackageIdentifier -> CabalConfig -> [Package]
cabalConfigDependencies thisPkg config = cfgDepends
where
pids :: [InstalledPackageId]
pids = let
mps = map fst <$> (components18 thisPkg `mplus` components16 thisPkg)
in case mps of
Just ps -> ps
Nothing -> errorExtract
cfgDepends = filter (("inplace" /=) . pkgId)
$ fromInstalledPackageId <$> pids
errorExtract = error $
"cabalConfigDependencies: Error extracting dependencies from setup-config"
-- Cabal 1.18
components18 :: PackageIdentifier
-> Maybe [(InstalledPackageId,PackageIdentifier)]
components18 _ =
concatMap (componentPackageDeps . lbi)
<$> extractCabalSetupConfig config "componentsConfigs"
lbi :: (ComponentName, ComponentLocalBuildInfo, [ComponentName])
-> ComponentLocalBuildInfo
lbi (_,i,_) = i
-- Cabal 1.16 and below
components16 :: PackageIdentifier
-> Maybe [(InstalledPackageId,PackageIdentifier)]
components16 thisPkg' = filter (not . internal . snd) . nub <$> do
cbi <- concat <$> sequence [ extract "executableConfigs"
, extract "testSuiteConfigs"
, extract "benchmarkConfigs" ]
:: Maybe [(String, ComponentLocalBuildInfo)]
return $ maybe [] componentPackageDeps libraryConfig
++ concatMap (componentPackageDeps . snd) cbi
where
-- True if this dependency is an internal one (depends on the library
-- defined in the same package).
internal pkgid = pkgid == thisPkg'
libraryConfig :: Maybe ComponentLocalBuildInfo
libraryConfig = do
field <- find ("libraryConfig" `isPrefixOf`) (tails config)
clbi <- stripPrefix " = " field
if "Nothing" `isPrefixOf` clbi
then Nothing
else read <$> stripPrefix "Just " clbi
extract :: Read r => String -> Maybe r
extract field = extractCabalSetupConfig config field
-- | Extract part of cabal's @setup-config@, this is done with a mix of manual
-- string processing and use of 'read'. This way we can extract a field from
-- 'LocalBuildInfo' without having to parse the whole thing which would mean
-- depending on the exact version of Cabal used to configure the project as it
-- is rather likley that some part of 'LocalBuildInfo' changed.
--
-- Right now 'extractCabalSetupConfig' can only deal with Lists and Tuples in
-- the field!
extractCabalSetupConfig :: (Read r) => CabalConfig -> String -> Maybe r
extractCabalSetupConfig config field = do
read <$> extractParens <$> find (field `isPrefixOf`) (tails config)

View File

@ -0,0 +1,119 @@
-- | Reading cabal @dist/setup-config@
module Language.Haskell.GhcMod.CabalConfig (
CabalConfig
, cabalConfigDependencies
) where
import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.Utils
import Language.Haskell.GhcMod.Types
import qualified Language.Haskell.GhcMod.Cabal16 as C16
import qualified Language.Haskell.GhcMod.Cabal18 as C18
import qualified Control.Exception as E
import Control.Applicative ((<$>))
import Control.Monad (mplus)
import Control.Monad.Error ()
import Data.Maybe ()
import Data.Set ()
import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix)
import Distribution.Package (InstalledPackageId(..)
, PackageIdentifier)
import Distribution.Simple.BuildPaths (defaultDistPref)
import Distribution.Simple.Configure (localBuildInfoFile)
import Distribution.Simple.LocalBuildInfo (ComponentName)
import System.FilePath ((</>))
import Text.Read (readMaybe)
----------------------------------------------------------------
type CabalConfig = String
-- | Get file containing 'LocalBuildInfo' data. If it doesn't exist run @cabal
-- configure@ i.e. configure with default options like @cabal build@ would do.
getConfig :: Cradle -> IO CabalConfig
getConfig cradle =
readFile path `E.catch` (\(E.SomeException _) -> configure >> readFile path)
where
prjDir = cradleRootDir cradle
path = prjDir </> configPath
configure =
withDirectory_ prjDir $ readProcess' "cabal" ["configure"]
-- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@
configPath :: FilePath
configPath = localBuildInfoFile defaultDistPref
cabalConfigDependencies :: Cradle -> PackageIdentifier -> IO [Package]
cabalConfigDependencies cradle thisPkg =
configDependencies thisPkg <$> getConfig cradle
configDependencies :: PackageIdentifier -> CabalConfig -> [Package]
configDependencies thisPkg config = map fromInstalledPackageId deps
where
deps :: [InstalledPackageId]
deps = case (deps18 `mplus` deps16) of
Right ps -> ps
Left msg -> error msg
-- True if this dependency is an internal one (depends on the library
-- defined in the same package).
internal pkgid = pkgid == thisPkg
-- Cabal >= 1.18
deps18 :: Either String [InstalledPackageId]
deps18 =
map fst
<$> filterInternal
<$> (readEither =<< extractField config "componentsConfigs")
filterInternal
:: [(ComponentName, C18.ComponentLocalBuildInfo, [ComponentName])]
-> [(InstalledPackageId, PackageIdentifier)]
filterInternal ccfg = [ (ipkgid, pkgid)
| (_,clbi,_) <- ccfg
, (ipkgid, pkgid) <- C18.componentPackageDeps clbi
, not (internal pkgid) ]
-- Cabal 1.16 and below
deps16 :: Either String [InstalledPackageId]
deps16 = map fst <$> filter (not . internal . snd) . nub <$> do
cbi <- concat <$> sequence [ extract "executableConfigs"
, extract "testSuiteConfigs"
, extract "benchmarkConfigs" ]
:: Either String [(String, C16.ComponentLocalBuildInfo)]
return $ maybe [] C16.componentPackageDeps libraryConfig
++ concatMap (C16.componentPackageDeps . snd) cbi
where
libraryConfig :: Maybe C16.ComponentLocalBuildInfo
libraryConfig = do
field <- find ("libraryConfig" `isPrefixOf`) (tails config)
clbi <- stripPrefix " = " field
if "Nothing" `isPrefixOf` clbi
then Nothing
else case readMaybe <$> stripPrefix "Just " clbi of
Just x -> x
Nothing -> error $ "reading libraryConfig failed\n" ++ show (stripPrefix "Just " clbi)
extract :: String -> Either String [(String, C16.ComponentLocalBuildInfo)]
extract field = readConfigs field <$> extractField config field
readConfigs :: String -> String -> [(String, C16.ComponentLocalBuildInfo)]
readConfigs f s = case readMaybe s of
Just x -> x
Nothing -> error $ "reading config " ++ f ++ " failed"
readEither :: Read r => String -> Either String r
readEither s = case readMaybe s of
Just x -> Right x
Nothing -> Left $ "read: failed on input:\n" ++ s
extractField :: CabalConfig -> String -> Either String String
extractField config field =
case extractParens <$> find (field `isPrefixOf`) (tails config) of
Just f -> Right f
Nothing -> Left $ "extractField: failed extracting "++field++" from input, input contained `"++field++"'? " ++ show (field `isInfixOf` config)

View File

@ -24,22 +24,18 @@ import Data.Maybe (isJust, fromJust)
import Exception (ghandle, SomeException(..)) import Exception (ghandle, SomeException(..))
import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..)) import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..))
import qualified GHC as G import qualified GHC as G
import GHC.Paths (libdir)
import qualified Language.Haskell.GhcMod.Gap as Gap import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Types
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import System.IO (hPutStr, hPrint, stderr) import System.IO (hPutStr, hPrint, stderr)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcess)
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Obtaining the directory for system libraries. -- | Obtaining the directory for system libraries.
getSystemLibDir :: IO (Maybe FilePath) getSystemLibDir :: IO (Maybe FilePath)
getSystemLibDir = do getSystemLibDir = return $ Just libdir
res <- readProcess "ghc" ["--print-libdir"] []
return $ case res of
"" -> Nothing
dirn -> Just (init dirn)
---------------------------------------------------------------- ----------------------------------------------------------------

View File

@ -1,4 +1,4 @@
{-# LANGUAGE BangPatterns, ScopedTypeVariables, TupleSections #-} {-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables, TupleSections #-}
module Language.Haskell.GhcMod.GhcPkg ( module Language.Haskell.GhcMod.GhcPkg (
ghcPkgDbOpt ghcPkgDbOpt
, ghcPkgDbStackOpts , ghcPkgDbStackOpts
@ -12,8 +12,9 @@ module Language.Haskell.GhcMod.GhcPkg (
import Config (cProjectVersionInt) import Config (cProjectVersionInt)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Exception (SomeException(..)) #if MIN_VERSION_Cabal(1,18,0)
import qualified Control.Exception as E import qualified Control.Exception as E
#endif
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.List (isPrefixOf, intercalate) import Data.List (isPrefixOf, intercalate)
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
@ -50,9 +51,14 @@ getPackageDbStack :: FilePath -- ^ Project Directory (where the
-- cabal.sandbox.config file would be if it -- cabal.sandbox.config file would be if it
-- exists) -- exists)
-> IO [GhcPkgDb] -> IO [GhcPkgDb]
#if MIN_VERSION_Cabal(1,18,0)
getPackageDbStack cdir = getPackageDbStack cdir =
(getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db]) (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db])
`E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb] `E.catch` \(_ :: E.SomeException) -> return [GlobalDb, UserDb]
#else
getPackageDbStack _ =
return [GlobalDb, UserDb]
#endif
fromInstalledPackageId' :: InstalledPackageId -> Maybe Package fromInstalledPackageId' :: InstalledPackageId -> Maybe Package
fromInstalledPackageId' pid = let fromInstalledPackageId' pid = let

View File

@ -23,11 +23,17 @@ import GhcMonad
import Exception import Exception
import MonadUtils import MonadUtils
import DynFlags import DynFlags
-- ghc <= 7.2
import Data.Monoid (Monoid)
#if !MIN_VERSION_ghc(7,4,0) #if !MIN_VERSION_ghc(7,4,0)
import HscTypes import HscTypes
#endif #endif
-- base <= 4.6
#if !MIN_VERSION_base(4,7,0)
import Data.Monoid (Monoid)
import Control.Monad.Trans.Class (lift)
#endif
import Data.IORef (IORef, readIORef, writeIORef, newIORef) import Data.IORef (IORef, readIORef, writeIORef, newIORef)
import Control.Monad (liftM) import Control.Monad (liftM)
@ -36,7 +42,6 @@ import Control.Monad.Base (MonadBase,liftBase)
import Control.Monad.Trans.RWS.Lazy (RWST(..),runRWST) import Control.Monad.Trans.RWS.Lazy (RWST(..),runRWST)
import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith
, control, liftBaseOp, liftBaseOp_) , control, liftBaseOp, liftBaseOp_)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Reader.Class import Control.Monad.Reader.Class
import Control.Monad.Writer.Class import Control.Monad.Writer.Class
import Control.Monad.State.Class import Control.Monad.State.Class

View File

@ -58,6 +58,9 @@ Library
Other-Modules: Language.Haskell.GhcMod.Boot Other-Modules: Language.Haskell.GhcMod.Boot
Language.Haskell.GhcMod.Browse Language.Haskell.GhcMod.Browse
Language.Haskell.GhcMod.CabalApi Language.Haskell.GhcMod.CabalApi
Language.Haskell.GhcMod.CabalConfig
Language.Haskell.GhcMod.Cabal16
Language.Haskell.GhcMod.Cabal18
Language.Haskell.GhcMod.Check Language.Haskell.GhcMod.Check
Language.Haskell.GhcMod.Cradle Language.Haskell.GhcMod.Cradle
Language.Haskell.GhcMod.Debug Language.Haskell.GhcMod.Debug

View File

@ -1,4 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP, ScopedTypeVariables #-}
module CabalApiSpec where module CabalApiSpec where
@ -36,9 +36,15 @@ spec = do
ghcOptions = ghcOptions res ghcOptions = ghcOptions res
, includeDirs = map (toRelativeDir dir) (includeDirs res) , includeDirs = map (toRelativeDir dir) (includeDirs res)
} }
#if MIN_VERSION_Cabal(1,18,0)
if ghcVersion < 706 if ghcVersion < 706
then ghcOptions res' `shouldContain` ["-global-package-conf", "-no-user-package-conf","-package-conf",cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"] then ghcOptions res' `shouldContain` ["-global-package-conf", "-no-user-package-conf","-package-conf",cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"]
else ghcOptions res' `shouldContain` ["-global-package-db", "-no-user-package-db","-package-db",cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"] else ghcOptions res' `shouldContain` ["-global-package-db", "-no-user-package-db","-package-db",cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"]
#else
if ghcVersion < 706
then ghcOptions res' `shouldContain` ["-global-package-conf", "-user-package-conf","-XHaskell98"]
else ghcOptions res' `shouldContain` ["-global-package-db", "-user-package-db","-XHaskell98"]
#endif
includeDirs res' `shouldBe` ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"] includeDirs res' `shouldBe` ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"]
(pkgName `map` depPackages res') `shouldContain` ["Cabal"] (pkgName `map` depPackages res') `shouldContain` ["Cabal"]
@ -60,10 +66,3 @@ spec = do
it "extracts build info" $ do it "extracts build info" $ do
info <- cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" info <- cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"
show info `shouldBe` "[BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\".\"], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]" show info `shouldBe` "[BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\".\"], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]"
describe "cabalGetConfig" $ do
it "can reconfigure a cabal package" $ do
withDirectory_ "test/data/check-test-subdir" $ do
cradle <- findCradle
cfg <- cabalGetConfig cradle
cfg `shouldSatisfy` not . null

View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
module CradleSpec where module CradleSpec where
import Control.Applicative import Control.Applicative
@ -31,7 +32,11 @@ spec = do
cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2" cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
, cradleRootDir = "test" </> "data" , cradleRootDir = "test" </> "data"
, cradleCabalFile = Just ("test" </> "data" </> "cabalapi.cabal") , cradleCabalFile = Just ("test" </> "data" </> "cabalapi.cabal")
#if MIN_VERSION_Cabal(1,18,0)
, cradlePkgDbStack = [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")] , cradlePkgDbStack = [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")]
#else
, cradlePkgDbStack = [GlobalDb, UserDb]
#endif
} }
it "works even if a sandbox config file is broken" $ do it "works even if a sandbox config file is broken" $ do
withDirectory "test/data/broken-sandbox" $ \dir -> do withDirectory "test/data/broken-sandbox" $ \dir -> do

View File

@ -1,6 +1,8 @@
{-# LANGUAGE CPP #-}
module GhcPkgSpec where module GhcPkgSpec where
import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.GhcPkg
import Language.Haskell.GhcMod.Types
import System.Directory import System.Directory
import System.FilePath ((</>)) import System.FilePath ((</>))
@ -8,7 +10,12 @@ import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do
describe "getSandboxDb" $ do describe "getPackageDbStack" $ do
#if !MIN_VERSION_Cabal(1,18,0)
it "does not include a sandbox with Cabal < 1.18" $ do
cwd <- getCurrentDirectory
getPackageDbStack cwd `shouldReturn` [GlobalDb, UserDb]
#endif
it "parses a config file and extracts sandbox package db" $ do it "parses a config file and extracts sandbox package db" $ do
cwd <- getCurrentDirectory cwd <- getCurrentDirectory
pkgDb <- getSandboxDb "test/data/" pkgDb <- getSandboxDb "test/data/"

View File

@ -1,9 +1,13 @@
{-# LANGUAGE ScopedTypeVariables #-}
import Spec import Spec
import Dir import Dir
import Test.Hspec import Test.Hspec
import System.Process import System.Process
import Language.Haskell.GhcMod (debugInfo, defaultOptions, findCradle)
import Control.Exception as E
main = do main = do
let sandboxes = [ "test/data", "test/data/check-packageid" let sandboxes = [ "test/data", "test/data/check-packageid"
, "test/data/duplicate-pkgver/" ] , "test/data/duplicate-pkgver/" ]
@ -17,4 +21,10 @@ main = do
genSandboxCfg `mapM_` sandboxes genSandboxCfg `mapM_` sandboxes
genGhcPkgCache `mapM_` pkgDirs genGhcPkgCache `mapM_` pkgDirs
system "find test -name setup-config -exec rm {} \\;" system "find test -name setup-config -exec rm {} \\;"
system "cabal --version"
system "ghc --version"
(putStrLn =<< debugInfo defaultOptions =<< findCradle)
`E.catch` (\(_ :: E.SomeException) -> return () )
hspec spec hspec spec