Commit c41e156c authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add support to multiple files in Target, implement registerPackage predicate.

parent 37262111
......@@ -140,7 +140,7 @@ builder :: Builder -> Predicate
builder b = liftM (b ==) (asks getBuilder)
file :: FilePattern -> Predicate
file f = liftM (f ?==) (asks getFile)
file f = liftM (any (f ?==)) (asks getFiles)
way :: Way -> Predicate
way w = liftM (w ==) (asks getWay)
......
module Rules.Actions (
build, run, verboseRun,
build, buildWhen, run, verboseRun,
) where
import Base
......@@ -21,6 +21,11 @@ build target = do
argsHash <- askArgsHash target
run (getBuilder target) argList
buildWhen :: Predicate -> FullTarget -> Action ()
buildWhen predicate target = do
bool <- interpretExpr target predicate
when bool $ build target
-- Run the builder with a given collection of arguments
verboseRun :: Builder -> [String] -> Action ()
verboseRun builder args = do
......
......@@ -4,10 +4,10 @@ module Rules.Data (
cabalArgs, ghcPkgArgs, buildPackageData
) where
import Way
import Base
import Package
import Builder
import Switches
import Expression
import Control.Monad.Extra
import Settings.GhcPkg
......@@ -31,16 +31,14 @@ buildPackageData target =
, "build" </> "autogen" </> "cabal_macros.h"
-- TODO: Is this needed? Also check out Paths_cpsa.hs.
-- , "build" </> "autogen" </> ("Paths_" ++ name) <.> "hs"
] &%> \_ -> do
] &%> \files -> do
let configure = pkgPath pkg </> "configure"
-- 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
whenM (doesFileExist $ configure <.> "ac") $ need [configure]
-- TODO: 1) automate? 2) mutliple files 3) vanilla?
build $ fullTarget target (path </> "package-data.mk") GhcCabal vanilla
-- TODO: when (registerPackage settings) $
build $ fullTarget target (path </> "package-data.mk") (GhcPkg stage) vanilla
build $ fullTarget target files GhcCabal
buildWhen registerPackage $ fullTarget target files (GhcPkg stage)
postProcessPackageData $ path </> "package-data.mk"
-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
......
......@@ -5,7 +5,8 @@ module Switches (
targetOss, targetOs, notTargetOs,
targetArchs, dynamicGhcPrograms, ghcWithInterpreter,
platformSupportsSharedLibs, crossCompiling,
gccIsClang, gccLt46, windowsHost, notWindowsHost
gccIsClang, gccLt46, windowsHost, notWindowsHost,
registerPackage
) where
import Base
......@@ -91,6 +92,10 @@ windowsHost = configKeyValues "host-os-cpp" ["mingw32", "cygwin32"]
notWindowsHost :: Predicate
notWindowsHost = liftM not windowsHost
-- TODO: Actually, we don't register compiler in some circumstances -- fix.
registerPackage :: Predicate
registerPackage = return True
-- splitObjects :: Stage -> Condition
-- splitObjects stage = do
-- arch <- showArg TargetArch
......
{-# LANGUAGE DeriveGeneric, TypeSynonymInstances #-}
module Target (
Target (..), StageTarget (..), StagePackageTarget (..), FullTarget (..),
stageTarget, stagePackageTarget, fullTarget
stageTarget, stagePackageTarget, fullTarget, fullTargetWithWay
) where
import Way
......@@ -18,7 +18,7 @@ data Target = Target
{
getStage :: Stage,
getPackage :: Package,
getFile :: FilePath, -- TODO: handle multple files?
getFiles :: [FilePath],
getBuilder :: Builder,
getWay :: Way
}
......@@ -32,9 +32,9 @@ stageTarget stage = Target
{
getStage = stage,
getPackage = error "stageTarget: Package not set",
getFile = error "stageTarget: File not set",
getFiles = error "stageTarget: Files not set",
getBuilder = error "stageTarget: Builder not set",
getWay = error "stageTarget: Way not set"
getWay = vanilla -- most targets are built only one way (vanilla)
}
-- StagePackageTarget is a Target whose fields getStage and getPackage are
......@@ -46,18 +46,28 @@ stagePackageTarget stage package = Target
{
getStage = stage,
getPackage = package,
getFile = error "stagePackageTarget: File not set",
getFiles = error "stagePackageTarget: Files not set",
getBuilder = error "stagePackageTarget: Builder not set",
getWay = error "stagePackageTarget: Way not set"
getWay = vanilla
}
-- FullTarget is a Target whose fields are all assigned
type FullTarget = Target
fullTarget :: StagePackageTarget -> FilePath -> Builder -> Way -> FullTarget
fullTarget target file builder way = target
-- Most targets are built only one way, vanilla, hence we set it by default.
fullTarget :: StagePackageTarget -> [FilePath] -> Builder -> FullTarget
fullTarget target files builder = target
{
getFile = file,
getFiles = files,
getBuilder = builder,
getWay = vanilla
}
-- Use this function to be explicit about build the way.
fullTargetWithWay :: StagePackageTarget -> [FilePath] -> Builder -> Way -> FullTarget
fullTargetWithWay target files builder way = target
{
getFiles = files,
getBuilder = builder,
getWay = way
}
......@@ -65,7 +75,7 @@ fullTarget target file builder way = target
-- Shows a (full) target as "package:file@stage (builder, way)"
instance Show FullTarget where
show target = show (getPackage target)
++ ":" ++ getFile target
++ ":" ++ show (getFiles target)
++ "@" ++ show (getStage target)
++ " (" ++ show (getBuilder target)
++ ", " ++ show (getWay target) ++ ")"
......
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