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

Distringuish partial Targets using type synonyms.

parent 9737176b
......@@ -9,10 +9,10 @@ import Base
import Settings
import Expression
newtype ArgsHashKey = ArgsHashKey Target
newtype ArgsHashKey = ArgsHashKey FullTarget
deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
askArgsHash :: Target -> Action Int
askArgsHash :: FullTarget -> Action Int
askArgsHash = askOracle . ArgsHashKey
-- Oracle for storing per-target argument list hashes
......
......@@ -17,7 +17,7 @@ import Util
import Ways
-- Build package-data.mk by using GhcCabal to process pkgCabal file
buildPackageData :: Target -> Rules ()
buildPackageData :: StagePackageTarget -> Rules ()
buildPackageData target =
let stage = getStage target
pkg = getPackage target
......@@ -33,16 +33,14 @@ buildPackageData target =
-- , "build" </> "autogen" </> ("Paths_" ++ name) <.> "hs"
] &%> \_ -> do
let configure = pkgPath pkg </> "configure"
-- TODO: 1) how to automate this? 2) handle multiple files?
newTarget = target { getFile = path </> "package-data.mk"
, getWay = vanilla } -- TODO: think
-- 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]
build $ newTarget { getBuilder = GhcCabal }
-- TODO: 1) automate? 2) mutliple files 3) vanilla?
build $ fullTarget target (path </> "package-data.mk") GhcCabal vanilla
-- TODO: when (registerPackage settings) $
build $ newTarget { getBuilder = GhcPkg stage }
build $ fullTarget target (path </> "package-data.mk") (GhcPkg stage) vanilla
postProcessPackageData $ path </> "package-data.mk"
-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
......
......@@ -6,5 +6,5 @@ import Base
import Rules.Data
import Expression
buildPackage :: Target -> Rules ()
buildPackage :: StagePackageTarget -> Rules ()
buildPackage = buildPackageData
......@@ -9,7 +9,7 @@ import Expression
import Oracles.Builder
import Oracles.ArgsHash
build :: Target -> Action ()
build :: FullTarget -> Action ()
build target = do
argList <- interpret target args
putColoured Green (show target)
......
module Settings.Packages (
module Settings.Default,
packages, knownPackages
) where
......@@ -6,6 +7,7 @@ import Base
import Package
import Switches
import Expression
import Settings.Default
import Settings.User
-- Combining default list of packages with user modifications
......@@ -25,7 +27,8 @@ packagesStage0 = mconcat
packagesStage1 :: Packages
packagesStage1 = mconcat
[ append [ array, base, bytestring, containers, deepseq, directory
[ packagesStage0
, append [ array, base, bytestring, containers, deepseq, directory
, filepath, ghcPrim, haskeline, integerLibrary, parallel
, pretty, primitive, process, stm, templateHaskell, time ]
, windowsHost ? append [win32]
......
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric, TypeSynonymInstances #-}
module Target (
Target (..), stageTarget, stagePackageTarget
Target (..), StageTarget (..), StagePackageTarget (..), FullTarget (..),
stageTarget, stagePackageTarget, fullTarget
) where
import Base
......@@ -17,41 +18,59 @@ data Target = Target
{
getStage :: Stage,
getPackage :: Package,
getBuilder :: Builder,
getFile :: FilePath, -- TODO: handle multple files?
getBuilder :: Builder,
getWay :: Way
}
deriving (Eq, Generic)
-- Shows a target as "package:file@stage (builder, way)"
instance Show Target where
show target = show (getPackage target)
++ ":" ++ show (getFile target)
++ "@" ++ show (getStage target)
++ " (" ++ show (getBuilder target)
++ ", " ++ show (getWay target) ++ ")"
-- StageTarget is a Target whose field getStage is already assigned
type StageTarget = Target
stageTarget :: Stage -> Target
stageTarget :: Stage -> StageTarget
stageTarget stage = Target
{
getStage = stage,
getPackage = error "stageTarget: Package not set",
getBuilder = error "stageTarget: Builder not set",
getFile = error "stageTarget: File not set",
getBuilder = error "stageTarget: Builder not set",
getWay = error "stageTarget: Way not set"
}
stagePackageTarget :: Stage -> Package -> Target
-- StagePackageTarget is a Target whose fields getStage and getPackage are
-- already assigned
type StagePackageTarget = Target
stagePackageTarget :: Stage -> Package -> StagePackageTarget
stagePackageTarget stage package = Target
{
getStage = stage,
getPackage = package,
getBuilder = error "stagePackageTarget: Builder not set",
getFile = error "stagePackageTarget: File not set",
getBuilder = error "stagePackageTarget: Builder not set",
getWay = error "stagePackageTarget: Way not set"
}
-- Instances for storing Target in the Shake database
instance Binary Target
instance NFData Target
instance Hashable Target
-- FullTarget is a Target whose fields are all assigned
type FullTarget = Target
fullTarget :: StagePackageTarget -> FilePath -> Builder -> Way -> FullTarget
fullTarget target file builder way = target
{
getFile = file,
getBuilder = builder,
getWay = way
}
-- Shows a (full) target as "package:file@stage (builder, way)"
instance Show FullTarget where
show target = show (getPackage target)
++ ":" ++ getFile target
++ "@" ++ show (getStage target)
++ " (" ++ show (getBuilder target)
++ ", " ++ show (getWay target) ++ ")"
-- Instances for storing FullTarget in the Shake database
instance Binary FullTarget
instance NFData FullTarget
instance Hashable FullTarget
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