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

Merge branch 'dev' of git://github.com/DanielG/ghc-mod into DanielG-dev

Browse Source
This commit is contained in:
Kazu Yamamoto 2014-04-16 11:24:39 +09:00
commit 2dc1eb645a
16 changed files with 278 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
Language/Haskell/GhcMod/CabalApi.hs
View File

@ -9,6 +9,9 @@ module Language.Haskell.GhcMod.CabalApi (
, cabalAllTargets
) where
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.GhcPkg
import Control.Applicative ((<$>))
import Control.Exception (throwIO)
import Control.Monad (filterM)
@ -30,18 +33,20 @@ import Distribution.System (buildPlatform)
import Distribution.Text (display)
import Distribution.Verbosity (silent)
import Distribution.Version (Version)
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Cradle
import System.Directory (doesFileExist)
import System.FilePath (dropExtension, takeFileName, (</>))
----------------------------------------------------------------
-- | Getting necessary 'CompilerOptions' from three information sources.
getCompilerOptions :: [GHCOption] -> Cradle -> PackageDescription -> IO CompilerOptions
getCompilerOptions :: [GHCOption]
-> Cradle
-> PackageDescription
-> IO CompilerOptions
getCompilerOptions ghcopts cradle pkgDesc = do
gopts <- getGHCOptions ghcopts cradle rdir $ head buildInfos
return $ CompilerOptions gopts idirs depPkgs
dbPkgs <- getPackageDbPackages rdir
return $ CompilerOptions gopts idirs (depPkgs dbPkgs)
where
wdir = cradleCurrentDir cradle
rdir = cradleRootDir cradle
@ -49,7 +54,12 @@ getCompilerOptions ghcopts cradle pkgDesc = do
pkgs = cradlePackages cradle
buildInfos = cabalAllBuildInfo pkgDesc
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
@ -114,7 +124,7 @@ getGHCOptions ghcopts cradle rdir binfo = do
let cpps = map ("-optP" ++) $ P.cppOptions binfo ++ cabalCpp
return $ ghcopts ++ pkgDb ++ exts ++ [lang] ++ libs ++ libDirs ++ cpps
where
pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle
pkgDb = ghcDbStackOpts $ cradlePkgDbStack cradle
lang = maybe "-XHaskell98" (("-X" ++) . display) $ P.defaultLanguage binfo
libDirs = map ("-L" ++) $ P.extraLibDirs binfo
exts = map (("-X" ++) . display) $ P.usedExtensions binfo
@ -211,4 +221,3 @@ cabalAllTargets pd = do
getExecutableTarget exe = do
let maybeExes = [p </> e | p <- P.hsSourceDirs $ P.buildInfo exe, e <- [P.modulePath exe]]
liftIO $ filterM doesFileExist maybeExes

144
Language/Haskell/GhcMod/Cradle.hs
View File

@ -3,23 +3,18 @@
module Language.Haskell.GhcMod.Cradle (
findCradle
, findCradleWithoutSandbox
, getPackageDbDir
, getPackageDbPackages
, userPackageDbOptsForGhc
, userPackageDbOptsForGhcPkg
, getSandboxDir
) where
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.GhcPkg
import Control.Applicative ((<$>))
import Control.Exception (SomeException(..))
import qualified Control.Exception as E
import Control.Exception.IOChoice ((||>))
import Control.Monad (filterM)
import Data.Char (isSpace)
import Data.List (isPrefixOf, isSuffixOf, tails)
import Language.Haskell.GhcMod.Types
import Data.List (isSuffixOf)
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 wdir = do
(rdir,cfile) <- cabalDir wdir
pkgDbOpts <- getPackageDb rdir
pkgDbStack <- getPackageDbStack rdir
return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = rdir
, cradleCabalFile = Just cfile
, cradlePackageDb = pkgDbOpts
, cradlePkgDbStack = pkgDbStack
, cradlePackages = []
}
sandboxCradle :: FilePath -> IO Cradle
sandboxCradle wdir = do
rdir <- getSandboxDir wdir
pkgDbOpts <- getPackageDb rdir
pkgDbStack <- getPackageDbStack rdir
return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = rdir
, cradleCabalFile = Nothing
, cradlePackageDb = pkgDbOpts
, cradlePkgDbStack = pkgDbStack
, cradlePackages = []
}
@ -61,7 +56,7 @@ plainCradle wdir = return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = wdir
, cradleCabalFile = Nothing
, cradlePackageDb = Nothing
, cradlePkgDbStack = [GlobalDb]
, cradlePackages = []
}
@ -69,7 +64,7 @@ plainCradle wdir = return Cradle {
findCradleWithoutSandbox :: IO Cradle
findCradleWithoutSandbox = do
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 dir = do
exist <- doesFileExist sfile
@ -228,5 +108,5 @@ getSandboxDir dir = do
else
getSandboxDir dir'
where
sfile = dir </> configFile
sfile = dir </> "cabal.sandbox.config"
dir' = takeDirectory dir

4
Language/Haskell/GhcMod/Debug.hs
View File

@ -51,7 +51,9 @@ debug opt cradle fileName = do
cabalFile = fromMaybe "" mCabalFile
origGopts = ghcOpts opt
simpleCompilerOption = CompilerOptions origGopts [] []
fromCabalFile = parseCabalFile file >>= getCompilerOptions origGopts cradle
fromCabalFile = do
pkgDesc <- parseCabalFile file
getCompilerOptions origGopts cradle pkgDesc
where
file = fromJust mCabalFile

15
Language/Haskell/GhcMod/GHCApi.hs
View File

@ -11,6 +11,11 @@ module Language.Haskell.GhcMod.GHCApi (
, getSystemLibDir
) 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.Monad (void, forM)
import CoreMonad (liftIO)
@ -20,10 +25,6 @@ import DynFlags (dopt_set)
import Exception (ghandle, SomeException(..))
import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..))
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 Language.Haskell.GhcMod.Types
import System.Exit (exitSuccess)
@ -89,10 +90,10 @@ initializeFlagsWithCradle opt cradle ghcopts logging
logger <- initSession SingleFile opt compOpts logging
return (logger, Nothing)
where
pkgDb = userPackageDbOptsForGhc $ cradlePackageDb cradle
pkgOpts = ghcDbStackOpts $ cradlePkgDbStack cradle
compOpts
| null pkgDb = CompilerOptions ghcopts importDirs []
| otherwise = CompilerOptions (ghcopts ++ pkgDb) [wdir,rdir] []
| null pkgOpts = CompilerOptions ghcopts importDirs []
| otherwise = CompilerOptions (ghcopts ++ pkgOpts) [wdir,rdir] []
wdir = cradleCurrentDir cradle
rdir = cradleRootDir cradle

148
Language/Haskell/GhcMod/GhcPkg.hs Normal file
View 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

4
Language/Haskell/GhcMod/Internal.hs
View File

@ -7,9 +7,6 @@ module Language.Haskell.GhcMod.Internal (
, Package
, IncludeDir
, CompilerOptions(..)
-- * Cradle
, userPackageDbOptsForGhc
, userPackageDbOptsForGhcPkg
-- * Cabal API
, parseCabalFile
, getCompilerOptions
@ -38,7 +35,6 @@ module Language.Haskell.GhcMod.Internal (
import Language.Haskell.GhcMod.Browse
import Language.Haskell.GhcMod.CabalApi
import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.ErrMsg
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.GHCChoice

11
Language/Haskell/GhcMod/PkgDoc.hs
View File

@ -1,8 +1,9 @@
module Language.Haskell.GhcMod.PkgDoc (packageDoc) where
import Control.Applicative ((<$>))
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.GhcPkg
import Control.Applicative ((<$>))
import System.Process (readProcess)
-- | 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
return ret
where
toModuleOpts = ["find-module", mdl, "--simple-output"] ++ userPackageDbOptsForGhcPkg (cradlePackageDb cradle)
toDocDirOpts pkg = ["field", pkg, "haddock-html"] ++ userPackageDbOptsForGhcPkg (cradlePackageDb cradle)
toModuleOpts = ["find-module", mdl, "--simple-output"]
++ ghcPkgDbStackOpts (cradlePkgDbStack cradle)
toDocDirOpts pkg = ["field", pkg, "haddock-html"]
++ ghcPkgDbStackOpts (cradlePkgDbStack cradle)
trim = takeWhile (`notElem` " \n")

9
Language/Haskell/GhcMod/Types.hs
View File

@ -88,14 +88,17 @@ data Cradle = Cradle {
, cradleRootDir :: FilePath
-- | The file name of the found cabal file.
, cradleCabalFile :: Maybe FilePath
-- | User package db. (\"\/foo\/bar\/i386-osx-ghc-7.6.3-packages.conf.d\")
, cradlePackageDb :: Maybe FilePath
-- | Dependent packages.
-- | Package database stack
, cradlePkgDbStack :: [GhcPkgDb]
-- | Package dependencies
, cradlePackages :: [Package]
} deriving (Eq, Show)
----------------------------------------------------------------
-- | GHC package database flags.
data GhcPkgDb = GlobalDb | UserDb | PackageDb String deriving (Eq, Show)
-- | A single GHC command line option.
type GHCOption = String

9
ghc-mod.cabal
View File

@ -26,7 +26,7 @@ Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
Extra-Source-Files: ChangeLog
test/data/*.cabal
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/broken-cabal/*.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/test/*.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/*.hs
test/data/ghc-mod-check/Data/*.hs
@ -54,6 +56,7 @@ Library
Language.Haskell.GhcMod.ErrMsg
Language.Haskell.GhcMod.Flag
Language.Haskell.GhcMod.GHCApi
Language.Haskell.GhcMod.GhcPkg
Language.Haskell.GhcMod.GHCChoice
Language.Haskell.GhcMod.Gap
Language.Haskell.GhcMod.Info
@ -117,10 +120,11 @@ Test-Suite doctest
Test-Suite spec
Default-Language: Haskell2010
Main-Is: Spec.hs
Main-Is: Main.hs
Hs-Source-Dirs: test, .
Type: exitcode-stdio-1.0
Other-Modules: Dir
Spec
BrowseSpec
CabalApiSpec
CheckSpec
@ -129,6 +133,7 @@ Test-Suite spec
LangSpec
LintSpec
ListSpec
GhcPkgSpec
Build-Depends: base >= 4.0 && < 5
, containers
, directory

14
test/CabalApiSpec.hs
View File

@ -9,9 +9,17 @@ import Language.Haskell.GhcMod.CabalApi
import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.Types
import Test.Hspec
import System.Directory
import System.FilePath
import Dir
import Config (cProjectVersionInt) -- ghc version
ghcVersion :: Int
ghcVersion = read cProjectVersionInt
spec :: Spec
spec = do
describe "parseCabalFile" $ do
@ -20,6 +28,7 @@ spec = do
describe "getCompilerOptions" $ do
it "gets necessary CompilerOptions" $ do
cwd <- getCurrentDirectory
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
cradle <- findCradle
pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle
@ -28,7 +37,10 @@ spec = do
ghcOptions = ghcOptions 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
it "extracts dependent packages" $ do

22
test/CradleSpec.hs
View File

@ -4,7 +4,7 @@ import Control.Applicative
import Data.List (isSuffixOf)
import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.Types
import System.Directory (canonicalizePath)
import System.Directory (canonicalizePath,getCurrentDirectory)
import System.FilePath ((</>), pathSeparator)
import Test.Hspec
@ -21,17 +21,18 @@ spec = do
cradleCurrentDir = curDir
, cradleRootDir = curDir
, cradleCabalFile = Nothing
, cradlePackageDb = Nothing
, cradlePkgDbStack = [GlobalDb]
, cradlePackages = []
}
it "finds a cabal file and a sandbox" $ do
cwd <- getCurrentDirectory
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
res <- relativeCradle dir <$> findCradle
res `shouldBe` Cradle {
cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
, cradleRootDir = "test" </> "data"
, 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 = []
}
it "works even if a sandbox config file is broken" $ do
@ -41,23 +42,10 @@ spec = do
cradleCurrentDir = "test" </> "data" </> "broken-sandbox"
, cradleRootDir = "test" </> "data" </> "broken-sandbox"
, cradleCabalFile = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
, cradlePackageDb = Nothing
, cradlePkgDbStack = [GlobalDb, UserDb]
, 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 dir cradle = cradle {
cradleCurrentDir = toRelativeDir dir $ cradleCurrentDir cradle

27
test/GhcPkgSpec.hs Normal file
View 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
View 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

2
test/Spec.hs
View File

@ -1 +1 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}

14
test/data/cabal.sandbox.config → test/data/cabal.sandbox.config.in
View File

@ -4,15 +4,15 @@
-- if you want to change the default settings for this sandbox.
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
local-repo: @CWD@/test/data/.cabal-sandbox/packages
logs-dir: @CWD@/test/data/.cabal-sandbox/logs
world-file: @CWD@/test/data/.cabal-sandbox/world
user-install: False
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
package-db: @CWD@/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d
build-summary: @CWD@/test/data/.cabal-sandbox/logs/build.log
install-dirs
prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox
install-dirs
prefix: @CWD@/test/data/.cabal-sandbox
bindir: $prefix/bin
libdir: $prefix/lib
libsubdir: $arch-$os-$compiler/$pkgid

12
test/data/check-packageid/cabal.sandbox.config → test/data/check-packageid/cabal.sandbox.config.in
View File

@ -4,15 +4,15 @@
-- if you want to change the default settings for this sandbox.
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
local-repo: @CWD@/test/data/.cabal-sandbox/packages
logs-dir: @CWD@/test/data/.cabal-sandbox/logs
world-file: @CWD@/test/data/.cabal-sandbox/world
user-install: False
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
prefix: /home/me/work/ghc-mod/test/data/.cabal-sandbox
install-dirs
prefix: @CWD@/test/data/.cabal-sandbox
bindir: $prefix/bin
libdir: $prefix/lib
libsubdir: $arch-$os-$compiler/$pkgid