Parse *.cabal file at once in initializeGHC.

This commit is contained in:
Kei Hibino 2012-10-24 10:48:13 +09:00
parent 659e5421e7
commit 87cca58681
2 changed files with 15 additions and 15 deletions

View File

@ -2,7 +2,7 @@
module Cabal (initializeGHC) where module Cabal (initializeGHC) where
import CabalApi (cabalBuildInfo, cabalDependPackages) import CabalApi (cabalParseFile, cabalBuildInfo, cabalDependPackages)
import Control.Applicative import Control.Applicative
import Control.Exception import Control.Exception
import Control.Monad import Control.Monad
@ -31,7 +31,8 @@ initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
return (fileName,logReader) return (fileName,logReader)
withCabal = do withCabal = do
(owdir,cdir,cfile) <- liftIO getDirs (owdir,cdir,cfile) <- liftIO getDirs
binfo@BuildInfo{..} <- liftIO $ cabalBuildInfo cfile cabal <- liftIO $ cabalParseFile cfile
binfo@BuildInfo{..} <- liftIO $ cabalBuildInfo cabal
let exts = map (addX . Gap.extensionToString) $ usedExtensions binfo let exts = map (addX . Gap.extensionToString) $ usedExtensions binfo
lang = maybe "-XHaskell98" (addX . show) defaultLanguage lang = maybe "-XHaskell98" (addX . show) defaultLanguage
libs = map ("-l" ++) extraLibs libs = map ("-l" ++) extraLibs
@ -40,7 +41,7 @@ initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
idirs = case hsSourceDirs of idirs = case hsSourceDirs of
[] -> [cdir,owdir] [] -> [cdir,owdir]
dirs -> map (cdir </>) dirs ++ [owdir] dirs -> map (cdir </>) dirs ++ [owdir]
depPkgs <- liftIO $ cabalDependPackages cfile depPkgs <- liftIO $ cabalDependPackages cabal
logReader <- initSession opt gopts idirs (Just depPkgs) logging logReader <- initSession opt gopts idirs (Just depPkgs) logging
return (fileName,logReader) return (fileName,logReader)
addX = ("-X" ++) addX = ("-X" ++)

View File

@ -1,4 +1,5 @@
module CabalApi ( module CabalApi (
cabalParseFile,
cabalBuildInfo, cabalBuildInfo,
cabalDependPackages cabalDependPackages
) where ) where
@ -19,20 +20,19 @@ import Distribution.PackageDescription.Parse (readPackageDescription)
---------------------------------------------------------------- ----------------------------------------------------------------
cabalParseFile :: FilePath -> IO GenericPackageDescription
cabalParseFile = readPackageDescription silent
-- Causes error, catched in the upper function. -- Causes error, catched in the upper function.
cabalBuildInfo :: FilePath -> IO BuildInfo cabalBuildInfo :: GenericPackageDescription -> IO BuildInfo
cabalBuildInfo file = do cabalBuildInfo pd = do
cabal <- readPackageDescription silent file return . fromJust $ fromLibrary pd <|> fromExecutable pd
return . fromJust $ fromLibrary cabal <|> fromExecutable cabal
where where
fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c
fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c) fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c)
toMaybe [] = Nothing toMaybe [] = Nothing
toMaybe (x:_) = Just x toMaybe (x:_) = Just x
parseGenericDescription :: FilePath -> IO GenericPackageDescription
parseGenericDescription = readPackageDescription silent
getDepsOfPairs :: [(a1, CondTree v [b] a)] -> [b] getDepsOfPairs :: [(a1, CondTree v [b] a)] -> [b]
getDepsOfPairs = concatMap (condTreeConstraints . snd) getDepsOfPairs = concatMap (condTreeConstraints . snd)
@ -48,9 +48,8 @@ allDependsOfDescription pd =
getDependencyPackageName :: Dependency -> String getDependencyPackageName :: Dependency -> String
getDependencyPackageName (Dependency (PackageName n) _) = n getDependencyPackageName (Dependency (PackageName n) _) = n
cabalDependPackages :: FilePath -> IO [String] cabalDependPackages :: GenericPackageDescription -> IO [String]
cabalDependPackages = cabalDependPackages =
fmap (toList . fromList return . toList . fromList
. map getDependencyPackageName . map getDependencyPackageName
. allDependsOfDescription) . allDependsOfDescription
. parseGenericDescription