2013-03-05 01:22:33 +00:00
|
|
|
module CradleSpec where
|
|
|
|
|
2013-03-05 01:44:17 +00:00
|
|
|
import Control.Applicative
|
2014-01-14 06:24:10 +00:00
|
|
|
import Data.List (isSuffixOf)
|
2013-09-21 06:10:43 +00:00
|
|
|
import Language.Haskell.GhcMod.Cradle
|
|
|
|
import Language.Haskell.GhcMod.Types
|
2013-05-20 02:29:44 +00:00
|
|
|
import System.Directory (canonicalizePath)
|
2014-01-14 06:24:10 +00:00
|
|
|
import System.FilePath ((</>), pathSeparator)
|
2013-03-05 01:22:33 +00:00
|
|
|
import Test.Hspec
|
|
|
|
|
2013-09-03 02:49:35 +00:00
|
|
|
import Dir
|
|
|
|
|
2013-03-05 01:22:33 +00:00
|
|
|
spec :: Spec
|
|
|
|
spec = do
|
|
|
|
describe "findCradle" $ do
|
|
|
|
it "returns the current directory" $ do
|
2013-03-05 01:44:17 +00:00
|
|
|
withDirectory_ "/" $ do
|
2014-01-14 06:24:10 +00:00
|
|
|
curDir <- stripLastDot <$> canonicalizePath "/"
|
2013-09-20 06:48:50 +00:00
|
|
|
res <- findCradle
|
2013-03-05 01:44:17 +00:00
|
|
|
res `shouldBe` Cradle {
|
2013-09-20 08:15:41 +00:00
|
|
|
cradleCurrentDir = curDir
|
|
|
|
, cradleCabalDir = Nothing
|
|
|
|
, cradleCabalFile = Nothing
|
|
|
|
, cradlePackageDbOpts = []
|
2014-01-30 11:42:25 +00:00
|
|
|
, cradlePackages = []
|
2013-03-05 01:44:17 +00:00
|
|
|
}
|
2013-09-20 06:57:26 +00:00
|
|
|
it "finds a cabal file and a sandbox" $ do
|
2013-03-05 01:44:17 +00:00
|
|
|
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
|
2013-09-20 06:48:50 +00:00
|
|
|
res <- relativeCradle dir <$> findCradle
|
2013-03-05 01:44:17 +00:00
|
|
|
res `shouldBe` Cradle {
|
2013-09-20 08:15:41 +00:00
|
|
|
cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
|
|
|
|
, cradleCabalDir = Just ("test" </> "data")
|
|
|
|
, cradleCabalFile = Just ("test" </> "data" </> "cabalapi.cabal")
|
2013-09-21 09:37:33 +00:00
|
|
|
, cradlePackageDbOpts = ["-no-user-package-db", "-package-db", "test" </> "data" </> ".cabal-sandbox" </> "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
|
2014-01-30 11:42:25 +00:00
|
|
|
, cradlePackages = []
|
2013-03-05 01:44:17 +00:00
|
|
|
}
|
2013-09-21 06:32:22 +00:00
|
|
|
it "works even if a sandbox config file is broken" $ do
|
|
|
|
withDirectory "test/data/broken-sandbox" $ \dir -> do
|
|
|
|
res <- relativeCradle dir <$> findCradle
|
|
|
|
res `shouldBe` Cradle {
|
|
|
|
cradleCurrentDir = "test" </> "data" </> "broken-sandbox"
|
|
|
|
, cradleCabalDir = Just ("test" </> "data" </> "broken-sandbox")
|
|
|
|
, cradleCabalFile = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
|
|
|
|
, cradlePackageDbOpts = []
|
2014-01-30 11:42:25 +00:00
|
|
|
, cradlePackages = []
|
2013-09-21 06:32:22 +00:00
|
|
|
}
|
|
|
|
|
2013-09-21 06:10:43 +00:00
|
|
|
describe "getPackageDbDir" $ do
|
|
|
|
it "parses a config file and extracts package db" $ do
|
|
|
|
pkgDb <- getPackageDbDir "test/data/cabal.sandbox.config"
|
2013-09-21 09:37:33 +00:00
|
|
|
pkgDb `shouldBe` "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"
|
2013-09-21 06:10:43 +00:00
|
|
|
|
|
|
|
it "throws an error if a config file is broken" $ do
|
|
|
|
getPackageDbDir "test/data/bad.config" `shouldThrow` anyException
|
2013-03-05 01:22:33 +00:00
|
|
|
|
2014-01-30 11:09:57 +00:00
|
|
|
describe "getPackageDbPackages" $ do
|
|
|
|
it "find a config file and extracts packages with their ids" $ do
|
|
|
|
pkgs <- getPackageDbPackages "test/data/check-packageid"
|
|
|
|
pkgs `shouldBe` [("template-haskell", Just "template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c")]
|
|
|
|
|
2013-03-05 01:44:17 +00:00
|
|
|
relativeCradle :: FilePath -> Cradle -> Cradle
|
2014-01-30 11:42:25 +00:00
|
|
|
relativeCradle dir cradle = cradle {
|
2013-09-20 08:15:41 +00:00
|
|
|
cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle
|
|
|
|
, cradleCabalDir = toRelativeDir dir <$> cradleCabalDir cradle
|
|
|
|
, cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle
|
2013-03-05 01:44:17 +00:00
|
|
|
}
|
2014-01-14 06:24:10 +00:00
|
|
|
|
|
|
|
-- Work around GHC 7.2.2 where `canonicalizePath "/"` returns "/.".
|
|
|
|
stripLastDot :: FilePath -> FilePath
|
|
|
|
stripLastDot path
|
|
|
|
| (pathSeparator:'.':"") `isSuffixOf` path = init path
|
|
|
|
| otherwise = path
|