Finish Args datatype, propagate changes to related modules.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Thu, 16 Apr 2015 01:08:59 +0000 (02:08 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Thu, 16 Apr 2015 01:08:59 +0000 (02:08 +0100)
src/Expression/Base.hs
src/Expression/Build.hs
src/Main.hs
src/Settings.hs
src/Targets.hs

index de982bd..7c9f9aa 100644 (file)
@@ -12,10 +12,11 @@ module Expression.Base (
     project,
     arg, args, argsOrdered, argBuildPath, argBuildDir,
     argInput, argOutput,
-    argConfig, argConfigStaged, argBuilderPath, argStagedBuilderPath,
+    argConfig, argStagedConfig, argBuilderPath, argStagedBuilderPath,
+    argWithBuilder, argWithStagedBuilder,
     argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
     argIncludeDirs, argDepIncludeDirs,
-    argConcat, argConcatPath, argPairs, argPrefix,
+    argConcat, argConcatPath, argConcatSpace, argPairs, argPrefix,
     argBootPkgConstraints,
     setPackage, setBuilder, setBuilderFamily, setStage, setWay,
     setFile, setConfig
@@ -37,16 +38,14 @@ data Args
     | Input                  -- evaluates to input file(s): "src.c"
     | Output                 -- evaluates to output file(s): "src.o"
     | Config String          -- evaluates to the value of a given config key
-    | ConfigStaged String    -- as above, but stage is appended to the key
     | BuilderPath Builder    -- evaluates to the path to a given builder
     | PackageData String     -- looks up value a given key in package-data.mk
     | BootPkgConstraints     -- evaluates to boot package constraints
-    | Pair Combine Args Args -- combine two Args using a given append method
     | Fold Combine Settings  -- fold settings using a given combine method
 
--- Assume original settings structure: (a `op1` b `op2` c ...)
-data Combine = Concat        -- Concatenate all: a ++ b ++ c ...
-             | ConcatPath    -- </>-concatenate all: a </> b </> c ...
+data Combine = Concat        -- Concatenate: a ++ b
+             | ConcatPath    -- </>-concatenate: a </> b
+             | ConcatSpace   -- concatenate with a space: a ++ " " ++ b
 
 type Ways      = BuildExpression Way
 type Settings  = BuildExpression Args
@@ -80,8 +79,12 @@ argOutput = return Output
 argConfig :: String -> Settings
 argConfig = return . Config
 
-argConfigStaged :: String -> Settings
-argConfigStaged = return . ConfigStaged
+argStagedConfig :: String -> Settings
+argStagedConfig key =
+    msum $ map (\s -> stage s ? argConfig (stagedKey s)) [Stage0 ..]
+  where
+    stagedKey :: Stage -> String
+    stagedKey stage = key ++ "-stage" ++ show stage
 
 argBuilderPath :: Builder -> Settings
 argBuilderPath = return . BuilderPath
@@ -91,6 +94,25 @@ argStagedBuilderPath :: (Stage -> Builder) -> Settings
 argStagedBuilderPath f =
     msum $ map (\s -> stage s ? argBuilderPath (f s)) [Stage0 ..]
 
+argWithBuilder :: Builder -> Settings
+argWithBuilder builder =
+    let key = case builder of
+            Ar       -> "--with-ar="
+            Ld       -> "--with-ld="
+            Gcc _    -> "--with-gcc="
+            Ghc _    -> "--with-ghc="
+            Alex     -> "--with-alex="
+            Happy    -> "--with-happy="
+            GhcPkg _ -> "--with-ghc-pkg="
+            HsColour -> "--with-hscolour="
+    in
+    argPrefix key (argBuilderPath builder)
+
+argWithStagedBuilder :: (Stage -> Builder) -> Settings
+argWithStagedBuilder f =
+    msum $ map (\s -> stage s ? argWithBuilder (f s)) [Stage0 ..]
+
+
 -- Accessing key value pairs from package-data.mk files
 argPackageKey :: Settings
 argPackageKey = return $ PackageData "PACKAGE_KEY"
@@ -113,25 +135,29 @@ argDepIncludeDirs = return $ PackageData "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
 argBootPkgConstraints :: Settings
 argBootPkgConstraints = return BootPkgConstraints
 
--- A concatenation of arguments: arg1 ++ arg2 ++ ...
+-- Concatenate arguments: arg1 ++ arg2 ++ ...
 argConcat :: Settings -> Settings
 argConcat = return . Fold Concat
 
--- A </>-concatenation of arguments: arg1 </> arg2 </> ...
+-- </>-concatenate arguments: arg1 </> arg2 </> ...
 argConcatPath :: Settings -> Settings
 argConcatPath = return . Fold ConcatPath
 
+-- Concatene arguments (space separated): arg1 ++ " " ++ arg2 ++ ...
+argConcatSpace :: Settings -> Settings
+argConcatSpace = return . Fold ConcatSpace
+
 -- An ordered list of pairs of arguments: prefix |> arg1, prefix |> arg2, ...
 argPairs :: String -> Settings -> Settings
 argPairs prefix settings = settings >>= (arg prefix |>) . return
 
 -- An ordered list of prefixed arguments: prefix ++ arg1, prefix ++ arg2, ...
 argPrefix :: String -> Settings -> Settings
-argPrefix prefix = fmap (Pair Concat $ Plain prefix)
+argPrefix prefix = fmap (Fold Concat . (arg prefix |>) . return)
 
 -- An ordered list of prefixed arguments: prefix </> arg1, prefix </> arg2, ...
 argPaths :: String -> Settings -> Settings
-argPaths prefix = fmap (Pair ConcatPath $ Plain prefix)
+argPaths prefix = fmap (Fold ConcatPath . (arg prefix |>) . return)
 
 -- Partially evaluate Settings using a truth-teller (compute a 'projection')
 project :: (BuildVariable -> Maybe Bool) -> Settings -> Settings
index 5e74b98..3b90e53 100644 (file)
@@ -5,7 +5,7 @@ module Expression.Build (
     BuildPredicate (..),
     BuildExpression (..),
     evaluate, tellTruth,
-    linearise, msum, mproduct, fromList, fromOrderedList,
+    linearise, (|>), msum, mproduct, fromList, fromOrderedList,
     packages, package, matchPackage,
     builders, builder, matchBuilder, matchBuilderFamily,
     stages, stage, notStage, matchStage,
index a91b9f0..a94ab98 100644 (file)
@@ -3,6 +3,7 @@ import Config
 import Oracles
 import Package
 import Targets
+import Settings
 
 main = shakeArgs shakeOptions{shakeFiles="_build/"} $ do
     oracleRules
index a219f03..172409a 100644 (file)
@@ -11,19 +11,21 @@ import Ways
 import Oracles.Builder
 import Expression.Base
 
-whenPackageKey :: BuildPredicate
-whenPackageKey = supportsPackageKey && notStage Stage0
+validating :: BuildPredicate
+validating = false
 
 packageSettings :: Settings
-packageSettings = mconcat
+packageSettings = msum
     [ args ["-hide-all-packages", "-no-user-package-db", "-include-pkg-deps"]
-    , stage Stage0 ? args ["-package-db libraries/bootstrapping.conf"]
-    , whenPackageKey ??
-      ( argPackageKey "-this-package-key" <> argPackageDepKeys "-package-key"
-      , argPackageKey "-package-name"     <> argPackageDeps    "-package"    )]
+    , stage Stage0 ? arg "-package-db libraries/bootstrapping.conf"
+    , supportsPackageKey && notStage Stage0 ??
+      ( argPairs "-this-package-key" argPackageKey <|>
+        argPairs "-package-key"      argPackageDepKeys
+      , argPairs "-package-name"     argPackageKey <|>
+        argPairs "-package"          argPackageDeps )]
 
 librarySettings :: Ways -> Settings
-librarySettings ways = mconcat
+librarySettings ways = msum
     [ whenExists vanilla ways     ?? ( arg  "--enable-library-vanilla"
                                      , arg "--disable-library-vanilla" )
     , (ghcWithInterpreter
@@ -35,37 +37,34 @@ librarySettings ways = mconcat
     , whenExists dynamic ways     ?? ( arg  "--enable-shared"
                                      , arg "--disable-shared" )]
 
-validating :: BuildPredicate
-validating = false
-
 ccSettings :: Settings
-ccSettings = mconcat
+ccSettings = msum
     [ package integerLibrary ? arg "-Ilibraries/integer-gmp2/gmp"
-    , builder GhcCabal ? argConfigStaged "conf-cc-args"
-    , validating ? mconcat
+    , builder GhcCabal ? argStagedConfig "conf-cc-args"
+    , validating ? msum
         [ not (builder GhcCabal) ? arg "-Werror"
         , arg "-Wall"
         , gccIsClang ??
-          ( arg "-Wno-unknown-pragmas" <>
+          ( arg "-Wno-unknown-pragmas" <|>
             not gccLt46 && windowsHost ? arg "-Werror=unused-but-set-variable"
-          , not gccLt46 ? arg "-Wno-error=inline" )
-        ]
-    ]
+          , not gccLt46 ? arg "-Wno-error=inline" )]]
 
 ldSettings :: Settings
-ldSettings = builder GhcCabal ? argConfigStaged "conf-gcc-linker-args"
+ldSettings = builder GhcCabal ? argStagedConfig "conf-gcc-linker-args"
 
 cppSettings :: Settings
-cppSettings = builder GhcCabal ? argConfigStaged "conf-cpp-args"
+cppSettings = builder GhcCabal ? argStagedConfig "conf-cpp-args"
 
 configureSettings :: Settings
 configureSettings =
-    let conf key = argComplex $ "--configure-option=" ++ key ++ "="
+    let conf key = argPrefix ("--configure-option=" ++ key ++ "=")
+                 . argConcatSpace
     in
-    mconcat [ conf "CFLAGS"   ccSettings
+    msum [ conf "CFLAGS"   ccSettings
             , conf "LDFLAGS"  ldSettings
             , conf "CPPFLAGS" cppSettings
-            , argComplex "--gcc-options="   (ccSettings <> ldSettings)
+            , argPrefix "--gcc-options=" $
+              argConcatSpace (ccSettings <|> ldSettings)
             , conf "--with-iconv-includes"  (argConfig "iconv-include-dirs")
             , conf "--with-iconv-libraries" (argConfig "iconv-lib-dirs")
             , conf "--with-gmp-includes"    (argConfig "gmp-include-dirs")
@@ -83,7 +82,7 @@ dllSettings = arg ""
 
 -- customConfArgs
 customConfigureSettings :: Settings
-customConfigureSettings = mconcat
+customConfigureSettings = msum
     [ package base    ? arg ("--flags=" ++ integerLibraryName)
     , package ghcPrim ? arg "--flag=include-ghc-prim"
     , package integerLibrary && windowsHost ?
@@ -94,33 +93,40 @@ customConfigureSettings = mconcat
 bootPackageDbSettings :: Settings
 bootPackageDbSettings =
     stage Stage0 ?
-        argPath "--package-db="
-        (argConfig "ghc-source-path" <> arg "libraries/bootstrapping.conf")
+        argPrefix "--package-db="
+        (argConcatPath $
+            argConfig "ghc-source-path" |>
+            arg "libraries"             |>
+            arg "bootstrapping.conf" )
 
 cabalSettings :: Settings
 cabalSettings =
-    argsOrdered ["configure", argBuildPath, argBuildDist, dllSettings]
-    `fence`
-    mconcat
-    [ argStagedBuilderPath Ghc -- TODO: used to be limited to max stage1 GHC
-    , argStagedBuilderPath GhcPkg
+    mproduct
+    [ argBuilderPath GhcCabal
+    , arg "configure"
+    , argBuildPath
+    , argBuildDir
+    , dllSettings ]
+    |>
+    msum
+    [ argWithStagedBuilder Ghc -- TODO: used to be limited to max stage1 GHC
+    , argWithStagedBuilder GhcPkg
     , customConfigureSettings
-    , bootPackageDbSettings
+    , stage Stage0 ? bootPackageDbSettings
     , librarySettings targetWays
-    , configNonEmpty "hscolour" ? argBuilderPath HsColour -- TODO: more reuse
+    , configNonEmpty "hscolour" ? argWithBuilder HsColour -- TODO: more reuse
     , configureSettings
     , stage Stage0 ? argBootPkgConstraints
-    , argStagedBuilderPath Gcc
-    , notStage Stage0 ? argBuilderPath Ld
-    , argBuilderPath Ar
-    , argBuilderPath Alex
-    , argBuilderPath Happy ] -- TODO: reorder with's
+    , argWithStagedBuilder Gcc
+    , notStage Stage0 ? argWithBuilder Ld
+    , argWithBuilder Ar
+    , argWithBuilder Alex
+    , argWithBuilder Happy ] -- TODO: reorder with's
 
 ghcPkgSettings :: Settings
 ghcPkgSettings =
-    arg "update"
-    `fence` mconcat
-    [ arg "--force"
-    , argPath "" $
-      mconcat [argBuildPath, argBuildDist, arg "inplace-pkg-config"]
-    , bootPackageDbSettings ]
+    arg "update" |> msum
+        [ arg "--force"
+        , argConcatPath $
+          msum [argBuildPath, argBuildDir, arg "inplace-pkg-config"]
+        , bootPackageDbSettings ]
index a0d31ce..1b7bba2 100644 (file)
@@ -1,7 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 module Targets (
     buildHaddock,
-    targetWays, targetPackages, targetPackagesInStage,
+    targetWays, targetPackages,
     IntegerLibraryImpl (..), integerLibraryImpl, integerLibraryName,
     array, base, binPackageDb, binary, bytestring, cabal, containers, deepseq,
     directory, filepath, ghcPrim, haskeline, hoopl, hpc, integerLibrary,
@@ -9,7 +9,7 @@ module Targets (
     transformers, unix, win32, xhtml
     ) where
 
-import Ways
+import qualified Ways
 import Base
 import Package
 import Expression.Base
@@ -19,14 +19,14 @@ buildHaddock = true
 
 -- These are the packages we build
 targetPackages :: Packages
-targetPackages =
+targetPackages = msum
     [ stage Stage0 ? packagesStage0
     , stage Stage1 ? packagesStage1 ]
 
 packagesStage0 :: Packages
-packagesStage0 = mconcat
+packagesStage0 = msum
     [ fromList [ binPackageDb, binary, cabal, hoopl, hpc, transformers ]
-    , windowsHost && not (targetOs "ios") ? terminfo ]
+    , windowsHost && not (targetOs "ios") ? return terminfo ]
 
 packagesStage1 :: Packages
 packagesStage1 = msum
@@ -34,16 +34,16 @@ packagesStage1 = msum
     , fromList [ array, base, bytestring, containers, deepseq, directory
                , filepath, ghcPrim, haskeline, integerLibrary, parallel
                , pretty, primitive, process, stm, templateHaskell, time ]
-    , not windowsHost ? unix
-    , windowsHost     ? win32
-    , buildHaddock    ? xhtml ]
+    , not windowsHost ? return unix
+    , windowsHost     ? return win32
+    , buildHaddock    ? return xhtml ]
 
 -- Packages will be build these ways
 targetWays :: Ways
 targetWays = msum
-    [                              return vanilla -- always build vanilla
-    , notStage Stage0            ? return profiling
-    , platformSupportsSharedLibs ? return dynamic ]
+    [                              return Ways.vanilla -- always build vanilla
+    , notStage Stage0            ? return Ways.profiling
+    , platformSupportsSharedLibs ? return Ways.dynamic ]
 
 -- Build results will be placed into a target directory with the following
 -- typical structure: