diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index 100a4e1..201788a 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -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' diff --git a/test/Expectation.hs b/test/Expectation.hs index 2032b9d..6b932ad 100644 --- a/test/Expectation.hs +++ b/test/Expectation.hs @@ -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