Merge branch 'dev' of git://github.com/DanielG/ghc-mod into DanielG-dev
This commit is contained in:
		
						commit
						2dc1eb645a
					
				| @ -9,6 +9,9 @@ module Language.Haskell.GhcMod.CabalApi ( | |||||||
|   , cabalAllTargets |   , cabalAllTargets | ||||||
|   ) where |   ) where | ||||||
| 
 | 
 | ||||||
|  | import Language.Haskell.GhcMod.Types | ||||||
|  | import Language.Haskell.GhcMod.GhcPkg | ||||||
|  | 
 | ||||||
| import Control.Applicative ((<$>)) | import Control.Applicative ((<$>)) | ||||||
| import Control.Exception (throwIO) | import Control.Exception (throwIO) | ||||||
| import Control.Monad (filterM) | import Control.Monad (filterM) | ||||||
| @ -30,18 +33,20 @@ import Distribution.System (buildPlatform) | |||||||
| import Distribution.Text (display) | import Distribution.Text (display) | ||||||
| import Distribution.Verbosity (silent) | import Distribution.Verbosity (silent) | ||||||
| import Distribution.Version (Version) | import Distribution.Version (Version) | ||||||
| import Language.Haskell.GhcMod.Types |  | ||||||
| import Language.Haskell.GhcMod.Cradle |  | ||||||
| import System.Directory (doesFileExist) | import System.Directory (doesFileExist) | ||||||
| import System.FilePath (dropExtension, takeFileName, (</>)) | import System.FilePath (dropExtension, takeFileName, (</>)) | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| -- | Getting necessary 'CompilerOptions' from three information sources. | -- | Getting necessary 'CompilerOptions' from three information sources. | ||||||
| getCompilerOptions :: [GHCOption] -> Cradle -> PackageDescription -> IO CompilerOptions | getCompilerOptions :: [GHCOption] | ||||||
|  |                    -> Cradle | ||||||
|  |                    -> PackageDescription | ||||||
|  |                    -> IO CompilerOptions | ||||||
| getCompilerOptions ghcopts cradle pkgDesc = do | getCompilerOptions ghcopts cradle pkgDesc = do | ||||||
|     gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos |     gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos | ||||||
|     return $ CompilerOptions gopts idirs depPkgs |     dbPkgs <- getPackageDbPackages rdir | ||||||
|  |     return $ CompilerOptions gopts idirs (depPkgs dbPkgs) | ||||||
|   where |   where | ||||||
|     wdir       = cradleCurrentDir cradle |     wdir       = cradleCurrentDir cradle | ||||||
|     rdir       = cradleRootDir    cradle |     rdir       = cradleRootDir    cradle | ||||||
| @ -49,7 +54,12 @@ getCompilerOptions ghcopts cradle pkgDesc = do | |||||||
|     pkgs       = cradlePackages   cradle |     pkgs       = cradlePackages   cradle | ||||||
|     buildInfos = cabalAllBuildInfo pkgDesc |     buildInfos = cabalAllBuildInfo pkgDesc | ||||||
|     idirs      = includeDirectories rdir wdir $ cabalSourceDirs buildInfos |     idirs      = includeDirectories rdir wdir $ cabalSourceDirs buildInfos | ||||||
|     depPkgs    = attachPackageIds pkgs $ removeThem problematicPackages $ removeMe cfile $ cabalDependPackages buildInfos |     depPkgs ps = attachPackageIds pkgs | ||||||
|  |                    $ removeThem problematicPackages | ||||||
|  |                    $ removeMe cfile | ||||||
|  |                    $ filter (`elem` ps) -- remove packages not available in any | ||||||
|  |                                         -- package dbs | ||||||
|  |                    $ cabalDependPackages buildInfos | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| -- Dependent packages | -- Dependent packages | ||||||
| @ -114,7 +124,7 @@ getGHCOptions ghcopts cradle rdir binfo = do | |||||||
|     let cpps = map ("-optP" ++) $ P.cppOptions binfo ++ cabalCpp |     let cpps = map ("-optP" ++) $ P.cppOptions binfo ++ cabalCpp | ||||||
|     return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps |     return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps | ||||||
|   where |   where | ||||||
|     pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle |     pkgDb = ghcDbStackOpts $ cradlePkgDbStack cradle | ||||||
|     lang = maybe "-XHaskell98" (("-X" ++) . display) $ P.defaultLanguage binfo |     lang = maybe "-XHaskell98" (("-X" ++) . display) $ P.defaultLanguage binfo | ||||||
|     libDirs = map ("-L" ++) $ P.extraLibDirs binfo |     libDirs = map ("-L" ++) $ P.extraLibDirs binfo | ||||||
|     exts = map (("-X" ++) . display) $ P.usedExtensions binfo |     exts = map (("-X" ++) . display) $ P.usedExtensions binfo | ||||||
| @ -211,4 +221,3 @@ cabalAllTargets pd = do | |||||||
|     getExecutableTarget exe = do |     getExecutableTarget exe = do | ||||||
|       let maybeExes = [p </> e | p <- P.hsSourceDirs $ P.buildInfo exe, e <- [P.modulePath exe]] |       let maybeExes = [p </> e | p <- P.hsSourceDirs $ P.buildInfo exe, e <- [P.modulePath exe]] | ||||||
|       liftIO $ filterM doesFileExist maybeExes |       liftIO $ filterM doesFileExist maybeExes | ||||||
| 
 |  | ||||||
|  | |||||||
| @ -3,23 +3,18 @@ | |||||||
| module Language.Haskell.GhcMod.Cradle ( | module Language.Haskell.GhcMod.Cradle ( | ||||||
|     findCradle |     findCradle | ||||||
|   , findCradleWithoutSandbox |   , findCradleWithoutSandbox | ||||||
|   , getPackageDbDir |  | ||||||
|   , getPackageDbPackages |  | ||||||
|   , userPackageDbOptsForGhc |  | ||||||
|   , userPackageDbOptsForGhcPkg |  | ||||||
|   , getSandboxDir |  | ||||||
|   ) where |   ) where | ||||||
| 
 | 
 | ||||||
|  | import Language.Haskell.GhcMod.Types | ||||||
|  | import Language.Haskell.GhcMod.GhcPkg | ||||||
|  | 
 | ||||||
| import Control.Applicative ((<$>)) | import Control.Applicative ((<$>)) | ||||||
| import Control.Exception (SomeException(..)) |  | ||||||
| import qualified Control.Exception as E | import qualified Control.Exception as E | ||||||
| import Control.Exception.IOChoice ((||>)) | import Control.Exception.IOChoice ((||>)) | ||||||
| import Control.Monad (filterM) | import Control.Monad (filterM) | ||||||
| import Data.Char (isSpace) | import Data.List (isSuffixOf) | ||||||
| import Data.List (isPrefixOf, isSuffixOf, tails) |  | ||||||
| import Language.Haskell.GhcMod.Types |  | ||||||
| import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist) | import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist) | ||||||
| import System.FilePath ((</>), takeDirectory, takeFileName) | import System.FilePath ((</>), takeDirectory) | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| @ -35,24 +30,24 @@ findCradle = do | |||||||
| cabalCradle :: FilePath -> IO Cradle | cabalCradle :: FilePath -> IO Cradle | ||||||
| cabalCradle wdir = do | cabalCradle wdir = do | ||||||
|     (rdir,cfile) <- cabalDir wdir |     (rdir,cfile) <- cabalDir wdir | ||||||
|     pkgDbOpts <- getPackageDb rdir |     pkgDbStack <- getPackageDbStack rdir | ||||||
|     return Cradle { |     return Cradle { | ||||||
|         cradleCurrentDir = wdir |         cradleCurrentDir = wdir | ||||||
|       , cradleRootDir    = rdir |       , cradleRootDir    = rdir | ||||||
|       , cradleCabalFile  = Just cfile |       , cradleCabalFile  = Just cfile | ||||||
|       , cradlePackageDb  = pkgDbOpts |       , cradlePkgDbStack = pkgDbStack | ||||||
|       , cradlePackages   = [] |       , cradlePackages   = [] | ||||||
|       } |       } | ||||||
| 
 | 
 | ||||||
| sandboxCradle :: FilePath -> IO Cradle | sandboxCradle :: FilePath -> IO Cradle | ||||||
| sandboxCradle wdir = do | sandboxCradle wdir = do | ||||||
|     rdir <- getSandboxDir wdir |     rdir <- getSandboxDir wdir | ||||||
|     pkgDbOpts <- getPackageDb rdir |     pkgDbStack <- getPackageDbStack rdir | ||||||
|     return Cradle { |     return Cradle { | ||||||
|         cradleCurrentDir = wdir |         cradleCurrentDir = wdir | ||||||
|       , cradleRootDir    = rdir |       , cradleRootDir    = rdir | ||||||
|       , cradleCabalFile  = Nothing |       , cradleCabalFile  = Nothing | ||||||
|       , cradlePackageDb  = pkgDbOpts |       , cradlePkgDbStack = pkgDbStack | ||||||
|       , cradlePackages   = [] |       , cradlePackages   = [] | ||||||
|       } |       } | ||||||
| 
 | 
 | ||||||
| @ -61,7 +56,7 @@ plainCradle wdir = return Cradle { | |||||||
|         cradleCurrentDir = wdir |         cradleCurrentDir = wdir | ||||||
|       , cradleRootDir    = wdir |       , cradleRootDir    = wdir | ||||||
|       , cradleCabalFile  = Nothing |       , cradleCabalFile  = Nothing | ||||||
|       , cradlePackageDb  = Nothing |       , cradlePkgDbStack = [GlobalDb] | ||||||
|       , cradlePackages   = [] |       , cradlePackages   = [] | ||||||
|       } |       } | ||||||
| 
 | 
 | ||||||
| @ -69,7 +64,7 @@ plainCradle wdir = return Cradle { | |||||||
| findCradleWithoutSandbox :: IO Cradle | findCradleWithoutSandbox :: IO Cradle | ||||||
| findCradleWithoutSandbox = do | findCradleWithoutSandbox = do | ||||||
|     cradle <- findCradle |     cradle <- findCradle | ||||||
|     return cradle { cradlePackageDb = Nothing, cradlePackages = [] } |     return cradle { cradlePkgDbStack = [GlobalDb], cradlePackages = [] } | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| @ -103,121 +98,6 @@ getCabalFiles dir = getFiles >>= filterM doesCabalFileExist | |||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
| configFile :: String |  | ||||||
| configFile = "cabal.sandbox.config" |  | ||||||
| 
 |  | ||||||
| pkgDbKey :: String |  | ||||||
| pkgDbKey = "package-db:" |  | ||||||
| 
 |  | ||||||
| pkgDbKeyLen :: Int |  | ||||||
| pkgDbKeyLen = length pkgDbKey |  | ||||||
| 
 |  | ||||||
| -- | Obtaining GHC options relating to a package db directory |  | ||||||
| getPackageDb :: FilePath -> IO (Maybe FilePath) |  | ||||||
| getPackageDb cdir = (Just <$> getPkgDb) `E.catch` handler |  | ||||||
|   where |  | ||||||
|     getPkgDb = getPackageDbDir (cdir </> configFile) |  | ||||||
|     handler :: SomeException -> IO (Maybe FilePath) |  | ||||||
|     handler _ = return Nothing |  | ||||||
| 
 |  | ||||||
| -- | 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 = dropWhileEnd isSpace . dropWhile isSpace . drop pkgDbKeyLen |  | ||||||
|     -- dropWhileEnd is not provided prior to base 4.5.0.0. |  | ||||||
|     dropWhileEnd :: (a -> Bool) -> [a] -> [a] |  | ||||||
|     dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] |  | ||||||
| 
 |  | ||||||
| -- | Creating user package db options for GHC. |  | ||||||
| -- |  | ||||||
| -- >>> userPackageDbOptsForGhc (Just "/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"] |  | ||||||
| -- >>> userPackageDbOptsForGhc (Just "/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"] |  | ||||||
| userPackageDbOptsForGhc :: Maybe FilePath -> [String] |  | ||||||
| userPackageDbOptsForGhc Nothing      = [] |  | ||||||
| userPackageDbOptsForGhc (Just pkgDb) = [noUserPkgDbOpt, pkgDbOpt, pkgDb] |  | ||||||
|   where |  | ||||||
|     ver = extractGhcVer pkgDb |  | ||||||
|     (noUserPkgDbOpt,pkgDbOpt) |  | ||||||
|       | ver < 706 = ("-no-user-package-conf", "-package-conf") |  | ||||||
|       | otherwise = ("-no-user-package-db",   "-package-db") |  | ||||||
| 
 |  | ||||||
| -- | Creating user package db options for ghc-pkg. |  | ||||||
| -- |  | ||||||
| -- >>> userPackageDbOptsForGhcPkg (Just "/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"] |  | ||||||
| -- >>> userPackageDbOptsForGhcPkg (Just "/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"] |  | ||||||
| userPackageDbOptsForGhcPkg :: Maybe FilePath -> [String] |  | ||||||
| userPackageDbOptsForGhcPkg Nothing      = [] |  | ||||||
| userPackageDbOptsForGhcPkg (Just pkgDb) = [noUserPkgDbOpt, pkgDbOpt] |  | ||||||
|   where |  | ||||||
|     ver = extractGhcVer pkgDb |  | ||||||
|     (noUserPkgDbOpt,pkgDbOpt) |  | ||||||
|       | ver < 706 = ("--no-user-package-conf", "--package-conf=" ++ pkgDb) |  | ||||||
|       | otherwise = ("--no-user-package-db",   "--package-db="   ++ pkgDb) |  | ||||||
| 
 |  | ||||||
| -- | 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 |  | ||||||
| 
 |  | ||||||
| -- | Obtaining packages installed in a package db directory. |  | ||||||
| getPackageDbPackages :: FilePath -> IO [Package] |  | ||||||
| getPackageDbPackages cdir = (getPkgDb >>= listDbPackages) `E.catch` handler |  | ||||||
|   where |  | ||||||
|     getPkgDb = getPackageDbDir (cdir </> configFile) |  | ||||||
|     handler :: SomeException -> IO [Package] |  | ||||||
|     handler _ = return [] |  | ||||||
| 
 |  | ||||||
| listDbPackages :: FilePath -> IO [Package] |  | ||||||
| listDbPackages pkgdir = do |  | ||||||
|   files <- filter (".conf" `isSuffixOf`) <$> getDirectoryContents pkgdir |  | ||||||
|   mapM (extractPackage . (pkgdir </>)) files |  | ||||||
| 
 |  | ||||||
| extractPackage :: FilePath -> IO Package |  | ||||||
| extractPackage pconf = do |  | ||||||
|   contents <- lines <$> readFile pconf |  | ||||||
|   -- Be strict to ensure that an error can be caught. |  | ||||||
|   let !name = extractName $ parseName contents |  | ||||||
|       !pid = extractId $ parseId contents |  | ||||||
|   return (name, Just pid) |  | ||||||
|   where |  | ||||||
|     parseName = parse nameKey |  | ||||||
|     extractName = extract nameKeyLength |  | ||||||
|     parseId = parse idKey |  | ||||||
|     extractId = extract idKeyLength |  | ||||||
|     parse key = head . filter (key `isPrefixOf`) |  | ||||||
|     extract keylen = takeWhile (not . isSpace) . dropWhile isSpace . drop keylen |  | ||||||
| 
 |  | ||||||
| nameKey :: String |  | ||||||
| nameKey = "name:" |  | ||||||
| 
 |  | ||||||
| idKey :: String |  | ||||||
| idKey = "id:" |  | ||||||
| 
 |  | ||||||
| nameKeyLength :: Int |  | ||||||
| nameKeyLength = length nameKey |  | ||||||
| 
 |  | ||||||
| idKeyLength :: Int |  | ||||||
| idKeyLength = length idKey |  | ||||||
| 
 |  | ||||||
| getSandboxDir :: FilePath -> IO FilePath | getSandboxDir :: FilePath -> IO FilePath | ||||||
| getSandboxDir dir = do | getSandboxDir dir = do | ||||||
|     exist <- doesFileExist sfile |     exist <- doesFileExist sfile | ||||||
| @ -228,5 +108,5 @@ getSandboxDir dir = do | |||||||
|       else |       else | ||||||
|         getSandboxDir dir' |         getSandboxDir dir' | ||||||
|   where |   where | ||||||
|     sfile = dir </> configFile |     sfile = dir </> "cabal.sandbox.config" | ||||||
|     dir' = takeDirectory dir |     dir' = takeDirectory dir | ||||||
|  | |||||||
| @ -51,7 +51,9 @@ debug opt cradle fileName = do | |||||||
|     cabalFile = fromMaybe "" mCabalFile |     cabalFile = fromMaybe "" mCabalFile | ||||||
|     origGopts = ghcOpts opt |     origGopts = ghcOpts opt | ||||||
|     simpleCompilerOption = CompilerOptions origGopts [] [] |     simpleCompilerOption = CompilerOptions origGopts [] [] | ||||||
|     fromCabalFile = parseCabalFile file >>= getCompilerOptions origGopts cradle |     fromCabalFile = do | ||||||
|  |         pkgDesc <- parseCabalFile file | ||||||
|  |         getCompilerOptions origGopts cradle pkgDesc | ||||||
|       where |       where | ||||||
|         file = fromJust mCabalFile |         file = fromJust mCabalFile | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -11,6 +11,11 @@ module Language.Haskell.GhcMod.GHCApi ( | |||||||
|   , getSystemLibDir |   , getSystemLibDir | ||||||
|   ) where |   ) where | ||||||
| 
 | 
 | ||||||
|  | import Language.Haskell.GhcMod.CabalApi | ||||||
|  | import Language.Haskell.GhcMod.ErrMsg | ||||||
|  | import Language.Haskell.GhcMod.GHCChoice | ||||||
|  | import Language.Haskell.GhcMod.GhcPkg | ||||||
|  | 
 | ||||||
| import Control.Applicative (Alternative, (<$>)) | import Control.Applicative (Alternative, (<$>)) | ||||||
| import Control.Monad (void, forM) | import Control.Monad (void, forM) | ||||||
| import CoreMonad (liftIO) | import CoreMonad (liftIO) | ||||||
| @ -20,10 +25,6 @@ import DynFlags (dopt_set) | |||||||
| import Exception (ghandle, SomeException(..)) | import Exception (ghandle, SomeException(..)) | ||||||
| import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..)) | import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..)) | ||||||
| import qualified GHC as G | import qualified GHC as G | ||||||
| import Language.Haskell.GhcMod.CabalApi |  | ||||||
| import Language.Haskell.GhcMod.Cradle (userPackageDbOptsForGhc) |  | ||||||
| import Language.Haskell.GhcMod.ErrMsg |  | ||||||
| import Language.Haskell.GhcMod.GHCChoice |  | ||||||
| import qualified Language.Haskell.GhcMod.Gap as Gap | import qualified Language.Haskell.GhcMod.Gap as Gap | ||||||
| import Language.Haskell.GhcMod.Types | import Language.Haskell.GhcMod.Types | ||||||
| import System.Exit (exitSuccess) | import System.Exit (exitSuccess) | ||||||
| @ -89,10 +90,10 @@ initializeFlagsWithCradle opt cradle ghcopts logging | |||||||
|         logger <- initSession SingleFile opt compOpts logging |         logger <- initSession SingleFile opt compOpts logging | ||||||
|         return (logger, Nothing) |         return (logger, Nothing) | ||||||
|       where |       where | ||||||
|         pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle |         pkgOpts = ghcDbStackOpts $ cradlePkgDbStack cradle | ||||||
|         compOpts |         compOpts | ||||||
|           | null pkgDb = CompilerOptions ghcopts importDirs [] |           | null pkgOpts = CompilerOptions ghcopts importDirs [] | ||||||
|           | otherwise  = CompilerOptions (ghcopts ++ pkgDb) [wdir,rdir] [] |           | otherwise    = CompilerOptions (ghcopts ++ pkgOpts) [wdir,rdir] [] | ||||||
|         wdir = cradleCurrentDir cradle |         wdir = cradleCurrentDir cradle | ||||||
|         rdir = cradleRootDir    cradle |         rdir = cradleRootDir    cradle | ||||||
| 
 | 
 | ||||||
|  | |||||||
							
								
								
									
										148
									
								
								Language/Haskell/GhcMod/GhcPkg.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										148
									
								
								Language/Haskell/GhcMod/GhcPkg.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,148 @@ | |||||||
|  | {-# LANGUAGE BangPatterns, ScopedTypeVariables #-} | ||||||
|  | module Language.Haskell.GhcMod.GhcPkg ( | ||||||
|  |     ghcPkgList | ||||||
|  |   , ghcPkgDbOpt | ||||||
|  |   , ghcPkgDbStackOpts | ||||||
|  |   , ghcDbStackOpts | ||||||
|  |   , ghcDbOpt | ||||||
|  |   , getSandboxDb | ||||||
|  |   , getPackageDbStack | ||||||
|  |   , getPackageDbPackages | ||||||
|  |   ) where | ||||||
|  | 
 | ||||||
|  | import Language.Haskell.GhcMod.Types | ||||||
|  | 
 | ||||||
|  | import Control.Applicative ((<$>)) | ||||||
|  | import Control.Exception (SomeException(..)) | ||||||
|  | import qualified Control.Exception as E | ||||||
|  | --import Control.Exception.IOChoice ((||>)) | ||||||
|  | import Data.Char (isSpace) | ||||||
|  | import Data.List (isPrefixOf, tails) | ||||||
|  | import System.FilePath ((</>), takeFileName) | ||||||
|  | import System.Process (readProcess) | ||||||
|  | 
 | ||||||
|  | import Config (cProjectVersionInt) -- ghc version | ||||||
|  | 
 | ||||||
|  | ghcVersion :: Int | ||||||
|  | ghcVersion = read cProjectVersionInt | ||||||
|  | 
 | ||||||
|  | -- | Get path to sandbox package db | ||||||
|  | getSandboxDb :: FilePath -- ^ Path to the cabal package root directory | ||||||
|  |                          -- (containing the @cabal.sandbox.config@ file) | ||||||
|  |              -> IO FilePath | ||||||
|  | getSandboxDb cdir = | ||||||
|  |     getSandboxDbDir (cdir </> "cabal.sandbox.config") | ||||||
|  | 
 | ||||||
|  | -- | Extract the sandbox package db directory from the cabal.sandbox.config file. | ||||||
|  | --   Exception is thrown if the sandbox config file is broken. | ||||||
|  | getSandboxDbDir :: FilePath -- ^ Path to the @cabal.sandbox.config@ file | ||||||
|  |                 -> IO FilePath | ||||||
|  | getSandboxDbDir sconf = do | ||||||
|  |     -- Be strict to ensure that an error can be caught. | ||||||
|  |     !path <- extractValue . parse <$> readFile sconf | ||||||
|  |     return path | ||||||
|  |   where | ||||||
|  |     key = "package-db:" | ||||||
|  |     keyLen = length key | ||||||
|  | 
 | ||||||
|  |     parse = head . filter (key `isPrefixOf`) . lines | ||||||
|  |     extractValue = dropWhileEnd isSpace . dropWhile isSpace . drop keyLen | ||||||
|  |     -- dropWhileEnd is not provided prior to base 4.5.0.0. | ||||||
|  |     dropWhileEnd :: (a -> Bool) -> [a] -> [a] | ||||||
|  |     dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) [] | ||||||
|  | 
 | ||||||
|  | -- | Get a list of packages from the global, user or cabal sandbox package | ||||||
|  | -- database. | ||||||
|  | -- | ||||||
|  | --   If a sandbox exists this will return packages from the global package db | ||||||
|  | --   and the sandbox, otherwise packages from the global and user package db are | ||||||
|  | --   returned. | ||||||
|  | getPackageDbPackages :: FilePath -- ^ Project Directory (where the | ||||||
|  |                                  -- cabal.sandbox.config file would be if it | ||||||
|  |                                  -- exists) | ||||||
|  |                      -> IO [PackageBaseName] | ||||||
|  | getPackageDbPackages cdir = | ||||||
|  |     ghcPkgList =<< getPackageDbStack cdir | ||||||
|  | 
 | ||||||
|  | getPackageDbStack :: FilePath -- ^ Project Directory (where the | ||||||
|  |                                  -- cabal.sandbox.config file would be if it | ||||||
|  |                                  -- exists) | ||||||
|  |                   -> IO [GhcPkgDb] | ||||||
|  | getPackageDbStack cdir = | ||||||
|  |     (getSandboxDb cdir >>= \db -> return [GlobalDb, PackageDb db]) | ||||||
|  |       `E.catch` \(_ :: SomeException) -> return [GlobalDb, UserDb] | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
|  | -- | List packages in one or more ghc package stores | ||||||
|  | ghcPkgList :: [GhcPkgDb] -> IO [PackageBaseName] | ||||||
|  | ghcPkgList dbs = | ||||||
|  |     words <$> readProcess "ghc-pkg" opts "" | ||||||
|  |   where | ||||||
|  |     opts = | ||||||
|  |         ["--simple-output", "--names-only", "list"] | ||||||
|  |           ++ ghcPkgDbStackOpts dbs | ||||||
|  | 
 | ||||||
|  | -- | Get options needed to add a list of package dbs to ghc-pkg's db stack | ||||||
|  | ghcPkgDbStackOpts :: [GhcPkgDb] -- ^ Package db stack | ||||||
|  |                   -> [String] | ||||||
|  | ghcPkgDbStackOpts dbs = (ghcPkgDbOpt `concatMap` dbs) | ||||||
|  | 
 | ||||||
|  | -- | Get options needed to add a list of package dbs to ghc's db stack | ||||||
|  | ghcDbStackOpts :: [GhcPkgDb] -- ^ Package db stack | ||||||
|  |                   -> [String] | ||||||
|  | ghcDbStackOpts dbs = (ghcDbOpt `concatMap` dbs) | ||||||
|  | 
 | ||||||
|  | ghcPkgDbOpt :: GhcPkgDb -> [String] | ||||||
|  | ghcPkgDbOpt GlobalDb = ["--global"] | ||||||
|  | ghcPkgDbOpt UserDb   = ["--user"] | ||||||
|  | ghcPkgDbOpt (PackageDb pkgDb) | ||||||
|  |     | ghcVersion < 706 = ["--no-user-package-conf", "--package-conf=" ++ pkgDb] | ||||||
|  |     | otherwise = ["--no-user-package-db",   "--package-db="   ++ pkgDb] | ||||||
|  | 
 | ||||||
|  | ghcDbOpt :: GhcPkgDb -> [String] | ||||||
|  | ghcDbOpt GlobalDb | ghcVersion < 706 = ["-global-package-conf"] | ||||||
|  |                   | otherwise = ["-global-package-db"] | ||||||
|  | ghcDbOpt UserDb   | ghcVersion < 706 = ["-user-package-conf"] | ||||||
|  |                   | otherwise = ["-user-package-db"] | ||||||
|  | ghcDbOpt (PackageDb pkgDb) | ||||||
|  |     | ghcVersion < 706 = ["-no-user-package-conf", "-package-conf", pkgDb] | ||||||
|  |     | otherwise = ["-no-user-package-db",   "-package-db",   pkgDb] | ||||||
|  | 
 | ||||||
|  | -- getPackageDbPackages :: FilePath -> IO [Package] | ||||||
|  | -- getPackageDbPackages cdir = (getPkgDb >>= listDbPackages) `E.catch` handler | ||||||
|  | --   where | ||||||
|  | --     getPkgDb = getPackageDbDir (cdir </> configFile) | ||||||
|  | --     handler :: SomeException -> IO [Package] | ||||||
|  | --     handler _ = return [] | ||||||
|  | 
 | ||||||
|  | -- listDbPackages :: FilePath -> IO [Package] | ||||||
|  | -- listDbPackages pkgdir = do | ||||||
|  | --   files <- filter (".conf" `isSuffixOf`) <$> getDirectoryContents pkgdir | ||||||
|  | --   mapM (extractPackage . (pkgdir </>)) files | ||||||
|  | 
 | ||||||
|  | -- extractPackage :: FilePath -> IO Package | ||||||
|  | -- extractPackage pconf = do | ||||||
|  | --   contents <- lines <$> readFile pconf | ||||||
|  | --   -- Be strict to ensure that an error can be caught. | ||||||
|  | --   let !name = extractName $ parseName contents | ||||||
|  | --       !pid = extractId $ parseId contents | ||||||
|  | --   return (name, Just pid) | ||||||
|  | --   where | ||||||
|  | --     parseName = parse nameKey | ||||||
|  | --     extractName = extract nameKeyLength | ||||||
|  | --     parseId = parse idKey | ||||||
|  | --     extractId = extract idKeyLength | ||||||
|  | --     parse key = head . filter (key `isPrefixOf`) | ||||||
|  | --     extract keylen = takeWhile (not . isSpace) . dropWhile isSpace . drop keylen | ||||||
|  | 
 | ||||||
|  | -- nameKey :: String | ||||||
|  | -- nameKey = "name:" | ||||||
|  | 
 | ||||||
|  | -- idKey :: String | ||||||
|  | -- idKey = "id:" | ||||||
|  | 
 | ||||||
|  | -- nameKeyLength :: Int | ||||||
|  | -- nameKeyLength = length nameKey | ||||||
|  | 
 | ||||||
|  | -- idKeyLength :: Int | ||||||
|  | -- idKeyLength = length idKey | ||||||
| @ -7,9 +7,6 @@ module Language.Haskell.GhcMod.Internal ( | |||||||
|   , Package |   , Package | ||||||
|   , IncludeDir |   , IncludeDir | ||||||
|   , CompilerOptions(..) |   , CompilerOptions(..) | ||||||
|   -- * Cradle |  | ||||||
|   , userPackageDbOptsForGhc |  | ||||||
|   , userPackageDbOptsForGhcPkg |  | ||||||
|   -- * Cabal API |   -- * Cabal API | ||||||
|   , parseCabalFile |   , parseCabalFile | ||||||
|   , getCompilerOptions |   , getCompilerOptions | ||||||
| @ -38,7 +35,6 @@ module Language.Haskell.GhcMod.Internal ( | |||||||
| 
 | 
 | ||||||
| import Language.Haskell.GhcMod.Browse | import Language.Haskell.GhcMod.Browse | ||||||
| import Language.Haskell.GhcMod.CabalApi | import Language.Haskell.GhcMod.CabalApi | ||||||
| import Language.Haskell.GhcMod.Cradle |  | ||||||
| import Language.Haskell.GhcMod.ErrMsg | import Language.Haskell.GhcMod.ErrMsg | ||||||
| import Language.Haskell.GhcMod.GHCApi | import Language.Haskell.GhcMod.GHCApi | ||||||
| import Language.Haskell.GhcMod.GHCChoice | import Language.Haskell.GhcMod.GHCChoice | ||||||
|  | |||||||
| @ -1,8 +1,9 @@ | |||||||
| module Language.Haskell.GhcMod.PkgDoc (packageDoc) where | module Language.Haskell.GhcMod.PkgDoc (packageDoc) where | ||||||
| 
 | 
 | ||||||
| import Control.Applicative ((<$>)) |  | ||||||
| import Language.Haskell.GhcMod.Types | import Language.Haskell.GhcMod.Types | ||||||
| import Language.Haskell.GhcMod.Cradle | import Language.Haskell.GhcMod.GhcPkg | ||||||
|  | 
 | ||||||
|  | import Control.Applicative ((<$>)) | ||||||
| import System.Process (readProcess) | import System.Process (readProcess) | ||||||
| 
 | 
 | ||||||
| -- | Obtaining the package name and the doc path of a module. | -- | Obtaining the package name and the doc path of a module. | ||||||
| @ -22,6 +23,8 @@ pkgDoc cradle mdl = do | |||||||
|         let ret = pkg ++ " " ++ drop 14 htmlpath |         let ret = pkg ++ " " ++ drop 14 htmlpath | ||||||
|         return ret |         return ret | ||||||
|   where |   where | ||||||
|     toModuleOpts = ["find-module", mdl, "--simple-output"] ++ userPackageDbOptsForGhcPkg (cradlePackageDb cradle) |     toModuleOpts = ["find-module", mdl, "--simple-output"] | ||||||
|     toDocDirOpts pkg = ["field", pkg, "haddock-html"] ++ userPackageDbOptsForGhcPkg (cradlePackageDb cradle) |                    ++ ghcPkgDbStackOpts (cradlePkgDbStack cradle) | ||||||
|  |     toDocDirOpts pkg = ["field", pkg, "haddock-html"] | ||||||
|  |                        ++ ghcPkgDbStackOpts (cradlePkgDbStack cradle) | ||||||
|     trim = takeWhile (`notElem` " \n") |     trim = takeWhile (`notElem` " \n") | ||||||
|  | |||||||
| @ -88,14 +88,17 @@ data Cradle = Cradle { | |||||||
|   , cradleRootDir    :: FilePath |   , cradleRootDir    :: FilePath | ||||||
|   -- | The file name of the found cabal file. |   -- | The file name of the found cabal file. | ||||||
|   , cradleCabalFile  :: Maybe FilePath |   , cradleCabalFile  :: Maybe FilePath | ||||||
|   -- | User package db. (\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\") |   -- | Package database stack | ||||||
|   , cradlePackageDb  :: Maybe FilePath |   , cradlePkgDbStack  :: [GhcPkgDb] | ||||||
|   -- | Dependent packages. |   -- | Package dependencies | ||||||
|   , cradlePackages   :: [Package] |   , cradlePackages   :: [Package] | ||||||
|   } deriving (Eq, Show) |   } deriving (Eq, Show) | ||||||
| 
 | 
 | ||||||
| ---------------------------------------------------------------- | ---------------------------------------------------------------- | ||||||
| 
 | 
 | ||||||
|  | -- | GHC package database flags. | ||||||
|  | data GhcPkgDb = GlobalDb | UserDb | PackageDb String deriving (Eq, Show) | ||||||
|  | 
 | ||||||
| -- | A single GHC command line option. | -- | A single GHC command line option. | ||||||
| type GHCOption  = String | type GHCOption  = String | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -26,7 +26,7 @@ Data-Files:             Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el | |||||||
| Extra-Source-Files:     ChangeLog | Extra-Source-Files:     ChangeLog | ||||||
| 			test/data/*.cabal | 			test/data/*.cabal | ||||||
|                         test/data/*.hs |                         test/data/*.hs | ||||||
|                         test/data/cabal.sandbox.config |                         test/data/cabal.sandbox.config.in | ||||||
|                         test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/dummy |                         test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/dummy | ||||||
|                         test/data/broken-cabal/*.cabal |                         test/data/broken-cabal/*.cabal | ||||||
|                         test/data/broken-sandbox/*.cabal |                         test/data/broken-sandbox/*.cabal | ||||||
| @ -35,6 +35,8 @@ Extra-Source-Files:     ChangeLog | |||||||
|                         test/data/check-test-subdir/src/Check/Test/*.hs |                         test/data/check-test-subdir/src/Check/Test/*.hs | ||||||
|                         test/data/check-test-subdir/test/*.hs |                         test/data/check-test-subdir/test/*.hs | ||||||
|                         test/data/check-test-subdir/test/Bar/*.hs |                         test/data/check-test-subdir/test/Bar/*.hs | ||||||
|  |                         test/data/check-packageid/cabal.sandbox.config.in | ||||||
|  |                         test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf | ||||||
|                         test/data/ghc-mod-check/*.cabal |                         test/data/ghc-mod-check/*.cabal | ||||||
|                         test/data/ghc-mod-check/*.hs |                         test/data/ghc-mod-check/*.hs | ||||||
|                         test/data/ghc-mod-check/Data/*.hs |                         test/data/ghc-mod-check/Data/*.hs | ||||||
| @ -54,6 +56,7 @@ Library | |||||||
|                         Language.Haskell.GhcMod.ErrMsg |                         Language.Haskell.GhcMod.ErrMsg | ||||||
|                         Language.Haskell.GhcMod.Flag |                         Language.Haskell.GhcMod.Flag | ||||||
|                         Language.Haskell.GhcMod.GHCApi |                         Language.Haskell.GhcMod.GHCApi | ||||||
|  |                         Language.Haskell.GhcMod.GhcPkg | ||||||
|                         Language.Haskell.GhcMod.GHCChoice |                         Language.Haskell.GhcMod.GHCChoice | ||||||
|                         Language.Haskell.GhcMod.Gap |                         Language.Haskell.GhcMod.Gap | ||||||
|                         Language.Haskell.GhcMod.Info |                         Language.Haskell.GhcMod.Info | ||||||
| @ -117,10 +120,11 @@ Test-Suite doctest | |||||||
| 
 | 
 | ||||||
| Test-Suite spec | Test-Suite spec | ||||||
|   Default-Language:     Haskell2010 |   Default-Language:     Haskell2010 | ||||||
|   Main-Is:              Spec.hs |   Main-Is:              Main.hs | ||||||
|   Hs-Source-Dirs:       test, . |   Hs-Source-Dirs:       test, . | ||||||
|   Type:                 exitcode-stdio-1.0 |   Type:                 exitcode-stdio-1.0 | ||||||
|   Other-Modules:        Dir |   Other-Modules:        Dir | ||||||
|  |                         Spec | ||||||
|                         BrowseSpec |                         BrowseSpec | ||||||
|                         CabalApiSpec |                         CabalApiSpec | ||||||
|                         CheckSpec |                         CheckSpec | ||||||
| @ -129,6 +133,7 @@ Test-Suite spec | |||||||
|                         LangSpec |                         LangSpec | ||||||
|                         LintSpec |                         LintSpec | ||||||
|                         ListSpec |                         ListSpec | ||||||
|  |                         GhcPkgSpec | ||||||
|   Build-Depends:        base >= 4.0 && < 5 |   Build-Depends:        base >= 4.0 && < 5 | ||||||
|                       , containers |                       , containers | ||||||
|                       , directory |                       , directory | ||||||
|  | |||||||
| @ -9,9 +9,17 @@ import Language.Haskell.GhcMod.CabalApi | |||||||
| import Language.Haskell.GhcMod.Cradle | import Language.Haskell.GhcMod.Cradle | ||||||
| import Language.Haskell.GhcMod.Types | import Language.Haskell.GhcMod.Types | ||||||
| import Test.Hspec | import Test.Hspec | ||||||
|  | import System.Directory | ||||||
|  | import System.FilePath | ||||||
| 
 | 
 | ||||||
| import Dir | import Dir | ||||||
| 
 | 
 | ||||||
|  | import Config (cProjectVersionInt) -- ghc version | ||||||
|  | 
 | ||||||
|  | ghcVersion :: Int | ||||||
|  | ghcVersion = read cProjectVersionInt | ||||||
|  | 
 | ||||||
|  | 
 | ||||||
| spec :: Spec | spec :: Spec | ||||||
| spec = do | spec = do | ||||||
|     describe "parseCabalFile" $ do |     describe "parseCabalFile" $ do | ||||||
| @ -20,6 +28,7 @@ spec = do | |||||||
| 
 | 
 | ||||||
|     describe "getCompilerOptions" $ do |     describe "getCompilerOptions" $ do | ||||||
|         it "gets necessary CompilerOptions" $ do |         it "gets necessary CompilerOptions" $ do | ||||||
|  |             cwd <- getCurrentDirectory | ||||||
|             withDirectory "test/data/subdir1/subdir2" $ \dir -> do |             withDirectory "test/data/subdir1/subdir2" $ \dir -> do | ||||||
|                 cradle <- findCradle |                 cradle <- findCradle | ||||||
|                 pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle |                 pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle | ||||||
| @ -28,7 +37,10 @@ spec = do | |||||||
|                         ghcOptions  = ghcOptions res |                         ghcOptions  = ghcOptions res | ||||||
|                       , includeDirs = map (toRelativeDir dir) (includeDirs res) |                       , includeDirs = map (toRelativeDir dir) (includeDirs res) | ||||||
|                       } |                       } | ||||||
|                 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", Nothing), ("base", Nothing) , ("template-haskell", Nothing)]} |                 if ghcVersion < 706 | ||||||
|  |                   then res' `shouldBe` CompilerOptions {ghcOptions = ["-global-package-conf", "-no-user-package-conf","-package-conf",cwd </> "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", Nothing), ("base", Nothing) , ("template-haskell", Nothing)]} | ||||||
|  |                   else res' `shouldBe` CompilerOptions {ghcOptions = ["-global-package-db", "-no-user-package-db","-package-db",cwd </> "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", Nothing), ("base", Nothing) , ("template-haskell", Nothing)]} | ||||||
|  | 
 | ||||||
| 
 | 
 | ||||||
|     describe "cabalDependPackages" $ do |     describe "cabalDependPackages" $ do | ||||||
|         it "extracts dependent packages" $ do |         it "extracts dependent packages" $ do | ||||||
|  | |||||||
| @ -4,7 +4,7 @@ import Control.Applicative | |||||||
| import Data.List (isSuffixOf) | import Data.List (isSuffixOf) | ||||||
| import Language.Haskell.GhcMod.Cradle | import Language.Haskell.GhcMod.Cradle | ||||||
| import Language.Haskell.GhcMod.Types | import Language.Haskell.GhcMod.Types | ||||||
| import System.Directory (canonicalizePath) | import System.Directory (canonicalizePath,getCurrentDirectory) | ||||||
| import System.FilePath ((</>), pathSeparator) | import System.FilePath ((</>), pathSeparator) | ||||||
| import Test.Hspec | import Test.Hspec | ||||||
| 
 | 
 | ||||||
| @ -21,17 +21,18 @@ spec = do | |||||||
|                     cradleCurrentDir = curDir |                     cradleCurrentDir = curDir | ||||||
|                   , cradleRootDir    = curDir |                   , cradleRootDir    = curDir | ||||||
|                   , cradleCabalFile  = Nothing |                   , cradleCabalFile  = Nothing | ||||||
|                   , cradlePackageDb  = Nothing |                   , cradlePkgDbStack = [GlobalDb] | ||||||
|                   , cradlePackages   = [] |                   , cradlePackages   = [] | ||||||
|                   } |                   } | ||||||
|         it "finds a cabal file and a sandbox" $ do |         it "finds a cabal file and a sandbox" $ do | ||||||
|  |             cwd <- getCurrentDirectory | ||||||
|             withDirectory "test/data/subdir1/subdir2" $ \dir -> do |             withDirectory "test/data/subdir1/subdir2" $ \dir -> do | ||||||
|                 res <- relativeCradle dir <$> findCradle |                 res <- relativeCradle dir <$> findCradle | ||||||
|                 res `shouldBe` Cradle { |                 res `shouldBe` Cradle { | ||||||
|                     cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2" |                     cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2" | ||||||
|                   , cradleRootDir    = "test" </> "data" |                   , cradleRootDir    = "test" </> "data" | ||||||
|                   , cradleCabalFile  = Just ("test" </> "data" </> "cabalapi.cabal") |                   , cradleCabalFile  = Just ("test" </> "data" </> "cabalapi.cabal") | ||||||
|                   , cradlePackageDb  = Just ("test" </> "data" </> ".cabal-sandbox" </> "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d") |                   , cradlePkgDbStack = [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")] | ||||||
|                   , cradlePackages   = [] |                   , cradlePackages   = [] | ||||||
|                   } |                   } | ||||||
|         it "works even if a sandbox config file is broken" $ do |         it "works even if a sandbox config file is broken" $ do | ||||||
| @ -41,23 +42,10 @@ spec = do | |||||||
|                     cradleCurrentDir = "test" </> "data" </> "broken-sandbox" |                     cradleCurrentDir = "test" </> "data" </> "broken-sandbox" | ||||||
|                   , cradleRootDir    = "test" </> "data" </> "broken-sandbox" |                   , cradleRootDir    = "test" </> "data" </> "broken-sandbox" | ||||||
|                   , cradleCabalFile  = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal") |                   , cradleCabalFile  = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal") | ||||||
|                   , cradlePackageDb  = Nothing |                   , cradlePkgDbStack = [GlobalDb, UserDb] | ||||||
|                   , cradlePackages   = [] |                   , cradlePackages   = [] | ||||||
|                   } |                   } | ||||||
| 
 | 
 | ||||||
|     describe "getPackageDbDir" $ do |  | ||||||
|         it "parses a config file and extracts package db" $ do |  | ||||||
|             pkgDb <- getPackageDbDir "test/data/cabal.sandbox.config" |  | ||||||
|             pkgDb `shouldBe` "/home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d" |  | ||||||
| 
 |  | ||||||
|         it "throws an error if a config file is broken" $ do |  | ||||||
|             getPackageDbDir "test/data/bad.config" `shouldThrow` anyException |  | ||||||
| 
 |  | ||||||
|     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")] |  | ||||||
| 
 |  | ||||||
| relativeCradle :: FilePath -> Cradle -> Cradle | relativeCradle :: FilePath -> Cradle -> Cradle | ||||||
| relativeCradle dir cradle = cradle { | relativeCradle dir cradle = cradle { | ||||||
|     cradleCurrentDir    = toRelativeDir dir  $  cradleCurrentDir cradle |     cradleCurrentDir    = toRelativeDir dir  $  cradleCurrentDir cradle | ||||||
|  | |||||||
							
								
								
									
										27
									
								
								test/GhcPkgSpec.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										27
									
								
								test/GhcPkgSpec.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,27 @@ | |||||||
|  | module GhcPkgSpec where | ||||||
|  | 
 | ||||||
|  | import Language.Haskell.GhcMod.Types | ||||||
|  | import Language.Haskell.GhcMod.GhcPkg | ||||||
|  | 
 | ||||||
|  | import Control.Applicative | ||||||
|  | import System.Directory | ||||||
|  | import System.FilePath ((</>)) | ||||||
|  | import Test.Hspec | ||||||
|  | 
 | ||||||
|  | import Dir | ||||||
|  | 
 | ||||||
|  | spec :: Spec | ||||||
|  | spec = do | ||||||
|  |     describe "getSandboxDb" $ do | ||||||
|  |         it "parses a config file and extracts sandbox package db" $ do | ||||||
|  |             cwd <- getCurrentDirectory | ||||||
|  |             pkgDb <- getSandboxDb "test/data/" | ||||||
|  |             pkgDb `shouldBe` (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d") | ||||||
|  | 
 | ||||||
|  |         it "throws an error if a config file is broken" $ do | ||||||
|  |             getSandboxDb "test/data/broken-sandbox" `shouldThrow` anyException | ||||||
|  | 
 | ||||||
|  |     describe "getPackageDbPackages" $ do | ||||||
|  |         it "find a config file and extracts packages" $ do | ||||||
|  |             pkgs <- getPackageDbPackages "test/data/check-packageid" | ||||||
|  |             pkgs `shouldSatisfy` (\x -> length x >= 1) | ||||||
							
								
								
									
										12
									
								
								test/Main.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										12
									
								
								test/Main.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,12 @@ | |||||||
|  | import Spec | ||||||
|  | import Dir | ||||||
|  | 
 | ||||||
|  | import Test.Hspec | ||||||
|  | import System.Process | ||||||
|  | 
 | ||||||
|  | main = do | ||||||
|  |   let sandboxes = [ "test/data", "test/data/check-packageid" ] | ||||||
|  |       genSandboxCfg dir = withDirectory dir $ \cwd -> do | ||||||
|  |          system ("sed 's|@CWD@|" ++ cwd ++ "|g' cabal.sandbox.config.in > cabal.sandbox.config") | ||||||
|  |   genSandboxCfg `mapM` sandboxes | ||||||
|  |   hspec spec | ||||||
| @ -1 +1 @@ | |||||||
| {-# OPTIONS_GHC -F -pgmF hspec-discover #-} | {-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-} | ||||||
|  | |||||||
| @ -4,15 +4,15 @@ | |||||||
| -- if you want to change the default settings for this sandbox. | -- if you want to change the default settings for this sandbox. | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| local-repo: /home/me/work/ghc-mod/test/data/.cabal-sandbox/packages | local-repo: @CWD@/test/data/.cabal-sandbox/packages | ||||||
| logs-dir: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs | logs-dir: @CWD@/test/data/.cabal-sandbox/logs | ||||||
| world-file: /home/me/work/ghc-mod/test/data/.cabal-sandbox/world | world-file: @CWD@/test/data/.cabal-sandbox/world | ||||||
| user-install: False | user-install: False | ||||||
| package-db: /home/me/work/ghc-mod/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d | package-db: @CWD@/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 | build-summary: @CWD@/test/data/.cabal-sandbox/logs/build.log | ||||||
| 
 | 
 | ||||||
| install-dirs | install-dirs | ||||||
|   prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox |   prefix: @CWD@/test/data/.cabal-sandbox | ||||||
|   bindir: $prefix/bin |   bindir: $prefix/bin | ||||||
|   libdir: $prefix/lib |   libdir: $prefix/lib | ||||||
|   libsubdir: $arch-$os-$compiler/$pkgid |   libsubdir: $arch-$os-$compiler/$pkgid | ||||||
| @ -4,15 +4,15 @@ | |||||||
| -- if you want to change the default settings for this sandbox. | -- if you want to change the default settings for this sandbox. | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| local-repo: /home/me/work/ghc-mod/test/data/.cabal-sandbox/packages | local-repo: @CWD@/test/data/.cabal-sandbox/packages | ||||||
| logs-dir: /home/me/work/ghc-mod/test/data/.cabal-sandbox/logs | logs-dir: @CWD@/test/data/.cabal-sandbox/logs | ||||||
| world-file: /home/me/work/ghc-mod/test/data/.cabal-sandbox/world | world-file: @CWD@/test/data/.cabal-sandbox/world | ||||||
| user-install: False | user-install: False | ||||||
| package-db: test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d | package-db: test/data/check-packageid/.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 | build-summary: @CWD@/test/data/.cabal-sandbox/logs/build.log | ||||||
| 
 | 
 | ||||||
| install-dirs | install-dirs | ||||||
|   prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox |   prefix: @CWD@/test/data/.cabal-sandbox | ||||||
|   bindir: $prefix/bin |   bindir: $prefix/bin | ||||||
|   libdir: $prefix/lib |   libdir: $prefix/lib | ||||||
|   libsubdir: $arch-$os-$compiler/$pkgid |   libsubdir: $arch-$os-$compiler/$pkgid | ||||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 Kazu Yamamoto
						Kazu Yamamoto