diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -1,4 +1,7 @@ -2013-09-16 v3.1.0 +2013-09-21 v3.1.1 + * Making Cradle strict. + +2013-09-21 v3.1.0 * API breaks backward compatibility. * Supporting sandbox sharing. diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -11,9 +11,11 @@ import Control.Applicative ((<$>)) import Control.Exception (throwIO) +import Control.Monad (filterM) +import CoreMonad (liftIO) import Data.Maybe (maybeToList) import Data.Set (fromList, toList) -import Distribution.ModuleName (toFilePath) +import Distribution.ModuleName (ModuleName,toFilePath) import Distribution.Package (Dependency(Dependency) , PackageName(PackageName) , PackageIdentifier(pkgName)) @@ -165,14 +167,36 @@ -- | Extracting all 'Module' 'FilePath's for libraries, executables, -- tests and benchmarks. -cabalAllTargets :: PackageDescription -> ([FilePath],[FilePath],[FilePath],[FilePath]) -cabalAllTargets pd = targets +cabalAllTargets :: PackageDescription -> IO ([String],[String],[String],[String]) +cabalAllTargets pd = do + exeTargets <- mapM getExecutableTarget $ executables pd + testTargets <- mapM getTestTarget $ testSuites pd + return (libTargets,concat exeTargets,concat testTargets,benchTargets) where lib = case library pd of Nothing -> [] Just l -> libModules l - targets = (map toFilePath $ lib, - map modulePath $ executables pd, - map toFilePath $ concatMap testModules $ testSuites pd, - map toFilePath $ concatMap benchmarkModules $ benchmarks pd) + libTargets = map toModuleString $ lib + benchTargets = map toModuleString $ concatMap benchmarkModules $ benchmarks pd + + toModuleString :: ModuleName -> String + toModuleString mn = fromFilePath $ toFilePath mn + + fromFilePath :: FilePath -> String + fromFilePath fp = map (\c -> if c=='/' then '.' else c) fp + + getTestTarget :: TestSuite -> IO [String] + getTestTarget ts = + case testInterface ts of + (TestSuiteExeV10 _ filePath) -> do + let maybeTests = [p e | p <- hsSourceDirs $ testBuildInfo ts, e <- [filePath]] + liftIO $ filterM doesFileExist maybeTests + (TestSuiteLibV09 _ moduleName) -> return [toModuleString moduleName] + (TestSuiteUnsupported _) -> return [] + + getExecutableTarget :: Executable -> IO [String] + getExecutableTarget exe = do + let maybeExes = [p e | p <- hsSourceDirs $ buildInfo exe, e <- [modulePath exe]] + liftIO $ filterM doesFileExist maybeExes + diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -1,5 +1,11 @@ -module Language.Haskell.GhcMod.Cradle (findCradle) where +{-# LANGUAGE BangPatterns #-} +module Language.Haskell.GhcMod.Cradle ( + findCradle + , findCradleWithoutSandbox + , getPackageDbDir + ) where + import Data.Char (isSpace) import Control.Applicative ((<$>)) import Control.Exception as E (catch, throwIO, SomeException) @@ -39,6 +45,12 @@ , cradlePackageDbOpts = pkgDbOpts } +-- Just for testing +findCradleWithoutSandbox :: IO Cradle +findCradleWithoutSandbox = do + cradle <- findCradle + return cradle { cradlePackageDbOpts = [] } + ---------------------------------------------------------------- cabalSuffix :: String @@ -80,15 +92,24 @@ pkgDbKeyLen :: Int pkgDbKeyLen = length pkgDbKey --- | Extract a package db directory from the sandbox config file. +-- | Obtaining GHC options relating to a package db directory getPackageDbOpts :: FilePath -> IO [GHCOption] -getPackageDbOpts cdir = (sandboxArguments <$> getPkgDb ) `E.catch` handler +getPackageDbOpts cdir = (sandboxArguments <$> getPkgDb) `E.catch` handler where - getPkgDb = extractValue . parse <$> readFile (cdir configFile) - parse = head . filter ("package-db:" `isPrefixOf`) . lines - extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen + getPkgDb = getPackageDbDir (cdir configFile) handler :: SomeException -> IO [GHCOption] handler _ = return [] + +-- | Extract a package db directory from the sandbox config file. +-- Exception is thrown if the sandbox config file is broken. +getPackageDbDir :: FilePath -> IO FilePath +getPackageDbDir sconf = do + -- Be strict to ensure that an error can be caught. + !path <- extractValue . parse <$> readFile sconf + return path + where + parse = head . filter ("package-db:" `isPrefixOf`) . lines + extractValue = fst . break isSpace . dropWhile isSpace . drop pkgDbKeyLen -- | Adding necessary GHC options to the package db. -- Exception is thrown if the string argument is incorrect. diff --git a/ghc-mod.cabal b/ghc-mod.cabal --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -1,5 +1,5 @@ Name: ghc-mod -Version: 3.1.0 +Version: 3.1.1 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -28,14 +28,17 @@ test/data/*.hs test/data/cabal.sandbox.config test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/dummy - test/data/ghc-mod-check/*.hs - test/data/ghc-mod-check/*.cabal - test/data/ghc-mod-check/Data/*.hs - test/data/subdir1/subdir2/dummy + test/data/broken-cabal/*.cabal + test/data/broken-sandbox/*.cabal + test/data/broken-sandbox/cabal.sandbox.config test/data/check-test-subdir/*.cabal + test/data/check-test-subdir/src/Check/Test/*.hs test/data/check-test-subdir/test/*.hs test/data/check-test-subdir/test/Bar/*.hs - test/data/check-test-subdir/src/Check/Test/*.hs + test/data/ghc-mod-check/*.cabal + test/data/ghc-mod-check/*.hs + test/data/ghc-mod-check/Data/*.hs + test/data/subdir1/subdir2/dummy Library Default-Language: Haskell2010 diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -25,10 +25,10 @@ pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle res <- getCompilerOptions [] cradle pkgDesc let res' = res { - ghcOptions = map (toRelativeDir dir) (ghcOptions res) + ghcOptions = ghcOptions res , includeDirs = map (toRelativeDir dir) (includeDirs res) } - res' `shouldBe` CompilerOptions {ghcOptions = ["-no-user-package-db","-package-db","test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"], depPackages = ["Cabal","base","template-haskell"]} + res' `shouldBe` CompilerOptions {ghcOptions = ["-no-user-package-db","-package-db","/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d","-XHaskell98"], includeDirs = ["test/data","test/data/dist/build","test/data/dist/build/autogen","test/data/subdir1/subdir2","test/data/test"], depPackages = ["Cabal","base","template-haskell"]} describe "cabalDependPackages" $ do it "extracts dependent packages" $ do diff --git a/test/CheckSpec.hs b/test/CheckSpec.hs --- a/test/CheckSpec.hs +++ b/test/CheckSpec.hs @@ -2,6 +2,7 @@ import Data.List (isSuffixOf, isInfixOf, isPrefixOf) import Language.Haskell.GhcMod +import Language.Haskell.GhcMod.Cradle import System.FilePath import Test.Hspec @@ -12,24 +13,24 @@ describe "checkSyntax" $ do it "can check even if an executable depends on its library" $ do withDirectory_ "test/data/ghc-mod-check" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["main.hs"] res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\NUL\n" it "can check even if a test module imports another test module located at different directory" $ do withDirectory_ "test/data/check-test-subdir" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["test/Bar/Baz.hs"] res `shouldSatisfy` (("test" "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\NUL\n") `isSuffixOf`) it "can detect mutually imported modules" $ do withDirectory_ "test/data" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["Mutual1.hs"] res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`) it "can check a module using QuasiQuotes" $ do withDirectory_ "test/data" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- checkSyntax defaultOptions cradle ["Baz.hs"] res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`) diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs --- a/test/InfoSpec.hs +++ b/test/InfoSpec.hs @@ -2,6 +2,7 @@ import Data.List (isPrefixOf) import Language.Haskell.GhcMod +import Language.Haskell.GhcMod.Cradle import System.Exit import System.Process import Test.Hspec @@ -13,38 +14,38 @@ describe "typeExpr" $ do it "shows types of the expression and its outers" $ do withDirectory_ "test/data/ghc-mod-check" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- typeExpr defaultOptions cradle "Data/Foo.hs" "Data.Foo" 9 5 res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n" it "works with a module using TemplateHaskell" $ do withDirectory_ "test/data" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- typeExpr defaultOptions cradle "Bar.hs" "Bar" 5 1 res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] it "works with a module that imports another module using TemplateHaskell" $ do withDirectory_ "test/data" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- typeExpr defaultOptions cradle "Main.hs" "Main" 3 8 res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""] describe "infoExpr" $ do it "works for non-export functions" $ do withDirectory_ "test/data" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- infoExpr defaultOptions cradle "Info.hs" "Info" "fib" res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`) it "works with a module using TemplateHaskell" $ do withDirectory_ "test/data" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- infoExpr defaultOptions cradle "Bar.hs" "Bar" "foo" res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`) it "works with a module that imports another module using TemplateHaskell" $ do withDirectory_ "test/data" $ do - cradle <- findCradle + cradle <- findCradleWithoutSandbox res <- infoExpr defaultOptions cradle "Main.hs" "Main" "bar" res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) diff --git a/test/data/broken-cabal/broken.cabal b/test/data/broken-cabal/broken.cabal new file mode 100644 --- /dev/null +++ b/test/data/broken-cabal/broken.cabal @@ -0,0 +1,1 @@ +broken cabal diff --git a/test/data/broken-sandbox/cabal.sandbox.config b/test/data/broken-sandbox/cabal.sandbox.config new file mode 100644 --- /dev/null +++ b/test/data/broken-sandbox/cabal.sandbox.config @@ -0,0 +1,1 @@ +broken diff --git a/test/data/broken-sandbox/dummy.cabal b/test/data/broken-sandbox/dummy.cabal new file mode 100644 --- /dev/null +++ b/test/data/broken-sandbox/dummy.cabal @@ -0,0 +1,1 @@ +dummy diff --git a/test/data/cabal.sandbox.config b/test/data/cabal.sandbox.config --- a/test/data/cabal.sandbox.config +++ b/test/data/cabal.sandbox.config @@ -4,15 +4,15 @@ -- if you want to change the default settings for this sandbox. -local-repo: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/packages -logs-dir: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/logs -world-file: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/world +local-repo: /home/me/work/ghc-mod/test/data/.cabal-sandbox/packages +logs-dir: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs +world-file: /home/me/work/ghc-mod/test/data/.cabal-sandbox/world user-install: False -package-db: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d -build-summary: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox/logs/build.log +package-db: /home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d +build-summary: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs/build.log install-dirs - prefix: /Users/kazu/work/ghc-mod/test/data/.cabal-sandbox + prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox bindir: $prefix/bin libdir: $prefix/lib libsubdir: $arch-$os-$compiler/$pkgid