Commit 51028b8d authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Clean up Expression package.

parent 4ad4d412
{-# LANGUAGE FlexibleInstances #-}
module Expression.Base (
module Expression.Args,
module Expression.Build,
BuildPredicate,
module Expression.Derived,
module Expression.Project,
module Expression.Resolve,
module Expression.Simplify,
module Expression.Predicate,
module Control.Applicative,
module Expression.BuildExpression,
module Control.Applicative
) where
import Base
import Expression.Args
hiding ( Args, BuildParameter, EnvironmentParameter, Arity, Combine )
import Expression.Build hiding (BuildVariable)
import Expression.Derived
import Expression.Predicate
import Expression.BuildPredicate
import Control.Monad
import Expression.BuildExpression
import Expression.Project
import Expression.Resolve
import Expression.Simplify
......
module Expression.BuildExpression (
BuildExpression,
Ways, Packages, TargetDirs,
-- reexport from Expression.PG:
bimap, (|>), (?), (??), whenExists, support,
msum, mproduct,
fromList, fromOrderedList
) where
import Base
import Ways
import Package (Package)
import Expression.PG
import Expression.BuildPredicate
type BuildExpression v = PG BuildPredicate v
type Ways = BuildExpression Way
type Packages = BuildExpression Package
type TargetDirs = BuildExpression TargetDir
{-# LANGUAGE NoImplicitPrelude, FlexibleInstances, TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude, TypeFamilies #-}
module Expression.Build (
module Expression.BuildPredicate (
BuildVariable (..),
BuildPredicate (..),
BuildExpression,
Ways, Packages, TargetDirs,
(?), (??), whenExists, support,
(|>), msum, mproduct, fromList, fromOrderedList,
packages, package,
builders, builder, stagedBuilder,
stages, stage, notStage,
ways, way, files, file,
configValues, config, configYes, configNo, configNonEmpty
BuildPredicate (..)
) where
import Base
import Ways
import Oracles.Builder
import Package (Package)
import Expression.PG
import Expression.Predicate
-- Build variables that can be used in build predicates
data BuildVariable = PackageVariable Package
......@@ -38,18 +29,6 @@ data BuildPredicate
| Or BuildPredicate BuildPredicate -- Disjunction
deriving Eq -- TODO: create a proper Eq instance (use BDDs?)
instance Show BuildPredicate where
showsPrec _ (Evaluated bool) = shows bool
showsPrec _ (Unevaluated var) = shows var
showsPrec d (Or p q) =
showParen (d > 0) $ shows p . showString " \\/ " . shows q
showsPrec d (And p q) =
showParen (d > 1) $ showsPrec 1 p . showString " /\\ " . showsPrec 1 q
showsPrec d (Not p) = showChar '!' . showsPrec 2 p
instance Predicate BuildPredicate where
type Variable BuildPredicate = BuildVariable
variable = Unevaluated
......@@ -59,63 +38,14 @@ instance Predicate BuildPredicate where
(&&) = And
(||) = Or
alternatives :: Predicate a => (b -> Variable a) -> [b] -> a
alternatives f = foldr (||) false . map (variable . f)
type BuildExpression v = PG BuildPredicate v
type Ways = BuildExpression Way
type Packages = BuildExpression Package
type TargetDirs = BuildExpression TargetDir
-- Basic GHC build predicates
packages :: [Package] -> BuildPredicate
packages = alternatives PackageVariable
builders :: [Builder] -> BuildPredicate
builders = alternatives BuilderVariable
stages :: [Stage] -> BuildPredicate
stages = alternatives StageVariable
ways :: [Way] -> BuildPredicate
ways = alternatives WayVariable
files :: [FilePattern] -> BuildPredicate
files = alternatives FileVariable
configValues :: String -> [String] -> BuildPredicate
configValues key = alternatives (ConfigVariable key)
package :: Package -> BuildPredicate
package p = packages [p]
builder :: Builder -> BuildPredicate
builder b = builders [b]
stagedBuilder :: (Stage -> Builder) -> BuildPredicate
stagedBuilder s2b = builders $ map s2b [Stage0 ..]
stage :: Stage -> BuildPredicate
stage s = stages [s]
notStage :: Stage -> BuildPredicate
notStage = not . Unevaluated . StageVariable
way :: Way -> BuildPredicate
way w = ways [w]
file :: FilePattern -> BuildPredicate
file f = files [f]
config :: String -> String -> BuildPredicate
config key value = configValues key [value]
instance Show BuildPredicate where
showsPrec _ (Evaluated bool) = shows bool
showsPrec _ (Unevaluated var) = shows var
configYes :: String -> BuildPredicate
configYes key = configValues key ["YES"]
showsPrec d (Or p q) =
showParen (d > 0) $ shows p . showString " \\/ " . shows q
configNo :: String -> BuildPredicate
configNo key = configValues key ["NO" ]
showsPrec d (And p q) =
showParen (d > 1) $ showsPrec 1 p . showString " /\\ " . showsPrec 1 q
configNonEmpty :: String -> BuildPredicate
configNonEmpty key = not $ configValues key [""]
showsPrec d (Not p) = showChar '!' . showsPrec 2 p
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Expression.Args (
Args (..), BuildParameter (..), EnvironmentParameter (..),
Arity (..), Combine (..),
module Expression.Derived (
Settings,
-- Constructing build predicates
packages, package,
builders, builder, stagedBuilder,
stages, stage, notStage,
ways, way, files, file,
configValues, config, configYes, configNo, configNonEmpty,
-- Primitive settings elements
arg, args, argPath, argsOrdered, argBuildPath, argBuildDir,
argInput, argOutput,
argConfig, argStagedConfig, argConfigList, argStagedConfigList,
......@@ -16,53 +23,71 @@ module Expression.Args (
argPackageConstraints
) where
import Base hiding (arg, args, Args)
import Base hiding (Args, arg, args)
import Ways
import Util
import Package (Package)
import Oracles.Builder
import Expression.Build
-- Settings comprise the following primitive elements
data Args
= Plain String -- e.g. "-O2"
| BuildParameter BuildParameter -- e.g. build path
| EnvironmentParameter EnvironmentParameter -- e.g. host OS
| Fold Combine Settings -- e.g. ccSettings
deriving (Show, Eq)
-- Build parameters to be determined during the build process
data BuildParameter
= PackagePath -- path to the current package, e.g. "libraries/deepseq"
| BuildDir -- build directory, e.g. "dist-install"
| Input -- input file(s), e.g. "src.hs"
| Output -- output file(s), e.g. ["src.o", "src.hi"]
deriving (Show, Eq)
-- Environment parameters to be determined using oracles
data EnvironmentParameter
= BuilderPath Builder -- look up path to a Builder
| Config Arity String -- look up configuration flag(s)
| PackageData -- look up package-data.mk flag(s)
{
pdArity :: Arity, -- arity of value (Single or Multiple)
pdKey :: String, -- key to look up, e.g. "PACKAGE_KEY"
pdPackagePath :: Maybe FilePath, -- path to the current package
pdBuildDir :: Maybe FilePath -- build directory
}
| PackageConstraints Packages -- package version constraints
deriving (Show, Eq)
-- Method for combining settings elements in Fold Combine Settings
data Combine = Id -- Keep given settings as is
| Concat -- Concatenate: a ++ b
| ConcatPath -- </>-concatenate: a </> b
| ConcatSpace -- concatenate with a space: a ++ " " ++ b
deriving (Show, Eq)
data Arity = Single -- expands to a single argument
| Multiple -- expands to a list of arguments
deriving (Show, Eq)
type Settings = BuildExpression Args
import Expression.PG
import Expression.Settings
import Expression.BuildPredicate
import Expression.BuildExpression
-- Auxiliary function for multiway disjunction
alternatives :: Predicate a => (b -> Variable a) -> [b] -> a
alternatives f = foldr (||) false . map (variable . f)
-- Basic GHC build predicates
packages :: [Package] -> BuildPredicate
packages = alternatives PackageVariable
builders :: [Builder] -> BuildPredicate
builders = alternatives BuilderVariable
stages :: [Stage] -> BuildPredicate
stages = alternatives StageVariable
ways :: [Way] -> BuildPredicate
ways = alternatives WayVariable
files :: [FilePattern] -> BuildPredicate
files = alternatives FileVariable
configValues :: String -> [String] -> BuildPredicate
configValues key = alternatives (ConfigVariable key)
package :: Package -> BuildPredicate
package p = packages [p]
builder :: Builder -> BuildPredicate
builder b = builders [b]
stagedBuilder :: (Stage -> Builder) -> BuildPredicate
stagedBuilder s2b = builders $ map s2b [Stage0 ..]
stage :: Stage -> BuildPredicate
stage s = stages [s]
notStage :: Stage -> BuildPredicate
notStage = not . Unevaluated . StageVariable
way :: Way -> BuildPredicate
way w = ways [w]
file :: FilePattern -> BuildPredicate
file f = files [f]
config :: String -> String -> BuildPredicate
config key value = configValues key [value]
configYes :: String -> BuildPredicate
configYes key = configValues key ["YES"]
configNo :: String -> BuildPredicate
configNo key = configValues key ["NO" ]
configNonEmpty :: String -> BuildPredicate
configNonEmpty key = not $ configValues key [""]
-- A single argument
arg :: String -> Settings
......
......@@ -9,14 +9,17 @@ import Package
import Ways
import Oracles.Builder
import Expression.PG
import Expression.Args
import Expression.Build
import Expression.Settings
import Expression.BuildPredicate
import Expression.BuildExpression
-- Projecting (partially evaluating) values of type b by setting the
-- parameters of type a
class Project a b where
project :: a -> b -> b
project = const id
-- Project recursively through Not, And and Or
-- Project a build predicate recursively through Not, And and Or
pmap :: Project a BuildPredicate => a -> BuildPredicate -> BuildPredicate
pmap a (Not p ) = Not (project a p)
pmap a (And p q) = And (project a p) (project a q)
......@@ -130,4 +133,3 @@ instance (Project a z, Project b z) => Project (a, b) z where
instance (Project a z, Project b z, Project c z) => Project (a, b, c) z where
project (p, q, r) = project p . project q . project r
......@@ -13,8 +13,10 @@ import Expression.Simplify
import Oracles.Base
import Oracles.PackageData
import Expression.PG
import Expression.Args
import Expression.Build
import Expression.Derived
import Expression.Settings
import Expression.BuildPredicate
import Expression.BuildExpression
-- Resolve unevaluated variables by calling the associated oracles
class Resolve a where
......
{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-}
module Expression.Settings (
Args (..), BuildParameter (..), EnvironmentParameter (..),
Arity (..), Combine (..),
Settings
) where
import Base hiding (Args)
import Oracles.Builder
import Expression.Predicate
import Expression.BuildExpression
type Settings = BuildExpression Args
-- Settings comprise the following primitive elements
data Args
= Plain String -- e.g. "-O2"
| BuildParameter BuildParameter -- e.g. build path
| EnvironmentParameter EnvironmentParameter -- e.g. host OS
| Fold Combine Settings -- e.g. ccSettings
deriving (Show, Eq)
-- Build parameters to be determined during the build process
data BuildParameter
= PackagePath -- path to the current package, e.g. "libraries/deepseq"
| BuildDir -- build directory, e.g. "dist-install"
| Input -- input file(s), e.g. "src.hs"
| Output -- output file(s), e.g. ["src.o", "src.hi"]
deriving (Show, Eq)
-- Environment parameters to be determined using oracles
data EnvironmentParameter
= BuilderPath Builder -- look up path to a Builder
| Config Arity String -- look up configuration flag(s)
| PackageData -- look up package-data.mk flag(s)
{
pdArity :: Arity, -- arity of value (Single or Multiple)
pdKey :: String, -- key to look up, e.g. "PACKAGE_KEY"
pdPackagePath :: Maybe FilePath, -- path to the current package
pdBuildDir :: Maybe FilePath -- build directory
}
| PackageConstraints Packages -- package version constraints
deriving (Show, Eq)
-- Method for combining settings elements in Fold Combine Settings
data Combine = Id -- Keep given settings as is
| Concat -- Concatenate: a ++ b
| ConcatPath -- </>-concatenate: a </> b
| ConcatSpace -- concatenate with a space: a ++ " " ++ b
deriving (Show, Eq)
data Arity = Single -- expands to a single argument
| Multiple -- expands to a list of arguments
deriving (Show, Eq)
......@@ -8,8 +8,9 @@ import Base hiding (Args)
import Ways
import Package
import Expression.PG
import Expression.Args
import Expression.Build
import Expression.Settings
import Expression.BuildPredicate
import Expression.BuildExpression
-- Simplify expressions by constant propagation
class Simplify a where
......
......@@ -108,7 +108,6 @@ customConfigureSettings = msum
arg "--configure-option=--with-intree-gmp"
]
-- TODISCUSS
-- Note [Cabal name weirdness]
-- Find out if we can move the contents to just Cabal/
-- What is Cabal/cabal-install? Do we need it?
......
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