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,
     project,
     arg, args, argsOrdered, argBuildPath, argBuildDir,
     argInput, argOutput,
-    argConfig, argConfigStaged, argBuilderPath, argStagedBuilderPath,
+    argConfig, argStagedConfig, argBuilderPath, argStagedBuilderPath,
+    argWithBuilder, argWithStagedBuilder,
     argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
     argIncludeDirs, argDepIncludeDirs,
     argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
     argIncludeDirs, argDepIncludeDirs,
-    argConcat, argConcatPath, argPairs, argPrefix,
+    argConcat, argConcatPath, argConcatSpace, argPairs, argPrefix,
     argBootPkgConstraints,
     setPackage, setBuilder, setBuilderFamily, setStage, setWay,
     setFile, setConfig
     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
     | 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
     | 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
 
     | 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
 
 type Ways      = BuildExpression Way
 type Settings  = BuildExpression Args
@@ -80,8 +79,12 @@ argOutput = return Output
 argConfig :: String -> Settings
 argConfig = return . Config
 
 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
 
 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 ..]
 
 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"
 -- 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
 
 argBootPkgConstraints :: Settings
 argBootPkgConstraints = return BootPkgConstraints
 
--- A concatenation of arguments: arg1 ++ arg2 ++ ...
+-- Concatenate arguments: arg1 ++ arg2 ++ ...
 argConcat :: Settings -> Settings
 argConcat = return . Fold Concat
 
 argConcat :: Settings -> Settings
 argConcat = return . Fold Concat
 
--- A </>-concatenation of arguments: arg1 </> arg2 </> ...
+-- </>-concatenate arguments: arg1 </> arg2 </> ...
 argConcatPath :: Settings -> Settings
 argConcatPath = return . Fold ConcatPath
 
 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
 -- 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
 
 -- 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
 
 -- 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,
     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,
     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 Oracles
 import Package
 import Targets
+import Settings
 
 main = shakeArgs shakeOptions{shakeFiles="_build/"} $ do
     oracleRules
 
 main = shakeArgs shakeOptions{shakeFiles="_build/"} $ do
     oracleRules
index a219f03..172409a 100644 (file)
@@ -11,19 +11,21 @@ import Ways
 import Oracles.Builder
 import Expression.Base
 
 import Oracles.Builder
 import Expression.Base
 
-whenPackageKey :: BuildPredicate
-whenPackageKey = supportsPackageKey && notStage Stage0
+validating :: BuildPredicate
+validating = false
 
 packageSettings :: Settings
 
 packageSettings :: Settings
-packageSettings = mconcat
+packageSettings = msum
     [ args ["-hide-all-packages", "-no-user-package-db", "-include-pkg-deps"]
     [ 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 -> Settings
-librarySettings ways = mconcat
+librarySettings ways = msum
     [ whenExists vanilla ways     ?? ( arg  "--enable-library-vanilla"
                                      , arg "--disable-library-vanilla" )
     , (ghcWithInterpreter
     [ 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" )]
 
     , whenExists dynamic ways     ?? ( arg  "--enable-shared"
                                      , arg "--disable-shared" )]
 
-validating :: BuildPredicate
-validating = false
-
 ccSettings :: Settings
 ccSettings :: Settings
-ccSettings = mconcat
+ccSettings = msum
     [ package integerLibrary ? arg "-Ilibraries/integer-gmp2/gmp"
     [ 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 ??
         [ 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 && windowsHost ? arg "-Werror=unused-but-set-variable"
-          , not gccLt46 ? arg "-Wno-error=inline" )
-        ]
-    ]
+          , not gccLt46 ? arg "-Wno-error=inline" )]]
 
 ldSettings :: Settings
 
 ldSettings :: Settings
-ldSettings = builder GhcCabal ? argConfigStaged "conf-gcc-linker-args"
+ldSettings = builder GhcCabal ? argStagedConfig "conf-gcc-linker-args"
 
 cppSettings :: Settings
 
 cppSettings :: Settings
-cppSettings = builder GhcCabal ? argConfigStaged "conf-cpp-args"
+cppSettings = builder GhcCabal ? argStagedConfig "conf-cpp-args"
 
 configureSettings :: Settings
 configureSettings =
 
 configureSettings :: Settings
 configureSettings =
-    let conf key = argComplex $ "--configure-option=" ++ key ++ "="
+    let conf key = argPrefix ("--configure-option=" ++ key ++ "=")
+                 . argConcatSpace
     in
     in
-    mconcat [ conf "CFLAGS"   ccSettings
+    msum [ conf "CFLAGS"   ccSettings
             , conf "LDFLAGS"  ldSettings
             , conf "CPPFLAGS" cppSettings
             , 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")
             , 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
 
 -- customConfArgs
 customConfigureSettings :: Settings
-customConfigureSettings = mconcat
+customConfigureSettings = msum
     [ package base    ? arg ("--flags=" ++ integerLibraryName)
     , package ghcPrim ? arg "--flag=include-ghc-prim"
     , package integerLibrary && windowsHost ?
     [ 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 ?
 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 =
 
 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
     , customConfigureSettings
-    , bootPackageDbSettings
+    , stage Stage0 ? bootPackageDbSettings
     , librarySettings targetWays
     , librarySettings targetWays
-    , configNonEmpty "hscolour" ? argBuilderPath HsColour -- TODO: more reuse
+    , configNonEmpty "hscolour" ? argWithBuilder HsColour -- TODO: more reuse
     , configureSettings
     , stage Stage0 ? argBootPkgConstraints
     , 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 =
 
 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,
 {-# 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,
     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
 
     transformers, unix, win32, xhtml
     ) where
 
-import Ways
+import qualified Ways
 import Base
 import Package
 import Expression.Base
 import Base
 import Package
 import Expression.Base
@@ -19,14 +19,14 @@ buildHaddock = true
 
 -- These are the packages we build
 targetPackages :: Packages
 
 -- These are the packages we build
 targetPackages :: Packages
-targetPackages =
+targetPackages = msum
     [ stage Stage0 ? packagesStage0
     , stage Stage1 ? packagesStage1 ]
 
 packagesStage0 :: Packages
     [ stage Stage0 ? packagesStage0
     , stage Stage1 ? packagesStage1 ]
 
 packagesStage0 :: Packages
-packagesStage0 = mconcat
+packagesStage0 = msum
     [ fromList [ binPackageDb, binary, cabal, hoopl, hpc, transformers ]
     [ fromList [ binPackageDb, binary, cabal, hoopl, hpc, transformers ]
-    , windowsHost && not (targetOs "ios") ? terminfo ]
+    , windowsHost && not (targetOs "ios") ? return terminfo ]
 
 packagesStage1 :: Packages
 packagesStage1 = msum
 
 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 ]
     , 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
 
 -- 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:
 
 -- Build results will be placed into a target directory with the following
 -- typical structure: