ghc-mod 3.0.2 → 3.1.0

raw patch · 18 files changed

+247/−212 lines, 18 filesdep +doctestdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: doctest

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog +4/−0
• Language/Haskell/GhcMod.hs +0/−4
• Language/Haskell/GhcMod/CabalApi.hs +34/−38
• Language/Haskell/GhcMod/Check.hs +1/−1
• Language/Haskell/GhcMod/Cradle.hs +85/−88
• Language/Haskell/GhcMod/Debug.hs +14/−11
• Language/Haskell/GhcMod/GHCApi.hs +25/−17
• Language/Haskell/GhcMod/Gap.hs +1/−0
• Language/Haskell/GhcMod/Internal.hs +3/−1
• Language/Haskell/GhcMod/Types.hs +12/−11
• ghc-mod.cabal +10/−1
• src/GHCMod.hs +4/−22
• test/CabalApiSpec.hs +21/−1
• test/CheckSpec.hs +4/−6
• test/DebugSpec.hs +2/−3
• test/Dir.hs +11/−1
• test/InfoSpec.hs +6/−7
• test/doctests.hs +10/−0

@@ -1,3 +1,7 @@+2013-09-16 v3.1.0+	* API breaks backward compatibility.+	* Supporting sandbox sharing.+ 2013-09-16 v3.0.2 	* Fixing a bug of "dist/build/autogen/cabal_macros.h". 

@@ -4,9 +4,6 @@   -- * Cradle     Cradle(..)   , findCradle-  -- * GHC version-  , GHCVersion-  , getGHCVersion   -- * Options   , Options(..)   , LineSeparator(..)@@ -48,4 +45,3 @@ import Language.Haskell.GhcMod.Lint import Language.Haskell.GhcMod.List import Language.Haskell.GhcMod.Types-import Language.Haskell.GhcMod.CabalApi

@@ -1,19 +1,19 @@ {-# LANGUAGE OverloadedStrings #-}  module Language.Haskell.GhcMod.CabalApi (-    fromCabalFile+    getCompilerOptions   , parseCabalFile   , cabalAllBuildInfo   , cabalDependPackages   , cabalSourceDirs-  , getGHCVersion+  , cabalAllTargets   ) where  import Control.Applicative ((<$>)) import Control.Exception (throwIO)-import Data.List (intercalate) import Data.Maybe (maybeToList) import Data.Set (fromList, toList)+import Distribution.ModuleName (toFilePath) import Distribution.Package (Dependency(Dependency)                            , PackageName(PackageName)                            , PackageIdentifier(pkgName))@@ -26,34 +26,23 @@ import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity (silent)-import Distribution.Version (versionBranch, Version)+import Distribution.Version (Version) import Language.Haskell.GhcMod.Types import System.Directory (doesFileExist) import System.FilePath  ---------------------------------------------------------------- --- | Parsing a cabal file in 'Cradle' and returns---   options for GHC, include directories for modules and---   package names of dependency.-fromCabalFile :: [GHCOption]-              -> Cradle-              -> IO ([GHCOption],[IncludeDir],[Package])-fromCabalFile ghcOptions cradle =-    parseCabalFile cfile >>= cookInfo ghcOptions cradle-  where-    Just cfile = cradleCabalFile cradle--cookInfo :: [GHCOption] -> Cradle -> PackageDescription-         -> IO ([GHCOption],[IncludeDir],[Package])-cookInfo ghcOptions cradle cabal = do-    gopts <- getGHCOptions ghcOptions cdir $ head buildInfos-    return (gopts,idirs,depPkgs)+-- | Getting necessary 'CompilerOptions' from three information sources.+getCompilerOptions :: [GHCOption] -> Cradle -> PackageDescription -> IO CompilerOptions+getCompilerOptions ghcopts cradle pkgDesc = do+    gopts <- getGHCOptions ghcopts cradle cdir $ head buildInfos+    return $ CompilerOptions gopts idirs depPkgs   where     wdir       = cradleCurrentDir cradle     Just cdir  = cradleCabalDir   cradle     Just cfile = cradleCabalFile  cradle-    buildInfos = cabalAllBuildInfo cabal+    buildInfos = cabalAllBuildInfo pkgDesc     idirs      = includeDirectories cdir wdir $ cabalSourceDirs buildInfos     depPkgs    = removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos @@ -77,12 +66,14 @@ -- Include directories for modules  cabalBuildDirs :: [FilePath]-cabalBuildDirs = ["dist/build"]+cabalBuildDirs = ["dist/build", "dist/build/autogen"]  includeDirectories :: FilePath -> FilePath -> [FilePath] -> [FilePath] includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir])   where-    extdirs = map (cdir </>) $ dirs ++ cabalBuildDirs+    extdirs = map expand $ dirs ++ cabalBuildDirs+    expand "."    = cdir+    expand subdir = cdir </> subdir  ---------------------------------------------------------------- @@ -105,12 +96,13 @@  ---------------------------------------------------------------- -getGHCOptions :: [GHCOption] -> FilePath -> BuildInfo -> IO [GHCOption]-getGHCOptions ghcOptions cdir binfo = do+getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption]+getGHCOptions ghcopts cradle cdir binfo = do     cabalCpp <- cabalCppOptions cdir     let cpps = map ("-optP" ++) $ cppOptions binfo ++ cabalCpp-    return $ ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps+    return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps   where+    pkgDb = cradlePackageDbOpts cradle     lang = maybe "-XHaskell98" (("-X" ++) . display) $ defaultLanguage binfo     libDirs = map ("-L" ++) $ extraLibDirs binfo     exts = map (("-X" ++) . display) $ usedExtensions binfo@@ -159,18 +151,6 @@  ---------------------------------------------------------------- --- | Getting GHC version. 7.6.3 becames 706 in the second of the result.-getGHCVersion :: IO (GHCVersion, Int)-getGHCVersion = toTupple <$> getGHC-  where-    toTupple v-      | length vs < 2 = (verstr, 0)-      | otherwise     = (verstr, ver)-      where-        vs = versionBranch v-        ver = (vs !! 0) * 100 + (vs !! 1)-        verstr = intercalate "." . map show $ vs- getGHCId :: IO CompilerId getGHCId = CompilerId GHC <$> getGHC @@ -180,3 +160,19 @@     case mv of         Nothing -> throwIO $ userError "ghc not found"         Just v  -> return $ v++----------------------------------------------------------------++-- | Extracting all 'Module' 'FilePath's for libraries, executables,+-- tests and benchmarks.+cabalAllTargets :: PackageDescription -> ([FilePath],[FilePath],[FilePath],[FilePath])+cabalAllTargets pd = targets+  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)

@@ -37,7 +37,7 @@ check opt cradle fileNames = checkIt `gcatch` handleErrMsg ls   where     checkIt = do-        readLog <- initializeFlagsWithCradle opt cradle options True+        (readLog,_) <- initializeFlagsWithCradle opt cradle options True         setTargetFiles fileNames         checkSlowAndSet         void $ load LoadAllTargets

@@ -1,66 +1,44 @@ module Language.Haskell.GhcMod.Cradle (findCradle) where +import Data.Char (isSpace) import Control.Applicative ((<$>))-import Control.Exception (throwIO)-import Control.Monad (unless, filterM)-import Data.List (isSuffixOf)-import Distribution.System (buildPlatform)-import qualified Distribution.Text as Text (display)+import Control.Exception as E (catch, throwIO, SomeException)+import Control.Monad (filterM)+import Data.List (isPrefixOf, isSuffixOf, tails) import Language.Haskell.GhcMod.Types-import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist, doesDirectoryExist)-import System.FilePath ((</>),takeDirectory)+import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist)+import System.FilePath ((</>), takeDirectory, takeFileName)  ----------------------------------------------------------------  -- | Finding 'Cradle'.---   An error would be thrown.-findCradle :: Maybe FilePath -- ^ A 'FilePath' for a sandbox.-           -> GHCVersion-           -> IO Cradle-findCradle (Just sbox) strver = do-    (pkgConf,exist) <- checkPackageConf sbox strver-    unless exist $  throwIO $ userError $ pkgConf ++ " not found"-    wdir <- getCurrentDirectory-    cfiles <- cabalDir wdir-    return $ case cfiles of-        Nothing -> Cradle {-            cradleCurrentDir  = wdir-          , cradleCabalDir    = Nothing-          , cradleCabalFile   = Nothing-          , cradlePackageConf = Just pkgConf-          }-        Just (cdir,cfile,_) -> Cradle {-            cradleCurrentDir  = wdir-          , cradleCabalDir    = Just cdir-          , cradleCabalFile   = Just cfile-          , cradlePackageConf = Just pkgConf-          }-findCradle Nothing strver = do+--   Find a cabal file by tracing ancestor directories.+--   Find a sandbox according to a cabal sandbox config+--   in a cabal directory.+findCradle :: IO Cradle+findCradle = do     wdir <- getCurrentDirectory-    cfiles <- cabalDir wdir-    case cfiles of-        Nothing -> return Cradle {-            cradleCurrentDir  = wdir-          , cradleCabalDir    = Nothing-          , cradleCabalFile   = Nothing-          , cradlePackageConf = Nothing-          }-        Just (cdir,cfile,Nothing) -> do-            return Cradle {-                cradleCurrentDir  = wdir-              , cradleCabalDir    = Just cdir-              , cradleCabalFile   = Just cfile-              , cradlePackageConf = Nothing-              }-        Just (cdir,cfile,Just sbox) -> do-            (pkgConf,exist) <- checkPackageConf sbox strver-            return Cradle {-                cradleCurrentDir  = wdir-              , cradleCabalDir    = Just cdir-              , cradleCabalFile   = Just cfile-              , cradlePackageConf = if exist then Just pkgConf else Nothing-              }+    findCradle' wdir `E.catch` handler wdir+  where+    handler :: FilePath -> SomeException -> IO Cradle+    handler wdir _ = return Cradle {+        cradleCurrentDir    = wdir+      , cradleCabalDir      = Nothing+      , cradleCabalFile     = Nothing+      , cradlePackageDbOpts = []+      } +findCradle' :: FilePath -> IO Cradle+findCradle' wdir = do+    (cdir,cfile) <- cabalDir wdir+    pkgDbOpts <- getPackageDbOpts cdir+    return Cradle {+        cradleCurrentDir    = wdir+      , cradleCabalDir      = Just cdir+      , cradleCabalFile     = Just cfile+      , cradlePackageDbOpts = pkgDbOpts+      }+ ----------------------------------------------------------------  cabalSuffix :: String@@ -72,52 +50,71 @@ -- Finding a Cabal file up to the root directory -- Input: a directly to investigate -- Output: (the path to the directory containing a Cabal file---         ,the path to the Cabal file---         ,Just the path to the sandbox directory)-cabalDir :: FilePath -> IO (Maybe (FilePath,FilePath,Maybe FilePath))+--         ,the path to the Cabal file)+cabalDir :: FilePath -> IO (FilePath,FilePath) cabalDir dir = do-    cnts <- (filter isCabal <$> getDirectoryContents dir)-            >>= filterM (\file -> doesFileExist (dir </> file))-    let dir' = takeDirectory dir+    cnts <- getCabalFiles dir     case cnts of-        [] | dir' == dir -> return Nothing+        [] | dir' == dir -> throwIO $ userError "cabal files not found"            | otherwise   -> cabalDir dir'-        cfile:_          -> do-            msbox <- checkSandbox dir-            return $ Just (dir,dir </> cfile, msbox)+        cfile:_          -> return (dir,dir </> cfile)   where+    dir' = takeDirectory dir++getCabalFiles :: FilePath -> IO [FilePath]+getCabalFiles dir = getFiles >>= filterM doesCabalFileExist+  where     isCabal name = cabalSuffix `isSuffixOf` name                 && length name > cabalSuffixLength+    getFiles = filter isCabal <$> getDirectoryContents dir+    doesCabalFileExist file = doesFileExist $ dir </> file  ---------------------------------------------------------------- -sandboxConfig :: String-sandboxConfig = "cabal.sandbox.config"+configFile :: String+configFile = "cabal.sandbox.config" -sandboxDir :: String-sandboxDir = ".cabal-sandbox"+pkgDbKey :: String+pkgDbKey = "package-db:" -checkSandbox :: FilePath -> IO (Maybe FilePath)-checkSandbox dir = do-    let conf = dir </> sandboxConfig-        sbox = dir </> sandboxDir-    sandboxConfigExists <- doesFileExist conf-    sandboxExists <- doesDirectoryExist sbox-    if sandboxConfigExists && sandboxExists then-        return (Just sbox)-      else-        return Nothing+pkgDbKeyLen :: Int+pkgDbKeyLen = length pkgDbKey -----------------------------------------------------------------+-- | Extract a package db directory from the sandbox config file.+getPackageDbOpts :: FilePath -> IO [GHCOption]+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+    handler :: SomeException -> IO [GHCOption]+    handler _ = return [] -packageConfName :: GHCVersion -> FilePath-packageConfName strver = Text.display buildPlatform-                      ++ "-ghc-"-                      ++ strver-                      ++ "-packages.conf.d"+-- | Adding necessary GHC options to the package db.+--   Exception is thrown if the string argument is incorrect.+--+-- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"+-- ["-no-user-package-db","-package-db","/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"]+-- >>> sandboxArguments "/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"+-- ["-no-user-package-conf","-package-conf","/foo/bar/i386-osx-ghc-7.4.1-packages.conf.d"]+sandboxArguments :: FilePath -> [String]+sandboxArguments pkgDb = [noUserPkgDbOpt, pkgDbOpt, pkgDb]+  where+    ver = extractGhcVer pkgDb+    (pkgDbOpt,noUserPkgDbOpt)+      | ver < 706 = ("-package-conf","-no-user-package-conf")+      | otherwise = ("-package-db",  "-no-user-package-db") -checkPackageConf :: FilePath -> GHCVersion -> IO (FilePath, Bool)-checkPackageConf path strver = do-    let dir = path </> packageConfName strver-    exist <- doesDirectoryExist dir-    return (dir,exist)+-- | Extracting GHC version from the path of package db.+--   Exception is thrown if the string argument is incorrect.+--+-- >>> extractGhcVer "/foo/bar/i386-osx-ghc-7.6.3-packages.conf.d"+-- 706+extractGhcVer :: String -> Int+extractGhcVer dir = ver+  where+    file = takeFileName dir+    findVer = drop 4 . head . filter ("ghc-" `isPrefixOf`) . tails+    (verStr1,_:left) = break (== '.') $ findVer file+    (verStr2,_)      = break (== '.') left+    ver = read verStr1 * 100 + read verStr2

@@ -17,30 +17,27 @@ -- | Obtaining debug information. debugInfo :: Options           -> Cradle-          -> GHCVersion           -> FilePath   -- ^ A target file.           -> IO String-debugInfo opt cradle ver fileName = unlines <$> withGHC fileName (debug opt cradle ver fileName)+debugInfo opt cradle fileName = unlines <$> withGHC fileName (debug opt cradle fileName)  -- | Obtaining debug information. debug :: Options       -> Cradle-      -> GHCVersion       -> FilePath     -- ^ A target file.       -> Ghc [String]-debug opt cradle ver fileName = do-    (gopts, incDir, pkgs) <-+debug opt cradle fileName = do+    CompilerOptions gopts incDir pkgs <-         if cabal then-            liftIO $ fromCabalFile (ghcOpts opt) cradle ||> return (ghcOpts opt, [], [])+            liftIO (fromCabalFile ||> return simpleCompilerOption)           else-            return (ghcOpts opt, [], [])+            return simpleCompilerOption     [fast] <- do         void $ initializeFlagsWithCradle opt cradle gopts True         setTargetFiles [fileName]         pure . canCheckFast <$> depanal [] False     return [-        "GHC version:         " ++ ver-      , "Current directory:   " ++ currentDir+        "Current directory:   " ++ currentDir       , "Cabal file:          " ++ cabalFile       , "GHC options:         " ++ unwords gopts       , "Include directories: " ++ unwords incDir@@ -49,5 +46,11 @@       ]   where     currentDir = cradleCurrentDir cradle-    cabal = isJust $ cradleCabalFile cradle-    cabalFile = fromMaybe "" $ cradleCabalFile cradle+    mCabalFile = cradleCabalFile cradle+    cabal = isJust mCabalFile+    cabalFile = fromMaybe "" mCabalFile+    origGopts = ghcOpts opt+    simpleCompilerOption = CompilerOptions origGopts [] []+    fromCabalFile = parseCabalFile file >>= getCompilerOptions origGopts cradle+      where+        file = fromJust mCabalFile

@@ -16,7 +16,8 @@ import Control.Exception import Control.Monad import CoreMonad-import Data.Maybe (isJust)+import Data.Maybe (isJust,fromJust)+import Distribution.PackageDescription (PackageDescription) import DynFlags import Exception import GHC@@ -24,8 +25,8 @@ import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.ErrMsg import Language.Haskell.GhcMod.GHCChoice-import Language.Haskell.GhcMod.Types import qualified Language.Haskell.GhcMod.Gap as Gap+import Language.Haskell.GhcMod.Types import System.Exit import System.IO @@ -60,37 +61,44 @@ -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session according to the 'Cradle' and 'Options' -- provided.-initializeFlagsWithCradle :: GhcMonad m =>  Options -> Cradle -> [GHCOption] -> Bool -> m LogReader-initializeFlagsWithCradle opt cradle ghcOptions logging+initializeFlagsWithCradle :: GhcMonad m =>  Options -> Cradle -> [GHCOption] -> Bool -> m (LogReader, Maybe PackageDescription)+initializeFlagsWithCradle opt cradle ghcopts logging   | cabal     = withCabal |||> withoutCabal   | otherwise = withoutCabal   where-    cabal = isJust $ cradleCabalFile cradle+    mCradleFile = cradleCabalFile cradle+    cabal = isJust mCradleFile     withCabal = do-        (gopts,idirs,depPkgs) <- liftIO $ fromCabalFile ghcOptions cradle-        initSession CabalPkg opt gopts idirs (Just depPkgs) logging-    withoutCabal =-        initSession SingleFile opt ghcOptions importDirs Nothing logging+        pkgDesc <- liftIO $ parseCabalFile $ fromJust mCradleFile+        compOpts <- liftIO $ getCompilerOptions ghcopts cradle pkgDesc+        logger <- initSession CabalPkg opt compOpts logging+        return (logger, Just pkgDesc)+    withoutCabal = do+        logger <- initSession SingleFile opt compOpts logging+        return (logger, Nothing)+      where+        compOpts = CompilerOptions ghcopts importDirs []  ----------------------------------------------------------------  initSession :: GhcMonad m => Build             -> Options-            -> [GHCOption]-            -> [IncludeDir]-            -> Maybe [Package]+            -> CompilerOptions             -> Bool             -> m LogReader-initSession build opt cmdOpts idirs mDepPkgs logging = do+initSession build opt compOpts logging = do     dflags0 <- getSessionDynFlags     (dflags1,readLog) <- setupDynamicFlags dflags0     _ <- setSessionDynFlags dflags1     return readLog   where+    cmdOpts = ghcOptions compOpts+    idirs   = includeDirs compOpts+    depPkgs = depPackages compOpts     ls = lineSeparator opt     setupDynamicFlags df0 = do         df1 <- modifyFlagsWithOpts df0 cmdOpts-        let df2 = modifyFlags df1 idirs mDepPkgs (expandSplice opt) build+        let df2 = modifyFlags df1 idirs depPkgs (expandSplice opt) build         df3 <- modifyFlagsWithOpts df2 $ ghcOpts opt         liftIO $ setLogger logging df3 ls @@ -107,14 +115,14 @@ ----------------------------------------------------------------  -- FIXME removing Options-modifyFlags :: DynFlags -> [IncludeDir] -> Maybe [Package] -> Bool -> Build -> DynFlags-modifyFlags d0 idirs mDepPkgs splice build+modifyFlags :: DynFlags -> [IncludeDir] -> [Package] -> Bool -> Build -> DynFlags+modifyFlags d0 idirs pepPkgs splice build   | splice    = setSplice d4   | otherwise = d4   where     d1 = d0 { importPaths = idirs }     d2 = setFastOrNot d1 Fast-    d3 = maybe d2 (Gap.addDevPkgs d2) mDepPkgs+    d3 = Gap.addDevPkgs d2 pepPkgs     d4 | build == CabalPkg = Gap.setCabalPkg d3        | otherwise         = d3 

@@ -207,6 +207,7 @@ ----------------------------------------------------------------  addDevPkgs :: DynFlags -> [Package] -> DynFlags+addDevPkgs df []   = df addDevPkgs df pkgs = df''   where #if __GLASGOW_HASKELL__ >= 707

@@ -6,12 +6,14 @@   , GHCOption   , Package   , IncludeDir+  , CompilerOptions(..)   -- * Cabal API-  , fromCabalFile   , parseCabalFile+  , getCompilerOptions   , cabalAllBuildInfo   , cabalDependPackages   , cabalSourceDirs+  , cabalAllTargets   -- * GHC API   , canCheckFast   -- * Getting 'DynFlags'

@@ -19,8 +19,6 @@   , detailed      :: Bool   -- | Whether or not Template Haskell should be expanded.   , expandSplice  :: Bool-  -- | The sandbox directory.-  , sandbox       :: Maybe FilePath   -- | Line separator string.   , lineSeparator :: LineSeparator   }@@ -34,7 +32,6 @@   , operators     = False   , detailed      = False   , expandSplice  = False-  , sandbox       = Nothing   , lineSeparator = LineSeparator "\0"   } @@ -85,24 +82,21 @@   , cradleCabalDir    :: Maybe FilePath   -- | The file name of the found cabal file.   , cradleCabalFile   :: Maybe FilePath-  -- | The sandbox directory. (e.g. \"\/foo\/bar\/packages-\<ver\>.conf/\")-  , cradlePackageConf :: Maybe FilePath+  -- | The package db options. ([\"-no-user-package-db\",\"-package-db\",\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\"])+  , cradlePackageDbOpts :: [GHCOption]   } deriving (Eq, Show)  ---------------------------------------------------------------- --- | A single GHC option, as it would appear on the command line.+-- | A single GHC command line option. type GHCOption  = String --- | Include directories for modules+-- | An include directory for modules. type IncludeDir = FilePath --- | Package names+-- | A package name. type Package    = String --- | GHC version in 'String'.-type GHCVersion = String- -- | Haskell expression. type Expression = String @@ -110,3 +104,10 @@ type ModuleString = String  data CheckSpeed = Slow | Fast++-- | Option information for GHC+data CompilerOptions = CompilerOptions {+    ghcOptions  :: [GHCOption]  -- ^ Command line options+  , includeDirs :: [IncludeDir] -- ^ Include directories for modules+  , depPackages :: [Package]    -- ^ Dependent package names+  } deriving (Eq, Show)

@@ -1,5 +1,5 @@ Name:                   ghc-mod-Version:                3.0.2+Version:                3.1.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -86,6 +86,15 @@                       , filepath                       , ghc                       , ghc-mod++Test-Suite doctest+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  HS-Source-Dirs:       test+  Ghc-Options:          -threaded -Wall+  Main-Is:              doctests.hs+  Build-Depends:        base+                      , doctest >= 0.9.3  Test-Suite spec   Default-Language:     Haskell2010

@@ -55,9 +55,6 @@           , Option "d" ["detailed"]             (NoArg (\opts -> opts { detailed = True }))             "print detailed info"-          , Option "s" ["sandbox"]-            (ReqArg (\s opts -> opts { sandbox = Just s }) "path")-            "specify a sandbox"           , Option "b" ["boundary"]             (ReqArg (\s opts -> opts { lineSeparator = LineSeparator s }) "sep")             "specify line separator (default is Nul string)"@@ -87,11 +84,9 @@     hSetEncoding stdout utf8 -- #endif     args <- getArgs-    let (opt',cmdArg) = parseArgs argspec args-    (strVer,ver) <- getGHCVersion-    cradle <- findCradle (sandbox opt') strVer-    let opt = adjustOpts opt' cradle ver-        cmdArg0 = cmdArg !. 0+    let (opt,cmdArg) = parseArgs argspec args+    cradle <- findCradle+    let cmdArg0 = cmdArg !. 0         cmdArg1 = cmdArg !. 1         cmdArg2 = cmdArg !. 2         cmdArg3 = cmdArg !. 3@@ -105,7 +100,7 @@       "list"   -> listModules opt       "check"  -> checkSyntax opt cradle remainingArgs       "expand" -> checkSyntax opt { expandSplice = True } cradle remainingArgs-      "debug"  -> nArgs 1 $ debugInfo opt cradle strVer cmdArg1+      "debug"  -> nArgs 1 $ debugInfo opt cradle cmdArg1       "type"   -> nArgs 4 $ typeExpr opt cradle cmdArg1 cmdArg2 (read cmdArg3) (read cmdArg4)       "info"   -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg2 cmdArg3       "lint"   -> nArgs 1 withFile (lintSyntax opt) cmdArg1@@ -148,13 +143,6 @@     xs !. idx       | length xs <= idx = throw SafeList       | otherwise = xs !! idx-    adjustOpts opt cradle ver = case mPkgConf of-            Nothing      -> opt-            Just pkgConf -> opt {-                ghcOpts = ghcPackageConfOptions ver pkgConf ++ ghcOpts opt-              }-      where-        mPkgConf = cradlePackageConf cradle  ---------------------------------------------------------------- @@ -169,9 +157,3 @@   , "Data.Maybe"   , "System.IO"   ]---ghcPackageConfOptions :: Int -> String -> [String]-ghcPackageConfOptions ver file-  | ver >= 706 = ["-package-db",   file, "-no-user-package-db"]-  | otherwise  = ["-package-conf", file, "-no-user-package-conf"]

@@ -4,15 +4,32 @@  import Control.Applicative import Control.Exception+import Data.Maybe import Language.Haskell.GhcMod.CabalApi+import Language.Haskell.GhcMod.Cradle+import Language.Haskell.GhcMod.Types import Test.Hspec +import Dir+ spec :: Spec spec = do     describe "parseCabalFile" $ do         it "throws an exception if the cabal file is broken" $ do             parseCabalFile "test/data/broken-cabal/broken.cabal" `shouldThrow` (\(_::IOException) -> True) +    describe "getCompilerOptions" $ do+        it "gets necessary CompilerOptions" $ do+            withDirectory "test/data/subdir1/subdir2" $ \dir -> do+                cradle <- findCradle+                pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle+                res <- getCompilerOptions [] cradle pkgDesc+                let res' = res {+                        ghcOptions  = map (toRelativeDir dir) (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"]}+     describe "cabalDependPackages" $ do         it "extracts dependent packages" $ do             pkgs <- cabalDependPackages . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"@@ -22,8 +39,11 @@         it "extracts all hs-source-dirs" $ do             dirs <- cabalSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal"             dirs `shouldBe` ["src", "test"]+        it "extracts all hs-source-dirs including \".\"" $ do+            dirs <- cabalSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"+            dirs `shouldBe` [".", "test"] -    describe "cabalBuildInfo" $ do+    describe "cabalAllBuildInfo" $ do         it "extracts build info" $ do             info <- cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal"             show info `shouldBe` "[BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\".\"], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]"

@@ -12,26 +12,24 @@     describe "checkSyntax" $ do         it "can check even if an executable depends on its library" $ do             withDirectory_ "test/data/ghc-mod-check" $ do-                (strVer,_) <- getGHCVersion-                cradle <- findCradle Nothing strVer+                cradle <- findCradle                 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 <- getGHCVersion >>= findCradle Nothing . fst+                cradle <- findCradle                 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-                (strVer,_) <- getGHCVersion-                cradle <- findCradle Nothing strVer+                cradle <- findCradle                 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 <- getGHCVersion >>= findCradle Nothing . fst+                cradle <- findCradle                 res <- checkSyntax defaultOptions cradle ["Baz.hs"]                 res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)

@@ -7,9 +7,8 @@  checkFast :: String -> String -> IO () checkFast file ans = withDirectory_ "test/data" $ do-    (strVer,_) <- getGHCVersion-    cradle <- findCradle Nothing strVer-    res <- debugInfo defaultOptions cradle strVer file+    let cradle = Cradle "." Nothing Nothing []+    res <- debugInfo defaultOptions cradle file     lines res `shouldContain` [ans]  spec :: Spec

@@ -1,7 +1,9 @@ module Dir where -import System.Directory import Control.Exception as E+import Data.List (isPrefixOf)+import System.Directory+import System.FilePath (addTrailingPathSeparator)  withDirectory_ :: FilePath -> IO a -> IO a withDirectory_ dir action = bracket getCurrentDirectory@@ -12,3 +14,11 @@ withDirectory dir action = bracket getCurrentDirectory                                    setCurrentDirectory                                    (\d -> setCurrentDirectory dir >> action d)++toRelativeDir :: FilePath -> FilePath -> FilePath+toRelativeDir dir file+  | dir' `isPrefixOf` file = drop len file+  | otherwise              = file+  where+    dir' = addTrailingPathSeparator dir+    len = length dir'

@@ -13,39 +13,38 @@     describe "typeExpr" $ do         it "shows types of the expression and its outers" $ do             withDirectory_ "test/data/ghc-mod-check" $ do-                (strVer,_) <- getGHCVersion-                cradle <- findCradle Nothing strVer+                cradle <- findCradle                 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 <- getGHCVersion >>= findCradle Nothing . fst+                cradle <- findCradle                 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 <- getGHCVersion >>= findCradle Nothing . fst+                cradle <- findCradle                 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 <- getGHCVersion >>= findCradle Nothing . fst+                cradle <- findCradle                 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 <- getGHCVersion >>= findCradle Nothing . fst+                cradle <- findCradle                 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 <- getGHCVersion >>= findCradle Nothing . fst+                cradle <- findCradle                 res <- infoExpr defaultOptions cradle "Main.hs" "Main" "bar"                 res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) 

@@ -0,0 +1,10 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest [+    "-package"+  , "ghc"+  , "Language/Haskell/GhcMod.hs"+  ]