Commit 418a1cd6 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Make targetDirectory and knownPackages configurable, rename Environment to Target.

parent b2b7c5c5
......@@ -10,12 +10,16 @@ UserSettings.hs, but will clutter it (what is the good balance of
what we expose to users?). Can be made into a conditional expression
similar to userWays, userPackages and userSettings, but is it worth it?
=> DONE: make this configurable.
* knownPackages (Targets.hs) -- fix by adding knownUserPackages? A nasty
import cycle is then created between Targets.hs and UserSettings.hs. Possible
solution: add file Settings/Targets.hs which will actually put two things
together similar to how it's done with userWays, userPackages and userSettings.
* integerLibraryImpl (Switches.hs) -- fix by having three integer library
=> DONE: keep duplication
* integerLibraryImpl (Switches.hs) -- DONE: fix by having three integer library
packages in Targets.hs and choosing which one to build in userPackages, e.g.:
userPackages = remove [integerGmp2] <> append [integerSimple]
......@@ -25,8 +29,12 @@ userPackages = remove [integerGmp2] <> append [integerSimple]
* In general, should Targets.hs (or any other file) be editable by users?
Ideally, there should only be one place for users to look: UserSettings.hs.
=> Only UserSettings.hs is touched by users.
* Any other parameters I missed which should be user configurable?
=> Look up config.mk
================================================
2. When predicates (e.g. buildHaddock) are moved from configuration files to
......@@ -40,6 +48,8 @@ previously: pass the final lists of arguments through oracles. Care must
be taken though as final command lines can be as large as 5Mb and may bloat
the Shake database!
=> hash command lines and channel them through oracles
================================================
3. Discuss if/how the current approach makes recording provenance information
......@@ -139,4 +149,14 @@ GetStage env, (GetStage env, GetPackage env), etc.
==============================================
stageEnvironment :: Environment
stageEnvironment stage = Environment
{
getStage = stage
getPackage = error "stageEnvironment: Package not set in the environment",
getBuilder = error "Builder not set in the environment",
getFile = error "File not set in the environment",
getWay = error "Way not set in the environment"
}
...
......@@ -2,10 +2,10 @@
module Expression (
module Control.Monad.Reader,
module Data.Monoid,
Expr, DiffExpr, fromDiff,
Expr, DiffExpr, fromDiffExpr,
Predicate,
Settings, Ways, Packages,
Environment (..), defaultEnvironment,
Target (..), stageTarget, stagePackageTarget,
append, appendM, remove, appendSub, appendSubD, filterSub, removeSub,
interpret, interpretDiff,
applyPredicate, (?), (??), stage, package, builder, file, way,
......@@ -19,7 +19,7 @@ import Package
import Data.Monoid
import Control.Monad.Reader
data Environment = Environment
data Target = Target
{
getStage :: Stage,
getPackage :: Package,
......@@ -28,26 +28,40 @@ data Environment = Environment
getWay :: Way
}
-- TODO: all readers are currently partial functions. Can use type classes to
-- guarantee these errors never occur.
defaultEnvironment :: Environment
defaultEnvironment = Environment
stageTarget :: Stage -> Target
stageTarget stage = Target
{
getStage = error "Stage not set in the environment",
getPackage = error "Package not set in the environment",
getBuilder = error "Builder not set in the environment",
getFile = error "File not set in the environment",
getWay = error "Way not set in the environment"
getStage = stage,
getPackage = error "stageTarget: Package not set",
getBuilder = error "stageTarget: Builder not set",
getFile = error "stageTarget: File not set",
getWay = error "stageTarget: Way not set"
}
type Expr a = ReaderT Environment Action a
type DiffExpr a = Expr (Dual (Endo a))
stagePackageTarget :: Stage -> Package -> Target
stagePackageTarget stage package = Target
{
getStage = stage,
getPackage = package,
getBuilder = error "stagePackageTarget: Builder not set",
getFile = error "stagePackageTarget: File not set",
getWay = error "stagePackageTarget: Way not set"
}
-- We could use Dual (Endo a) instead of Diff a, but the former may look scary.
newtype Diff a = Diff { fromDiff :: a -> a }
instance Monoid (Diff a) where
mempty = Diff id
Diff x `mappend` Diff y = Diff $ y . x
type Predicate = Expr Bool
type Expr a = ReaderT Target Action a
type DiffExpr a = Expr (Diff a)
type Settings = DiffExpr [String]
type Ways = DiffExpr [Way]
type Packages = DiffExpr [Package]
type Predicate = Expr Bool
type Settings = DiffExpr [String] -- TODO: rename to Args
type Ways = DiffExpr [Way]
type Packages = DiffExpr [Package]
instance Monoid a => Monoid (Expr a) where
mempty = return mempty
......@@ -56,11 +70,11 @@ instance Monoid a => Monoid (Expr a) where
-- Basic operations on expressions:
-- 1) append something to an expression
append :: Monoid a => a -> DiffExpr a
append x = return . Dual . Endo $ (<> x)
append x = return . Diff $ (<> x)
-- 2) remove given elements from a list expression
remove :: Eq a => [a] -> DiffExpr [a]
remove xs = return . Dual . Endo $ filter (`notElem` xs)
remove xs = return . Diff $ filter (`notElem` xs)
-- 3) apply a predicate to an expression
applyPredicate :: Monoid a => Predicate -> Expr a -> Expr a
......@@ -85,7 +99,7 @@ appendM mx = lift mx >>= append
appendSub :: String -> [String] -> Settings
appendSub prefix xs
| xs' == [] = mempty
| otherwise = return . Dual . Endo $ go False
| otherwise = return . Diff $ go False
where
xs' = filter (/= "") xs
go True [] = []
......@@ -97,31 +111,31 @@ appendSub prefix xs
-- appendSubD is similar to appendSub but it extracts the list of sub-arguments
-- from the given DiffExpr.
appendSubD :: String -> Settings -> Settings
appendSubD prefix diffExpr = fromDiff diffExpr >>= appendSub prefix
appendSubD prefix diffExpr = fromDiffExpr diffExpr >>= appendSub prefix
filterSub :: String -> (String -> Bool) -> Settings
filterSub prefix p = return . Dual . Endo $ map filterSubstr
filterSub prefix p = return . Diff $ map filterSubstr
where
filterSubstr s
| prefix `isPrefixOf` s = unwords . filter p . words $ s
| otherwise = s
-- remove given elements from a list of sub-arguments with a given prefix
-- Remove given elements from a list of sub-arguments with a given prefix
-- Example: removeSub "--configure-option=CFLAGS" ["-Werror"]
removeSub :: String -> [String] -> Settings
removeSub prefix xs = filterSub prefix (`notElem` xs)
-- Interpret a given expression in a given environment
interpret :: Environment -> Expr a -> Action a
interpret :: Target -> Expr a -> Action a
interpret = flip runReaderT
-- Extract an expression from a difference expression
fromDiff :: Monoid a => DiffExpr a -> Expr a
fromDiff = fmap (($ mempty) . appEndo . getDual)
fromDiffExpr :: Monoid a => DiffExpr a -> Expr a
fromDiffExpr = fmap (($ mempty) . fromDiff)
-- Interpret a given difference expression in a given environment
interpretDiff :: Monoid a => Environment -> DiffExpr a -> Action a
interpretDiff env = interpret env . fromDiff
interpretDiff :: Monoid a => Target -> DiffExpr a -> Action a
interpretDiff target = interpret target . fromDiffExpr
-- An equivalent of if-then-else for predicates
(??) :: Monoid a => Predicate -> (Expr a, Expr a) -> Expr a
......
......@@ -20,6 +20,7 @@ instance Eq Package where
instance Ord Package where
compare = compare `on` pkgName
-- TODO: check if unifyPath is actually needed
library :: String -> Package
library name =
Package name (unifyPath $ "libraries" </> name) (name <.> "cabal")
......
......@@ -6,19 +6,18 @@ module Rules (
import Base hiding (arg, args, Args)
import Control.Monad
import Targets
import Package
import Expression
import Rules.Package
import Settings.Packages
import Settings.TargetDirectory
-- generateTargets needs package-data.mk files of all target packages
-- TODO: make interpretDiff total
generateTargets :: Rules ()
generateTargets = action $
forM_ [Stage0 ..] $ \stage -> do
let env = defaultEnvironment { getStage = stage }
pkgs <- interpretDiff env packages
pkgs <- interpretDiff (stageTarget stage) packages
forM_ pkgs $ \pkg -> do
let dir = targetDirectory stage pkg
need [pkgPath pkg </> dir </> "package-data.mk"]
......@@ -28,5 +27,4 @@ packageRules :: Rules ()
packageRules =
forM_ [Stage0, Stage1] $ \stage -> do
forM_ knownPackages $ \pkg -> do
let env = defaultEnvironment { getStage = stage, getPackage = pkg }
buildPackage env
buildPackage (stagePackageTarget stage pkg)
......@@ -7,17 +7,17 @@ import Package
import Expression hiding (when, liftIO)
import Oracles.Flag (when)
import Oracles.Builder
import Targets
import Settings
import Settings.GhcPkg
import Settings.GhcCabal
import Settings.TargetDirectory
import Util
-- Build package-data.mk by using GhcCabal to process pkgCabal file
buildPackageData :: Environment -> Rules ()
buildPackageData env =
let stage = getStage env
pkg = getPackage env
buildPackageData :: Target -> Rules ()
buildPackageData target =
let stage = getStage target
pkg = getPackage target
dir = pkgPath pkg </> targetDirectory stage pkg
in
(dir </>) <$>
......@@ -31,20 +31,20 @@ buildPackageData env =
] &%> \_ -> do
let configure = pkgPath pkg </> "configure"
-- TODO: 1) how to automate this? 2) handle multiple files?
newEnv = env { getFile = dir </> "package-data.mk" }
newEnv = target { getFile = dir </> "package-data.mk" }
-- GhcCabal will run the configure script, so we depend on it
need [pkgPath pkg </> pkgCabal pkg]
-- We still don't know who built the configure script from configure.ac
when (doesFileExist $ configure <.> "ac") $ need [configure]
run' env GhcCabal
run' newEnv GhcCabal
-- TODO: when (registerPackage settings) $
run' env (GhcPkg stage)
run' newEnv (GhcPkg stage)
postProcessPackageData $ dir </> "package-data.mk"
-- TODO: This should probably go to Oracles.Builder
run' :: Environment -> Builder -> Action ()
run' env builder = do
args <- interpret (env {getBuilder = builder}) $ fromDiff settings
run' :: Target -> Builder -> Action ()
run' target builder = do
args <- interpret (target {getBuilder = builder}) $ fromDiffExpr settings
putColoured Green (show args)
run builder args
......
......@@ -6,5 +6,5 @@ import Base
import Rules.Data
import Expression
buildPackage :: Environment -> Rules ()
buildPackage :: Target -> Rules ()
buildPackage = buildPackageData
......@@ -2,7 +2,6 @@ module Settings (
settings
) where
import Targets
import Base hiding (arg, args)
import Settings.GhcPkg
import Settings.GhcCabal
......
module Settings.GhcCabal (
cabalSettings, bootPackageDbSettings
cabalSettings, bootPackageDbSettings, customPackageSettings
) where
import Base hiding (arg, args)
......@@ -14,6 +14,7 @@ import Expression hiding (when, liftIO)
import Settings.Ways
import Settings.Util
import Settings.Packages
import Settings.TargetDirectory
import UserSettings
cabalSettings :: Settings
......@@ -40,7 +41,7 @@ cabalSettings = builder GhcCabal ? do
-- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
librarySettings :: Settings
librarySettings = do
ways <- fromDiff Settings.Ways.ways
ways <- fromDiffExpr Settings.Ways.ways
ghcInterpreter <- ghcWithInterpreter
dynamicPrograms <- dynamicGhcPrograms
append [ if vanilla `elem` ways
......@@ -95,7 +96,7 @@ with' builder = appendM $ with builder
packageConstraints :: Settings
packageConstraints = do
pkgs <- fromDiff packages
pkgs <- fromDiffExpr packages
constraints <- lift $ forM pkgs $ \pkg -> do
let cabal = pkgPath pkg </> pkgCabal pkg
prefix = dropExtension (pkgCabal pkg) ++ " == "
......@@ -124,3 +125,16 @@ ldSettings = mempty
cppSettings :: Settings
cppSettings = mempty
customPackageSettings :: Settings
customPackageSettings = mconcat
[ package integerGmp2 ?
mconcat [ windowsHost ? builder GhcCabal ?
arg "--configure-option=--with-intree-gmp"
, ccArgs ["-Ilibraries/integer-gmp2/gmp"] ]
, package base ?
builder GhcCabal ? arg ("--flags=" ++ pkgName integerLibrary)
, package ghcPrim ?
builder GhcCabal ? arg "--flag=include-ghc-prim" ]
......@@ -4,12 +4,12 @@ module Settings.GhcPkg (
import Base hiding (arg, args)
import Package
import Targets
import Switches
import Expression hiding (when, liftIO)
import Settings.Util
import Oracles.Builder
import Settings.GhcCabal
import Settings.TargetDirectory
ghcPkgSettings :: Settings
ghcPkgSettings = do
......
module Settings.Packages (
packages
packages, knownPackages
) where
import Base
import Package
import Targets
import Switches
import Expression
......@@ -31,3 +32,18 @@ packagesStage1 = mconcat
, windowsHost ? append [win32]
, notWindowsHost ? append [unix]
, buildHaddock ? append [xhtml] ]
-- These are all packages we know about. Build rules will be generated for
-- all of them. However, not all of these packages will be built. For example,
-- package 'win32' is built only on Windows.
-- Settings/Packages.hs defines default conditions for building each package,
-- which can be overridden in UserSettings.hs.
knownPackages :: [Package]
knownPackages = defaultKnownPackages ++ userKnownPackages
defaultKnownPackages :: [Package]
defaultKnownPackages =
[ array, base, binPackageDb, binary, bytestring, cabal, compiler
, containers, deepseq, directory, filepath, ghcPrim, haskeline
, hoopl, hpc, integerLibrary, parallel, pretty, primitive, process
, stm, templateHaskell, terminfo, time, transformers, unix, win32, xhtml ]
module Settings.TargetDirectory (
targetDirectory
) where
import Base
import Package
import UserSettings
-- User can override the default target directory settings given below
targetDirectory :: Stage -> Package -> FilePath
targetDirectory = userTargetDirectory
......@@ -49,12 +49,11 @@ argStagedConfigList key = do
-- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
ccArgs :: [String] -> Settings
ccArgs args = do
ccArgs xs = do
stage <- asks getStage
mconcat [ builder (Gcc stage) ? append args
, builder GhcCabal ? appendSub "--configure-option=CFLAGS" args
, builder GhcCabal ? appendSub "--gcc-options" args ]
mconcat [ builder (Gcc stage) ? args xs
, builder GhcCabal ? appendSub "--configure-option=CFLAGS" xs
, builder GhcCabal ? appendSub "--gcc-options" xs ]
......
module Switches (
IntegerLibraryImpl (..), integerLibraryImpl,
notStage, stage0, stage1, stage2,
configKeyYes, configKeyNo, configKeyNonEmpty,
supportsPackageKey, targetPlatforms, targetPlatform,
......@@ -12,14 +11,6 @@ module Switches (
import Base
import Expression
-- TODO: This setting should be moved to UserSettings.hs
-- TODO: Define three packages for integer library instead of one in Targets.hs
-- Support for multiple integer library implementations
data IntegerLibraryImpl = IntegerGmp | IntegerGmp2 | IntegerSimple
integerLibraryImpl :: IntegerLibraryImpl
integerLibraryImpl = IntegerGmp2
-- Derived predicates
notStage :: Stage -> Predicate
notStage = liftM not . stage
......
module Targets (
targetDirectory,
knownPackages,
customPackageSettings,
integerLibraryName,
defaultTargetDirectory,
array, base, binPackageDb, binary, bytestring, cabal, compiler, containers,
deepseq, directory, filepath, ghcPrim, haskeline, hoopl, hpc,
integerLibrary, parallel, pretty, primitive, process, stm, templateHaskell,
integerGmp, integerGmp2, integerSimple,
parallel, pretty, primitive, process, stm, templateHaskell,
terminfo, time, transformers, unix, win32, xhtml
) where
import Base hiding (arg, args)
import Package
import Switches
import Expression
import Settings.Util
import Oracles.Builder
-- Build results will be placed into a target directory with the following
-- typical structure:
-- * build/ : contains compiled object code
-- * doc/ : produced by haddock
-- * package-data.mk : contains output of ghc-cabal applied to pkgCabal
-- TODO: This is currently not user configurable. Is this right?
targetDirectory :: Stage -> Package -> FilePath
targetDirectory stage package
defaultTargetDirectory :: Stage -> Package -> FilePath
defaultTargetDirectory stage package
| package == compiler = "stage" ++ show (fromEnum stage + 1)
| stage == Stage0 = "dist-boot"
| otherwise = "dist-install"
-- These are all packages we know about. Build rules will be generated for
-- all of them. However, not all of these packages will be built. For example,
-- package 'win32' is built only on Windows.
-- Settings/Packages.hs defines default conditions for building each package,
-- which can be overridden in UserSettings.hs.
knownPackages :: [Package]
knownPackages =
[ array, base, binPackageDb, binary, bytestring, cabal, compiler
, containers, deepseq, directory, filepath, ghcPrim, haskeline
, hoopl, hpc, integerLibrary, parallel, pretty, primitive, process
, stm, templateHaskell, terminfo, time, transformers, unix, win32, xhtml ]
-- Package definitions
array = library "array"
base = library "base"
......@@ -56,7 +37,9 @@ ghcPrim = library "ghc-prim"
haskeline = library "haskeline"
hoopl = library "hoopl"
hpc = library "hpc"
integerLibrary = library integerLibraryName `setCabal` integerLibraryCabal
integerGmp = library "integer-gmp"
integerGmp2 = library "integer-gmp2" `setCabal` "integer-gmp.cabal"
integerSimple = library "integer-simple"
parallel = library "parallel"
pretty = library "pretty"
primitive = library "primitive"
......@@ -70,32 +53,6 @@ unix = library "unix"
win32 = library "Win32"
xhtml = library "xhtml"
integerLibraryName :: String
integerLibraryName = case integerLibraryImpl of
IntegerGmp -> "integer-gmp"
IntegerGmp2 -> "integer-gmp2"
IntegerSimple -> "integer-simple"
-- see Note [Cabal name weirdness]
integerLibraryCabal :: FilePath
integerLibraryCabal = case integerLibraryImpl of
IntegerGmp -> "integer-gmp.cabal"
IntegerGmp2 -> "integer-gmp.cabal" -- Indeed, why make life easier?
IntegerSimple -> "integer-simple.cabal"
customPackageSettings :: Settings
customPackageSettings = mconcat
[ package integerLibrary ?
mconcat [ windowsHost ? builder GhcCabal ?
arg "--configure-option=--with-intree-gmp"
, ccArgs ["-Ilibraries/integer-gmp2/gmp"] ]
, package base ?
builder GhcCabal ? arg ("--flags=" ++ integerLibraryName)
, package ghcPrim ?
builder GhcCabal ? arg "--flag=include-ghc-prim" ]
-- Note [Cabal name weirdness]
-- Find out if we can move the contents to just Cabal/
-- What is Cabal/cabal-install? Do we need it?
......
module UserSettings (
userSettings, userPackages, userWays,
userSettings, userPackages, userWays, userTargetDirectory,
userKnownPackages, integerLibrary,
buildHaddock, validating
) where
import Base hiding (arg, args, Args)
import Oracles.Builder
import Ways
import Package
import Targets
import Switches
import Expression
import Settings.Util
-- No user-specific settings by default
-- TODO: rename to userArgs
userSettings :: Settings
userSettings = mempty
-- Control conditions of which packages get to be built
-- TODO: adding *new* packages is not possible (see knownPackages in Targets.hs)
-- Control which packages get to be built
userPackages :: Packages
userPackages = mempty
-- Add new user-defined packages
userKnownPackages :: [Package]
userKnownPackages = []
-- Control which ways are built
userWays :: Ways
userWays = mempty
-- Control where build results go
userTargetDirectory :: Stage -> Package -> FilePath
userTargetDirectory = defaultTargetDirectory
-- Choose integer library: integerGmp, integerGmp2 or integerSimple
integerLibrary :: Package
integerLibrary = integerGmp2
-- User-defined predicates
-- TODO: migrate more predicates here from configuration files
buildHaddock :: Predicate
......@@ -31,33 +41,3 @@ buildHaddock = return True
validating :: Predicate
validating = return False
-- Examples:
userSettings' :: Settings
userSettings' = mconcat
[ package base ?
builder GhcCabal ? arg ("--flags=" ++ integerLibraryName)
, package integerLibrary ? ccArgs ["-Ilibraries/integer-gmp2/gmp"]
, windowsHost ?
package integerLibrary ?
builder GhcCabal ? arg "--configure-option=--with-intree-gmp"
, package compiler ?
stage0 ?
way profiling ?
file "pattern.*" ? args ["foo", "bar"]
, builder (Ghc Stage0) ? remove ["-O2"]
, builder GhcCabal ? removeSub "--configure-option=CFLAGS" ["-Werror"]
]
userPackages' :: Packages
userPackages' = mconcat
[ stage1 ? remove [cabal]
, remove [compiler] ]
userWays' :: Ways
userWays' = remove [profiling]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment