Commit 8bdc64cc authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Work on the top-level build structure.

parent 489e385a
......@@ -4,7 +4,8 @@ module Expression.Base (
module Expression.Build,
module Expression.Predicate,
(?), (??), whenExists,
Args (..), -- hide?
Args (..), -- TODO: hide?
Combine (..), -- TODO: hide?
Settings,
Packages,
FilePaths,
......@@ -12,7 +13,8 @@ module Expression.Base (
project,
arg, args, argPath, argsOrdered, argBuildPath, argBuildDir,
argInput, argOutput,
argConfig, argStagedConfig, argBuilderPath, argStagedBuilderPath,
argConfig, argStagedConfig, argConfigList, argStagedConfigList,
argBuilderPath, argStagedBuilderPath,
argWithBuilder, argWithStagedBuilder,
argPackageKey, argPackageDeps, argPackageDepKeys, argSrcDirs,
argIncludeDirs, argDepIncludeDirs,
......@@ -40,12 +42,15 @@ 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
| ConfigList String -- as above, but evaluates to a list of values
| BuilderPath Builder -- evaluates to the path to a given builder
| PackageData String -- looks up value a given key in package-data.mk
| PackageDataList String -- as above, but evaluates to a list of values
| BootPkgConstraints -- evaluates to boot package constraints
| Fold Combine Settings -- fold settings using a given combine method
data Combine = Concat -- Concatenate: a ++ b
data Combine = Id -- Keep given settings as is
| Concat -- Concatenate: a ++ b
| ConcatPath -- </>-concatenate: a </> b
| ConcatSpace -- concatenate with a space: a ++ " " ++ b
......@@ -85,6 +90,9 @@ argOutput = return Output
argConfig :: String -> Settings
argConfig = return . Config
argConfigList :: String -> Settings
argConfigList = return . ConfigList
argStagedConfig :: String -> Settings
argStagedConfig key =
msum $ map (\s -> stage s ? argConfig (stagedKey s)) [Stage0 ..]
......@@ -92,6 +100,13 @@ argStagedConfig key =
stagedKey :: Stage -> String
stagedKey stage = key ++ "-stage" ++ show stage
argStagedConfigList :: String -> Settings
argStagedConfigList key =
msum $ map (\s -> stage s ? argConfigList (stagedKey s)) [Stage0 ..]
where
stagedKey :: Stage -> String
stagedKey stage = key ++ "-stage" ++ show stage
argBuilderPath :: Builder -> Settings
argBuilderPath = return . BuilderPath
......@@ -123,19 +138,19 @@ argPackageKey :: Settings
argPackageKey = return $ PackageData "PACKAGE_KEY"
argPackageDeps :: Settings
argPackageDeps = return $ PackageData "DEPS"
argPackageDeps = return $ PackageDataList "DEPS"
argPackageDepKeys :: Settings
argPackageDepKeys = return $ PackageData "DEP_KEYS"
argPackageDepKeys = return $ PackageDataList "DEP_KEYS"
argSrcDirs :: Settings
argSrcDirs = return $ PackageData "HS_SRC_DIRS"
argSrcDirs = return $ PackageDataList "HS_SRC_DIRS"
argIncludeDirs :: Settings
argIncludeDirs = return $ PackageData "INCLUDE_DIRS"
argIncludeDirs = return $ PackageDataList "INCLUDE_DIRS"
argDepIncludeDirs :: Settings
argDepIncludeDirs = return $ PackageData "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
argDepIncludeDirs = return $ PackageDataList "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
argBootPkgConstraints :: Settings
argBootPkgConstraints = return BootPkgConstraints
......
{-# LANGUAGE FlexibleInstances #-}
module Expression.Resolve (
ResolveConfig (..)
Resolve (..)
) where
import Base
import Base hiding (Args)
import Package
import Ways
import Util
import Oracles.Base
import Expression.PG
import Expression.Predicate
import Expression.Base
import Expression.Build
-- Resolve configuration variables
class ResolveConfig a where
resolveConfig :: a -> Action a
-- resolveConfig = return . id
-- Resolve unevaluated variables by calling the associated oracles
class Resolve a where
resolve :: a -> Action a
resolve = return . id
instance ResolveConfig BuildPredicate where
resolveConfig p @ (Evaluated _) = return p
-- Nothing to resolve for expressions containing FilePaths, Packages or Ways
instance Resolve FilePath where
instance Resolve Package where
instance Resolve Way where
resolveConfig (Unevaluated (ConfigVariable key value)) = do
--data Args
-- = Plain String -- a plain old string argument: e.g., "-O2"
-- | BuildPath -- evaluates to build path: "libraries/base"
-- | BuildDir -- evaluates to build directory: "dist-install"
-- | 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
-- | ConfigList String
-- | BuilderPath Builder -- evaluates to the path to a given builder
-- | PackageData String -- looks up value a given key in package-data.mk
-- | PackageDataList String
-- | BootPkgConstraints -- evaluates to boot package constraints
-- | Fold Combine Settings -- fold settings using a given combine method
instance Resolve Args where
resolve (Config key) = do
value <- askConfig key
return $ Plain value
resolve (ConfigList key) = do
values <- words <$> askConfig key
return $ Fold Id $ argsOrdered values
resolve (BuilderPath builder) = do
path <- showArg builder
return $ Plain $ unifyPath path
--resolve (PackageData key) = ...
--resolve (PackageDataList key) = ...
--resolve (BootPkgConstraints) = ...
resolve (Fold op settings) = do
settings' <- resolve settings
return $ Fold op settings'
resolve a = return a
instance Resolve BuildPredicate where
resolve p @ (Evaluated _) = return p
resolve (Unevaluated (ConfigVariable key value)) = do
lookup <- askConfig key
return $ Evaluated $ lookup == value
resolveConfig p @ (Unevaluated _) = return p
resolve p @ (Unevaluated _) = return p
resolveConfig (Not p) = do
p' <- resolveConfig p
resolve (Not p) = do
p' <- resolve p
return $ Not p'
resolveConfig (And p q) = do
p' <- resolveConfig p
q' <- resolveConfig q
resolve (And p q) = do
p' <- resolve p
q' <- resolve q
return $ And p' q'
resolveConfig (Or p q) = do
p' <- resolveConfig p
q' <- resolveConfig q
resolve (Or p q) = do
p' <- resolve p
q' <- resolve q
return $ Or p' q'
instance ResolveConfig (BuildExpression v) where
resolveConfig Epsilon = return Epsilon
instance Resolve v => Resolve (BuildExpression v) where
resolve Epsilon = return Epsilon
resolveConfig v @ (Vertex _) = return v -- TODO: go deeper
resolve (Vertex v) = do
v' <- resolve v
return $ Vertex v'
resolveConfig (Overlay l r) = do
l' <- resolveConfig l
r' <- resolveConfig r
resolve (Overlay l r) = do
l' <- resolve l
r' <- resolve r
return $ Overlay l' r'
resolveConfig (Sequence l r) = do
l' <- resolveConfig l
r' <- resolveConfig r
resolve (Sequence l r) = do
l' <- resolve l
r' <- resolve r
return $ Sequence l' r'
resolveConfig (Condition l r) = do
l' <- resolveConfig l
r' <- resolveConfig r
resolve (Condition l r) = do
l' <- resolve l
r' <- resolve r
return $ Condition l' r'
......@@ -7,6 +7,14 @@ import Settings
import Expression.Base
import Expression.Simplify
import Expression.Resolve
import Util
buildSettings = empty
setBuildDir = undefined
buildPackage :: Package -> Ways -> Settings -> Action ()
buildPackage = undefined
main = shakeArgs shakeOptions{shakeFiles="_build/"} $ do
oracleRules
......@@ -15,21 +23,24 @@ main = shakeArgs shakeOptions{shakeFiles="_build/"} $ do
--packageRules
action $ do
putNormal $ "\ntargetPackages = " ++ show (simplify targetPackages)
putNormal $ "\n\ntargetWays = " ++ show (simplify targetWays)
putNormal $ "\n\n=============================\n"
forM_ [Stage0 ..] $ \stage -> do
pkgs <- resolve $ setStage stage targetPackages
case linearise pkgs of
Nothing -> redError "Cannot determine target packages."
Just pkgList ->
forM_ pkgList $ \pkg -> do
let eval = setPackage pkg . setStage stage
dirs <- resolve $ eval targetDirectories
case linearise dirs of
Just [dir] -> do
let eval' = setBuildDir dir . eval
ways <- resolve $ eval' targetWays
stgs <- resolve $ eval' buildSettings
buildPackage pkg ways stgs
_ -> redError "Cannot determine target directory."
-- Read config file
targetPackages' <- resolveConfig targetPackages
targetWays' <- resolveConfig targetWays
-- Build stages
forM_ [Stage0 ..] $ \stage -> do
putNormal $ "Stage = " ++ show stage
let packages = setStage stage targetPackages'
ways = setStage stage targetWays'
putNormal $ "\n packages = " ++ show (simplify packages)
putNormal $ "\n ways = " ++ show (simplify ways)
--forM_ targetPackages $ \pkg @ (Package name path _ todo) -> do
-- forM_ todo $ \todoItem @ (stage, dist, settings) -> do
......
{-# LANGUAGE NoImplicitPrelude #-}
module Targets (
buildHaddock,
targetWays, targetPackages,
targetWays, targetPackages, targetDirectories,
IntegerLibraryImpl (..), integerLibraryImpl, integerLibraryName,
array, base, binPackageDb, binary, bytestring, cabal, containers, deepseq,
directory, filepath, ghcPrim, haskeline, hoopl, hpc, integerLibrary,
......
{-# LANGUAGE NoImplicitPrelude #-}
module Ways (
module Ways ( -- TODO: rename to "Way"?
WayUnit (..),
Way, tag,
......
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