Refactor builder path manipulation
[hadrian.git] / src / Settings / Builders / GhcCabal.hs
index 85cf092..7a0669a 100644 (file)
@@ -1,37 +1,33 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Settings.Builders.GhcCabal (
-    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs, bootPackageDbArgs,
-    PackageDbKey (..), cppArgs, needDll0
+    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs, buildDll0
     ) where
 
-import Base
-import GHC
-import Oracles.Config.Flag
-import Oracles.Config.Setting
-import Predicate
-import Settings
+import Context
+import Flavour
+import Rules.Actions
 import Settings.Builders.Common
 
 ghcCabalBuilderArgs :: Args
 ghcCabalBuilderArgs = builder GhcCabal ? do
-    path <- getPackagePath
-    dir  <- getContextDirectory
+    verbosity <- lift $ getVerbosity
     mconcat [ arg "configure"
-            , arg path
-            , arg dir
+            , arg =<< getPackagePath
+            , arg =<< getContextDirectory
             , dll0Args
-            , withStaged $ Ghc Compile
+            , withStaged $ Ghc CompileHs
             , withStaged GhcPkg
-            , bootPackageDbArgs
+            , bootPackageDatabaseArgs
             , libraryArgs
             , with HsColour
             , configureArgs
             , packageConstraints
-            , withStaged $ Cc Compile
+            , withStaged $ Cc CompileC
             , notStage0 ? with Ld
             , with Ar
             , with Alex
-            , with Happy ]
+            , with Happy
+            , verbosity < Chatty ? append [ "-v0", "--configure-option=--quiet"
+                , "--configure-option=--disable-option-checking"  ] ]
 
 ghcCabalHsColourBuilderArgs :: Args
 ghcCabalHsColourBuilderArgs = builder GhcCabalHsColour ? do
@@ -48,7 +44,7 @@ libraryArgs = do
     append [ if vanilla `elem` ways
              then  "--enable-library-vanilla"
              else "--disable-library-vanilla"
-           , if vanilla `elem` ways && withGhci && not dynamicGhcPrograms
+           , if vanilla `elem` ways && withGhci && not (dynamicGhcPrograms flavour)
              then  "--enable-library-for-ghci"
              else "--disable-library-for-ghci"
            , if profiling `elem` ways
@@ -59,13 +55,14 @@ libraryArgs = do
              else "--disable-shared" ]
 
 -- TODO: LD_OPTS?
--- TODO: WARNING: unrecognized options: --with-compiler, --with-gmp-libraries, --with-cc
 configureArgs :: Args
 configureArgs = do
+    top <- getTopDirectory
     let conf key = appendSubD $ "--configure-option=" ++ key
         cFlags   = mconcat [ cArgs
                            , remove ["-Werror"]
-                           , argStagedSettingList ConfCcArgs ]
+                           , argStagedSettingList ConfCcArgs
+                           , arg $ "-I" ++ top -/- generatedPath ]
         ldFlags  = ldArgs  <> (argStagedSettingList ConfGccLinkerArgs)
         cppFlags = cppArgs <> (argStagedSettingList ConfCppArgs)
     mconcat
@@ -78,22 +75,7 @@ configureArgs = do
         , conf "--with-gmp-includes"      $ argSetting GmpIncludeDir
         , conf "--with-gmp-libraries"     $ argSetting GmpLibDir
         , crossCompiling ? (conf "--host" $ argSetting TargetPlatformFull)
-        , conf "--with-cc" $ argStagedBuilderPath (Cc Compile) ]
-
-newtype PackageDbKey = PackageDbKey Stage
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
-
-initialisePackageDb :: Stage -> Action ()
-initialisePackageDb stage = askOracle $ PackageDbKey stage
-
-bootPackageDbArgs :: Args
-bootPackageDbArgs = do
-    stage <- getStage
-    lift $ initialisePackageDb stage
-    stage0 ? do
-        path   <- getTopDirectory
-        prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=")
-        arg $ prefix ++ path -/- packageDbDirectory Stage0
+        , conf "--with-cc" $ argStagedBuilderPath (Cc CompileC) ]
 
 packageConstraints :: Args
 packageConstraints = stage0 ? do
@@ -101,7 +83,7 @@ packageConstraints = stage0 ? do
     append $ concat [ ["--constraint", c] | c <- constraints ]
 
 cppArgs :: Args
-cppArgs = includesArgs
+cppArgs = arg $ "-I" ++ generatedPath
 
 withBuilderKey :: Builder -> String
 withBuilderKey b = case b of
@@ -113,11 +95,11 @@ withBuilderKey b = case b of
     Happy    -> "--with-happy="
     GhcPkg _ -> "--with-ghc-pkg="
     HsColour -> "--with-hscolour="
-    _        -> error "withBuilderKey: not supported builder"
+    _        -> error $ "withBuilderKey: not supported builder " ++ show b
 
 -- Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
 with :: Builder -> Args
-with b = specified b ? do
+with b = isSpecified b ? do
     top  <- getTopDirectory
     path <- getBuilderPath b
     lift $ needBuilder b
@@ -126,19 +108,18 @@ with b = specified b ? do
 withStaged :: (Stage -> Builder) -> Args
 withStaged sb = with . sb =<< getStage
 
-needDll0 :: Stage -> Package -> Action Bool
-needDll0 stage pkg = do
+buildDll0 :: Context -> Action Bool
+buildDll0 Context {..} = do
     windows <- windowsHost
-    return $ windows && pkg == compiler && stage == Stage1
+    return $ windows && stage == Stage1 && package == compiler
 
 -- This is a positional argument, hence:
 -- * if it is empty, we need to emit one empty string argument;
 -- * otherwise, we must collapse it into one space-separated string.
 dll0Args :: Args
 dll0Args = do
-    stage    <- getStage
-    pkg      <- getPackage
-    dll0     <- lift $ needDll0 stage pkg
+    context  <- getContext
+    dll0     <- lift $ buildDll0 context
     withGhci <- lift ghcWithInterpreter
     arg . unwords . concat $ [ modules     | dll0             ]
                           ++ [ ghciModules | dll0 && withGhci ] -- see #9552