hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

relative dir for testing.

Browse Source
This commit is contained in:
Kazu Yamamoto 2013-03-05 10:44:17 +09:00
parent 89dc02f185
commit 39954d9114
2 changed files with 53 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
test/CradleSpec.hs
View File

@ -1,8 +1,10 @@
module CradleSpec where
import Control.Applicative
import Cradle
import Data.List (isPrefixOf)
import Expectation
import System.Directory
import System.FilePath (addTrailingPathSeparator)
import Test.Hspec
import Types
@ -10,18 +12,58 @@ spec :: Spec
spec = do
describe "findCradle" $ do
it "returns the current directory" $ do
withDirectory_ "/" $
findCradle Nothing "7.4.1" `shouldReturn` Cradle {cradleCurrentDir = "/", cradleCabalDir = Nothing, cradleCabalFile = Nothing, cradlePackageConf = Nothing}
withDirectory_ "/" $ do
res <- findCradle Nothing "7.4.1"
res `shouldBe` Cradle {
cradleCurrentDir = "/"
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConf = Nothing
}
it "finds a cabal file" $ do
withDirectory "test/data/subdir1/subdir2" $ \dir ->
findCradle Nothing "7.4.1" `shouldReturn` Cradle {cradleCurrentDir = "/Users/kazu/work/ghc-mod/test/data", cradleCabalDir = Just "/Users/kazu/work/ghc-mod/test/data", cradleCabalFile = Just "/Users/kazu/work/ghc-mod/test/data/cabalapi.cabal", cradlePackageConf = Nothing}
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
res <- relativeCradle dir <$> findCradle Nothing "7.4.1"
res `shouldBe` Cradle {
cradleCurrentDir = "test/data/subdir1/subdir2"
, cradleCabalDir = Just "test/data"
, cradleCabalFile = Just "test/data/cabalapi.cabal"
, cradlePackageConf = Nothing
}
it "finds a sandbox" $ do
withDirectory "test/data/subdir1/subdir2" $ \dir ->
findCradle Nothing "7.6.2" `shouldReturn` Cradle {cradleCurrentDir = "/Users/kazu/work/ghc-mod/test/data", cradleCabalDir = Just "/Users/kazu/work/ghc-mod/test/data", cradleCabalFile = Just "/Users/kazu/work/ghc-mod/test/data/cabalapi.cabal", cradlePackageConf = Just "/Users/kazu/work/ghc-mod/test/data/cabal-dev/packages-7.6.2.conf"}
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
res <- relativeCradle dir <$> findCradle Nothing "7.6.2"
res `shouldBe` Cradle {
cradleCurrentDir = "test/data/subdir1/subdir2"
, cradleCabalDir = Just "test/data"
, cradleCabalFile = Just "test/data/cabalapi.cabal"
, cradlePackageConf = Just "test/data/cabal-dev/packages-7.6.2.conf"
}
it "finds a sandbox if exists" $ do
withDirectory "/" $ \dir ->
findCradle (Just "/Users/kazu/work/ghc-mod/test/data/cabal-dev") "7.6.2" `shouldReturn` Cradle {cradleCurrentDir = "/", cradleCabalDir = Nothing, cradleCabalFile = Nothing, cradlePackageConf = Just "/Users/kazu/work/ghc-mod/test/data/cabal-dev/packages-7.6.2.conf"}
withDirectory "/" $ \dir -> do
res <- relativeCradle dir <$> findCradle (Just $ addTrailingPathSeparator dir ++ "test/data/cabal-dev") "7.6.2"
res `shouldBe` Cradle {
cradleCurrentDir = "/"
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConf = Just "test/data/cabal-dev/packages-7.6.2.conf"
}
relativeCradle :: FilePath -> Cradle -> Cradle
relativeCradle dir cradle = Cradle {
cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle
, cradleCabalDir = toRelativeDir dir <$> cradleCabalDir cradle
, cradleCabalFile = toRelativeDir dir <$> cradleCabalFile cradle
, cradlePackageConf = toRelativeDir dir <$> cradlePackageConf cradle
}
toRelativeDir :: FilePath -> FilePath -> FilePath
toRelativeDir dir file
| dir' `isPrefixOf` file = drop len file
| otherwise = file
where
dir' = addTrailingPathSeparator dir
len = length dir'

4
test/Expectation.hs
View File

@ -11,8 +11,8 @@ shouldContain containers element = do
withDirectory_ :: FilePath -> IO a -> IO a
withDirectory_ dir action = bracket getCurrentDirectory
setCurrentDirectory
(\_ -> setCurrentDirectory dir >> action)
setCurrentDirectory
(\_ -> setCurrentDirectory dir >> action)
withDirectory :: FilePath -> (FilePath -> IO a) -> IO a
withDirectory dir action = bracket getCurrentDirectory