2015-03-05 15:50:06 +00:00
|
|
|
module CabalHelperSpec where
|
|
|
|
|
|
|
|
import Control.Arrow
|
|
|
|
import Control.Applicative
|
2015-08-07 02:13:12 +00:00
|
|
|
import Distribution.Helper
|
|
|
|
import Language.Haskell.GhcMod.CabalHelper
|
|
|
|
import Language.Haskell.GhcMod.PathsAndFiles
|
2015-03-05 15:50:06 +00:00
|
|
|
import Language.Haskell.GhcMod.Error
|
|
|
|
import Test.Hspec
|
2015-08-07 02:13:12 +00:00
|
|
|
import System.Directory
|
|
|
|
import System.FilePath
|
2015-08-07 04:47:34 +00:00
|
|
|
import System.Process (readProcess, system)
|
2015-03-05 15:50:06 +00:00
|
|
|
|
2015-08-07 02:13:12 +00:00
|
|
|
import Dir
|
|
|
|
import TestUtils
|
2015-03-05 15:50:06 +00:00
|
|
|
import Data.List
|
|
|
|
|
|
|
|
import Config (cProjectVersionInt)
|
|
|
|
|
|
|
|
ghcVersion :: Int
|
|
|
|
ghcVersion = read cProjectVersionInt
|
|
|
|
|
|
|
|
gmeProcessException :: GhcModError -> Bool
|
|
|
|
gmeProcessException GMEProcess {} = True
|
|
|
|
gmeProcessException _ = False
|
|
|
|
|
|
|
|
pkgOptions :: [String] -> [String]
|
|
|
|
pkgOptions [] = []
|
|
|
|
pkgOptions (_:[]) = []
|
|
|
|
pkgOptions (x:y:xs) | x == "-package-id" = [name y] ++ pkgOptions xs
|
|
|
|
| otherwise = pkgOptions (y:xs)
|
|
|
|
where
|
|
|
|
stripDash s = maybe s id $ (flip drop s . (+1) <$> findIndex (=='-') s)
|
|
|
|
name s = reverse $ stripDash $ stripDash $ reverse s
|
|
|
|
|
|
|
|
idirOpts :: [(c, [String])] -> [(c, [String])]
|
|
|
|
idirOpts = map (second $ map (drop 2) . filter ("-i"`isPrefixOf`))
|
|
|
|
|
|
|
|
spec :: Spec
|
2015-08-07 02:13:12 +00:00
|
|
|
spec = do
|
|
|
|
describe "getComponents" $ do
|
|
|
|
it "throws an exception if the cabal file is broken" $ do
|
|
|
|
let tdir = "test/data/broken-cabal"
|
|
|
|
runD' tdir getComponents `shouldThrow` anyIOException
|
2015-03-05 15:50:06 +00:00
|
|
|
|
2015-08-07 02:13:12 +00:00
|
|
|
it "handles sandboxes correctly" $ do
|
|
|
|
let tdir = "test/data/cabal-project"
|
|
|
|
cwd <- getCurrentDirectory
|
2015-03-05 15:50:06 +00:00
|
|
|
|
2015-08-07 02:13:12 +00:00
|
|
|
-- TODO: ChSetupHsName should also have sandbox stuff, see related
|
|
|
|
-- comment in cabal-helper
|
|
|
|
opts <- map gmcGhcOpts . filter ((/= ChSetupHsName) . gmcName) <$> runD' tdir getComponents
|
2015-03-05 15:50:06 +00:00
|
|
|
|
2015-08-12 08:44:36 +00:00
|
|
|
bp <- buildPlatform readProcess
|
2015-08-07 02:13:12 +00:00
|
|
|
if ghcVersion < 706
|
2015-08-12 08:44:36 +00:00
|
|
|
then forM_ opts (\o -> o `shouldContain` ["-no-user-package-conf","-package-conf", cwd </> "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir bp])
|
|
|
|
else forM_ opts (\o -> o `shouldContain` ["-no-user-package-db","-package-db",cwd </> "test/data/cabal-project/.cabal-sandbox/"++ghcSandboxPkgDbDir bp])
|
2015-03-05 15:50:06 +00:00
|
|
|
|
2015-08-07 02:13:12 +00:00
|
|
|
it "extracts build dependencies" $ do
|
|
|
|
let tdir = "test/data/cabal-project"
|
|
|
|
opts <- map gmcGhcOpts <$> runD' tdir getComponents
|
|
|
|
let ghcOpts = head opts
|
|
|
|
pkgs = pkgOptions ghcOpts
|
|
|
|
pkgs `shouldBe` ["Cabal","base","template-haskell"]
|
2015-03-05 15:50:06 +00:00
|
|
|
|
2015-08-07 02:13:12 +00:00
|
|
|
it "uses non default flags" $ do
|
|
|
|
let tdir = "test/data/cabal-flags"
|
|
|
|
_ <- withDirectory_ tdir $
|
|
|
|
readProcess "cabal" ["configure", "-ftest-flag"] ""
|
|
|
|
|
|
|
|
opts <- map gmcGhcOpts <$> runD' tdir getComponents
|
|
|
|
let ghcOpts = head opts
|
|
|
|
pkgs = pkgOptions ghcOpts
|
|
|
|
pkgs `shouldBe` ["Cabal","base"]
|
2015-08-07 04:47:34 +00:00
|
|
|
|
|
|
|
describe "getCustomPkgDbStack" $ do
|
|
|
|
it "works" $ do
|
|
|
|
let tdir = "test/data/custom-cradle"
|
|
|
|
Just stack <- runD' tdir $ getCustomPkgDbStack
|
|
|
|
stack `shouldBe` [ GlobalDb
|
|
|
|
, UserDb
|
|
|
|
, PackageDb "package-db-a"
|
|
|
|
, PackageDb "package-db-b"
|
|
|
|
, PackageDb "package-db-c"
|
|
|
|
]
|
|
|
|
|
|
|
|
describe "getPackageDbStack'" $ do
|
|
|
|
it "fixes out of sync custom pkg-db stack" $ do
|
|
|
|
withDirectory_ "test/data/custom-cradle" $ do
|
|
|
|
_ <- system "cabal configure"
|
|
|
|
(s, s') <- runD $ do
|
|
|
|
Just stack <- getCustomPkgDbStack
|
|
|
|
withCabal $ do
|
|
|
|
stack' <- getPackageDbStack'
|
|
|
|
return (stack, stack')
|
|
|
|
s' `shouldBe` s
|