Clean up, fix -Wall warnings.

src/Main.hs

 import Base
 import Rules
 
+main :: IO ()
 main = shakeArgs shakeOptions{shakeFiles = shakeFilesPath} $ do
     oracleRules     -- see module Rules.Oracles
     cabalRules      -- see module Rules.Cabal

src/Oracles/ArgsHash.hs

@@ -25,11 +25,11 @@ newtype ArgsHashKey = ArgsHashKey Target
 -- TODO: enforce the above assumption via type trickery?
 checkArgsHash :: FullTarget -> Action ()
 checkArgsHash target = do
-    tmp <- askOracle . ArgsHashKey $ target { sources = ["src"] } :: Action Int
+    _ <- askOracle . ArgsHashKey $ target { sources = ["src"] } :: Action Int
     return ()
 
 -- Oracle for storing per-target argument list hashes
 argsHashOracle :: Rules ()
 argsHashOracle = do
-    addOracle $ \(ArgsHashKey target) -> hash <$> interpret target getArgs
+    _ <- addOracle $ \(ArgsHashKey target) -> hash <$> interpret target getArgs
     return ()

src/Oracles/Base.hs

@@ -36,5 +36,5 @@ configOracle = do
         need [configFile]
         putOracle $ "Reading " ++ configFile ++ "..."
         liftIO $ readConfigFile configFile
-    addOracle $ \(ConfigKey key) -> Map.lookup key <$> cfg ()
+    _ <- addOracle $ \(ConfigKey key) -> Map.lookup key <$> cfg ()
     return ()

src/Oracles/Dependencies.hs

@@ -45,5 +45,5 @@ dependenciesOracle = do
                               . groupBy ((==) `on` fst)
                               . sortBy (compare `on` fst) $ contents
 
-    addOracle $ \(DependenciesKey (file, obj)) -> Map.lookup obj <$> deps file
+    _ <- addOracle $ \(DependenciesKey (file, obj)) -> Map.lookup obj <$> deps file
     return ()

src/Oracles/Flag.hs

 module Oracles.Flag (
     Flag (..), flag,
-    supportsPackageKey, crossCompiling, gccIsClang, gccLt46,
+    crossCompiling, gccIsClang, gccLt46,
     platformSupportsSharedLibs, ghcWithSMP, ghcWithNativeCodeGen
     ) where
 
@@ -35,9 +35,6 @@ flag f = do
         ++ "' instead of 'YES' or 'NO'."
     return $ value == "YES"
 
-supportsPackageKey :: Action Bool
-supportsPackageKey = flag SupportsPackageKey
-
 crossCompiling :: Action Bool
 crossCompiling = flag CrossCompiling
 

src/Oracles/PackageDeps.hs

@@ -31,5 +31,5 @@ packageDepsOracle = do
         contents <- readFileLines packageDependencies
         return . Map.fromList
                $ [ (head ps, tail ps) | line <- contents, let ps = words line ]
-    addOracle $ \(PackageDepsKey pkg) -> Map.lookup pkg <$> deps ()
+    _ <- addOracle $ \(PackageDepsKey pkg) -> Map.lookup pkg <$> deps ()
     return ()

src/Oracles/WindowsRoot.hs

@@ -24,5 +24,5 @@ windowsRootOracle = do
         let root = dropWhileEnd isSpace out
         putOracle $ "Detected root on Windows: " ++ root
         return root
-    addOracle $ \WindowsRoot{} -> root ()
+    _ <- addOracle $ \WindowsRoot{} -> root ()
     return ()

src/Package.hs

 {-# LANGUAGE DeriveGeneric #-}
 
 module Package (
-    Package (..), PackageName, pkgCabalPath,
+    Package (..), PackageName, pkgCabalFile,
     library, topLevel, setPath
     ) where
 
@@ -22,8 +22,8 @@ data Package = Package
      deriving Generic
 
 -- Relative path to cabal file, e.g.: "libraries/Cabal/Cabal/Cabal.cabal"
-pkgCabalPath :: Package -> FilePath
-pkgCabalPath pkg = pkgPath pkg -/- pkgName pkg <.> "cabal"
+pkgCabalFile :: Package -> FilePath
+pkgCabalFile pkg = pkgPath pkg -/- pkgName pkg <.> "cabal"
 
 instance Show Package where
     show = pkgName

src/Rules.hs

@@ -27,17 +27,17 @@ generateTargets = action $ do
         fmap concat . forM pkgs $ \pkg -> do
             let target    = stagePackageTarget stage pkg
                 buildPath = targetPath stage pkg -/- "build"
-            buildGhciLib <- interpret target $ getPkgData BuildGhciLib
-            pkgKey       <- interpret target $ getPkgData PackageKey
-            buildHaddock <- interpret target $ Settings.User.buildHaddock
-            let ghciLib = [ buildPath -/- "HS" ++ pkgKey <.> "o"
-                          | buildGhciLib == "YES" && stage /= Stage0 ]
-                haddock = [ pkgHaddockPath pkg | buildHaddock ]
+            libName     <- interpret target $ getPkgData LibName
+            needGhciLib <- interpret target $ getPkgData BuildGhciLib
+            needHaddock <- interpret target buildHaddock
+            let ghciLib = [ buildPath -/- "HS" ++ libName <.> "o"
+                          | needGhciLib == "YES" && stage /= Stage0 ]
+                haddock = [ pkgHaddockFile pkg | needHaddock ]
 
             ways <- interpret target getWays
             libs <- forM ways $ \way -> do
                 extension <- libsuf way
-                return $ buildPath -/- "libHS" ++ pkgKey <.> extension
+                return $ buildPath -/- "libHS" ++ libName <.> extension
 
             return $ ghciLib ++ libs ++ haddock
 

src/Rules/Actions.hs

@@ -10,7 +10,6 @@ import qualified Target
 import Oracles.Setting
 import Oracles.ArgsHash
 import Settings.Args
-import Settings.Util
 import Settings.User
 import Settings.Builders.Ar
 
@@ -20,7 +19,7 @@ import Settings.Builders.Ar
 buildWithResources :: [(Resource, Int)] -> FullTarget -> Action ()
 buildWithResources rs target = do
     let builder = Target.builder target
-    needBuilder builder
+    needBuilder laxDependencies builder
     path    <- builderPath builder
     argList <- interpret target getArgs
     -- The line below forces the rule to be rerun if the args hash has changed
@@ -55,11 +54,11 @@ interestingInfo builder ss = case builder of
     GhcCabal -> prefixAndSuffix 3 0 ss
     _        -> ss
   where
-    prefixAndSuffix n m ss =
-        if length ss <= n + m + 1
-        then ss
-        else take n ss
+    prefixAndSuffix n m list =
+        if length list <= n + m + 1
+        then list
+        else take n list
              ++ ["... skipping "
-             ++ show (length ss - n - m)
+             ++ show (length list - n - m)
              ++ " arguments ..."]
-             ++ drop (length ss - m) ss
+             ++ drop (length list - m) list

src/Rules/Cabal.hs

@@ -3,7 +3,7 @@ module Rules.Cabal (cabalRules) where
 import Base
 import Stage
 import Package hiding (library)
-import Expression hiding (package)
+import Expression
 import Settings.Packages
 import Data.List
 import Data.Version
@@ -15,29 +15,27 @@ import Distribution.PackageDescription.Parse
 cabalRules :: Rules ()
 cabalRules = do
     -- Cache boot package constraints (to be used in cabalArgs)
-    bootPackageConstraints %> \file -> do
+    bootPackageConstraints %> \out -> do
         pkgs <- interpret (stageTarget Stage0) getPackages
         constraints <- forM (sort pkgs) $ \pkg -> do
-            let cabal = pkgCabalPath pkg
-            need [cabal]
-            description <- liftIO $ readPackageDescription silent cabal
-            let identifier       = package . packageDescription $ description
+            need [pkgCabalFile pkg]
+            pd <- liftIO . readPackageDescription silent $ pkgCabalFile pkg
+            let identifier       = package . packageDescription $ pd
                 version          = showVersion . pkgVersion $ identifier
                 PackageName name = Distribution.Package.pkgName identifier
             return $ name ++ " == " ++ version
-        writeFileChanged file . unlines $ constraints
+        writeFileChanged out . unlines $ constraints
 
     -- Cache package dependencies
-    packageDependencies %> \file -> do
+    packageDependencies %> \out -> do
         pkgs <- interpret (stageTarget Stage1) getPackages
         pkgDeps <- forM (sort pkgs) $ \pkg -> do
-            let cabal = pkgCabalPath pkg
-            need [cabal]
-            description <- liftIO $ readPackageDescription silent cabal
-            let deps     = collectDeps . condLibrary $ description
+            need [pkgCabalFile pkg]
+            pd <- liftIO . readPackageDescription silent $ pkgCabalFile pkg
+            let deps     = collectDeps . condLibrary $ pd
                 depNames = [ name | Dependency (PackageName name) _ <- deps ]
             return . unwords $ Package.pkgName pkg : sort depNames
-        writeFileChanged file . unlines $ pkgDeps
+        writeFileChanged out . unlines $ pkgDeps
 
 collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]
 collectDeps Nothing = []

src/Rules/Config.hs

@@ -12,12 +12,13 @@ configCommand = "AC_CONFIG_FILES([" ++ configPath ++ "system.config])"
 
 configRules :: Rules ()
 configRules = do
-    configPath -/- "system.config" %> \out -> do
+    configPath -/- "system.config" %> \_ -> do
         need [configPath -/- "system.config.in", "configure"]
         putBuild "Running configure..."
         cmd "bash configure" -- TODO: get rid of 'bash'
 
-    "configure" %> \out -> do
+    -- TODO: this rule won't rebuild if configure.ac is changed. Worth fixing?
+    "configure" %> \_ -> do
         -- Make sure 'configure.ac' script contains a line with configCommand
         script <- fmap lines . liftIO $ readFile "configure.ac"
         when (configCommand `notElem` script) $ do

src/Rules/Data.hs

@@ -4,7 +4,7 @@ import Base
 import Util
 import Package
 import Builder
-import Switches
+import Switches (registerPackage)
 import Expression
 import qualified Target
 import Oracles.PackageDeps
@@ -18,11 +18,11 @@ import Control.Monad.Extra
 
 -- Build package-data.mk by using GhcCabal to process pkgCabal file
 buildPackageData :: Resources -> StagePackageTarget -> Rules ()
-buildPackageData (Resources ghcCabal ghcPkg) target = do
+buildPackageData rs target = do
     let stage     = Target.stage target
         pkg       = Target.package target
         path      = targetPath stage pkg
-        cabal     = pkgCabalPath pkg
+        cabalFile = pkgCabalFile pkg
         configure = pkgPath pkg -/- "configure"
 
     (path -/-) <$>
@@ -33,7 +33,7 @@ buildPackageData (Resources ghcCabal ghcPkg) target = do
         , "build" -/- "autogen" -/- "cabal_macros.h"
         -- TODO: Is this needed? Also check out Paths_cpsa.hs.
         -- , "build" -/- "autogen" -/- ("Paths_" ++ name) <.> "hs"
-        ] &%> \files -> do
+        ] &%> \outs -> do
             -- GhcCabal may run the configure script, so we depend on it
             -- We don't know who built the configure script from configure.ac
             whenM (doesFileExist $ configure <.> "ac") $ need [configure]
@@ -41,18 +41,18 @@ buildPackageData (Resources ghcCabal ghcPkg) target = do
             -- We configure packages in the order of their dependencies
             deps <- packageDeps pkg
             pkgs <- interpret target getPackages
-            let cmp pkg name = compare (pkgName pkg) name
-                depPkgs      = intersectOrd cmp (sort pkgs) deps
+            let cmp p name = compare (pkgName p) name
+                depPkgs    = intersectOrd cmp (sort pkgs) deps
             need [ targetPath stage p -/- "package-data.mk" | p <- depPkgs ]
 
-            need [cabal]
-            buildWithResources [(ghcCabal, 1)] $
-                fullTarget target GhcCabal [cabal] files
+            need [cabalFile]
+            buildWithResources [(ghcCabal rs, 1)] $
+                fullTarget target GhcCabal [cabalFile] outs
 
             -- TODO: find out of ghc-cabal can be concurrent with ghc-pkg
             whenM (interpret target registerPackage) .
-                buildWithResources [(ghcPkg, 1)] $
-                fullTarget target (GhcPkg stage) [cabal] files
+                buildWithResources [(ghcPkg rs, 1)] $
+                fullTarget target (GhcPkg stage) [cabalFile] outs
 
             postProcessPackageData $ path -/- "package-data.mk"
 

src/Rules/Dependencies.hs

@@ -21,10 +21,10 @@ buildPackageDependencies _ target =
         dropBuild = (pkgPath pkg ++) . drop (length buildPath)
         hDepFile  = buildPath -/- ".hs-dependencies"
     in do
-        (buildPath <//> "*.c.deps") %> \file -> do
-            let srcFile = dropBuild . dropExtension $ file
+        (buildPath <//> "*.c.deps") %> \out -> do
+            let srcFile = dropBuild . dropExtension $ out
             need [srcFile]
-            build $ fullTarget target (GccM stage) [srcFile] [file]
+            build $ fullTarget target (GccM stage) [srcFile] [out]
 
         hDepFile %> \file -> do
             srcs <- interpret target getPackageSources

src/Rules/Documentation.hs

@@ -21,20 +21,19 @@ import Control.Monad.Extra
 -- files in the Shake databases seems fragile and unnecesarry.
 buildPackageDocumentation :: Resources -> StagePackageTarget -> Rules ()
 buildPackageDocumentation _ target =
-    let stage   = Target.stage target
-        pkg     = Target.package target
-        name    = pkgName pkg
-        cabal   = pkgCabalPath pkg
-        haddock = pkgHaddockPath pkg
+    let stage       = Target.stage target
+        pkg         = Target.package target
+        cabalFile   = pkgCabalFile pkg
+        haddockFile = pkgHaddockFile pkg
     in when (stage == Stage1) $ do
 
-        haddock %> \file -> do
+        haddockFile %> \file -> do
             whenM (specified HsColour) $ do
-                need [cabal]
-                build $ fullTarget target GhcCabalHsColour [cabal] []
+                need [cabalFile]
+                build $ fullTarget target GhcCabalHsColour [cabalFile] []
             srcs <- interpret target getPackageSources
             deps <- interpret target $ getPkgDataList DepNames
-            let haddocks = [ pkgHaddockPath depPkg
+            let haddocks = [ pkgHaddockFile depPkg
                            | Just depPkg <- map findKnownPackage deps ]
             need $ srcs ++ haddocks
             let haddockWay = if dynamicGhcPrograms then dynamic else vanilla

src/Rules/Resources.hs

@@ -3,6 +3,7 @@ module Rules.Resources (
     ) where
 
 import Base
+import Control.Monad
 
 data Resources = Resources
     {
@@ -14,7 +15,5 @@ data Resources = Resources
 -- * https://mail.haskell.org/pipermail/ghc-commits/2013-May/001712.html
 -- * ghc.mk: see comment about parallel ghc-pkg invokations
 resourceRules :: Rules Resources
-resourceRules = do
-    ghcCabal <- newResource "ghc-cabal" 1
-    ghcPkg   <- newResource "ghc-pkg"   1
-    return $ Resources ghcCabal ghcPkg
+resourceRules = liftM2 Resources (newResource "ghc-cabal" 1)
+                                 (newResource "ghc-pkg"   1)

src/Settings/Builders/Ar.hs

 module Settings.Builders.Ar (arArgs, arPersistentArgsCount) where
 
 import Builder
+import Switches (builder)
 import Expression
 import Settings.Util
 

src/Settings/Builders/Gcc.hs

@@ -3,6 +3,7 @@ module Settings.Builders.Gcc (gccArgs, gccMArgs) where
 import Base
 import Util
 import Builder
+import Switches (stagedBuilder)
 import Expression
 import Oracles.PackageData
 import Settings.Util
@@ -10,7 +11,6 @@ import Settings.Util
 -- TODO: check code duplication
 gccArgs :: Args
 gccArgs = stagedBuilder Gcc ? do
-    path   <- getTargetPath
     file   <- getFile
     src    <- getSource
     ccArgs <- getPkgDataList CcArgs
@@ -24,28 +24,25 @@ gccArgs = stagedBuilder Gcc ? do
 -- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
 gccMArgs :: Args
 gccMArgs = stagedBuilder GccM ? do
-    path   <- getTargetPath
     file   <- getFile
     src    <- getSource
     ccArgs <- getPkgDataList CcArgs
-    mconcat
-        [ arg "-E"
-        , arg "-MM"
-        , append ccArgs -- TODO: remove? any other flags?
-        , includeGccArgs
-        , arg "-MF"
-        , arg file
-        , arg "-MT"
-        , arg $ dropExtension file -<.> "o"
-        , arg "-x"
-        , arg "c"
-        , arg src ]
+    mconcat [ arg "-E"
+            , arg "-MM"
+            , append ccArgs -- TODO: remove? any other flags?
+            , includeGccArgs
+            , arg "-MF"
+            , arg file
+            , arg "-MT"
+            , arg $ dropExtension file -<.> "o"
+            , arg "-x"
+            , arg "c"
+            , arg src ]
 
 includeGccArgs :: Args
 includeGccArgs = do
     path    <- getTargetPath
     pkgPath <- getPackagePath
-    pkg     <- getPackage
     iDirs   <- getPkgDataList IncludeDirs
     dDirs   <- getPkgDataList DepIncludeDirs
     mconcat

src/Settings/Builders/Ghc.hs

@@ -4,7 +4,7 @@ import Way
 import Util
 import Stage
 import Builder
-import Switches
+import Switches (stagedBuilder, splitObjects, stage0)
 import Expression
 import Oracles.Flag
 import Oracles.PackageData
@@ -32,7 +32,7 @@ ghcMArgs = stagedBuilder GhcM ? do
     mconcat [ arg "-M"
             , commonGhcArgs
             , arg "-dep-makefile", arg file
-            , append $ concat [ ["-dep-suffix", wayPrefix way] | way <- ways ]
+            , append $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]
             , append srcs ]
 
 -- This is included into ghcArgs, ghcMArgs and haddockArgs.
@@ -78,18 +78,16 @@ packageGhcArgs = do
     stage              <- getStage
     supportsPackageKey <- getFlag SupportsPackageKey
     pkgKey             <- getPkgData PackageKey
-    pkgDepKeys         <- getPkgDataList DepKeys
-    pkgDeps            <- getPkgDataList Deps
+    pkgDepIds          <- getPkgDataList DepIds
     mconcat
         [ arg "-hide-all-packages"
         , arg "-no-user-package-db"
         , arg "-include-pkg-deps"
         , stage0 ? arg "-package-db libraries/bootstrapping.conf"
         , if supportsPackageKey || stage /= Stage0
-          then mconcat [ arg $ "-this-package-key " ++ pkgKey
-                       , append $ map ("-package-key " ++) pkgDepKeys ]
-          else mconcat [ arg $ "-package-name " ++ pkgKey
-                       , append $ map ("-package " ++) pkgDeps ]]
+          then arg $ "-this-package-key " ++ pkgKey
+          else arg $ "-package-name "     ++ pkgKey
+        , append $ map ("-package-id " ++) pkgDepIds ]
 
 includeGhcArgs :: Args
 includeGhcArgs = do

src/Settings/Builders/GhcCabal.hs

@@ -68,13 +68,12 @@ libraryArgs = do
 
 configureArgs :: Args
 configureArgs = do
-    stage <- getStage
     let conf key = appendSubD $ "--configure-option=" ++ key
         cFlags   = mconcat [ ccArgs
                            , remove ["-Werror"]
-                           , argSettingList $ ConfCcArgs stage ]
-        ldFlags  = ldArgs <> (argSettingList $ ConfGccLinkerArgs stage)
-        cppFlags = cppArgs <> (argSettingList $ ConfCppArgs stage)
+                           , argStagedSettingList ConfCcArgs ]
+        ldFlags  = ldArgs  <> (argStagedSettingList ConfGccLinkerArgs)
+        cppFlags = cppArgs <> (argStagedSettingList ConfCppArgs)
     mconcat
         [ conf "CFLAGS"   cFlags
         , conf "LDFLAGS"  ldFlags
@@ -86,7 +85,7 @@ configureArgs = do
         , conf "--with-gmp-libraries"   $ argSettingList GmpLibDirs
         -- TODO: why TargetPlatformFull and not host?
         , crossCompiling ? (conf "--host" $ argSetting TargetPlatformFull)
-        , conf "--with-cc" . argM . builderPath $ Gcc stage ]
+        , conf "--with-cc" $ argStagedBuilderPath Gcc ]
 
 bootPackageDbArgs :: Args
 bootPackageDbArgs = do
@@ -128,16 +127,21 @@ ghcIncludeDirs = [ "includes", "includes/dist"
 cppArgs :: Args
 cppArgs = append $ map ("-I" ++) ghcIncludeDirs
 
+-- TODO: Is this needed?
+-- ifeq "$(GMP_PREFER_FRAMEWORK)" "YES"
+-- libraries/integer-gmp_CONFIGURE_OPTS += --with-gmp-framework-preferred
+-- endif
+
 -- TODO: move this somewhere
 customPackageArgs :: Args
 customPackageArgs = do
-    stage   <- getStage
-    rtsWays <- getRtsWays
+    nextStage <- fmap succ getStage
+    rtsWays   <- getRtsWays
     mconcat
-        [ package integerGmp2 ?
+        [ package integerGmp ?
           mconcat [ windowsHost ? builder GhcCabal ?
                     arg "--configure-option=--with-intree-gmp"
-                  , appendCcArgs ["-I" ++ pkgPath integerGmp2 -/- "gmp"] ]
+                  , appendCcArgs ["-I" ++ pkgPath integerGmp -/- "gmp"] ]
 
         , package base ?
           builder GhcCabal ?
@@ -148,8 +152,8 @@ customPackageArgs = do
 
         , package compiler ?
           builder GhcCabal ?
-          mconcat [ arg $ "--ghc-option=-DSTAGE=" ++ show (succ stage)
-                  , arg $ "--flags=stage" ++ show (succ stage)
+          mconcat [ arg $ "--ghc-option=-DSTAGE=" ++ show nextStage
+                  , arg $ "--flags=stage" ++ show nextStage
                   , arg "--disable-library-for-ghci"
                   , targetOs "openbsd" ? arg "--ld-options=-E"
                   , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
@@ -173,7 +177,7 @@ customPackageArgs = do
         ]
 
 withBuilderKey :: Builder -> String
-withBuilderKey builder = case builder of
+withBuilderKey b = case b of
     Ar       -> "--with-ar="
     Ld       -> "--with-ld="
     Gcc _    -> "--with-gcc="
@@ -186,12 +190,10 @@ withBuilderKey builder = case builder of
 
 -- Expression 'with Gcc' appends "--with-gcc=/path/to/gcc" and needs Gcc.
 with :: Builder -> Args
-with builder = specified builder ? do
-    path <- lift $ builderPath builder
-    lift $ needBuilder builder
-    append [withBuilderKey builder ++ path]
+with b = specified b ? do
+    path <- lift $ builderPath b
+    lift $ needBuilder laxDependencies b
+    append [withBuilderKey b ++ path]
 
 withStaged :: (Stage -> Builder) -> Args
-withStaged sb = do
-    stage <- getStage
-    with $ sb stage
+withStaged sb = (with . sb) =<< getStage