Bump Cabal upper bound (#651)
[hadrian.git] / src / Target.hs
index 6efbd6d..30c8d98 100644 (file)
@@ -1,76 +1,26 @@
-{-# LANGUAGE DeriveGeneric, TypeSynonymInstances #-}
 module Target (
-    Target (..), StageTarget (..), StagePackageTarget (..), FullTarget (..),
-    stageTarget, stagePackageTarget, fullTarget
+    Target, target, context, builder, inputs, outputs, trackArgument,
+    module Builder
     ) where
 
-import Base
-import Ways
-import Package
-import Builder
-import GHC.Generics
-import Development.Shake.Classes
-
--- Target captures parameters relevant to the current build target: Stage and
--- Package being built, Builder that is to be invoked, file(s) that are to
--- be built and the Way they are to be built.
-data Target = Target
-     {
-        getStage   :: Stage,
-        getPackage :: Package,
-        getFile    :: FilePath, -- TODO: handle multple files?
-        getBuilder :: Builder,
-        getWay     :: Way
-     }
-     deriving (Eq, Generic)
-
--- StageTarget is a Target whose field getStage is already assigned
-type StageTarget = Target
-
-stageTarget :: Stage -> StageTarget
-stageTarget stage = Target
-    {
-        getStage   = stage,
-        getPackage = error "stageTarget: Package not set",
-        getFile    = error "stageTarget: File not set",
-        getBuilder = error "stageTarget: Builder not set",
-        getWay     = error "stageTarget: Way not set"
-    }
-
--- StagePackageTarget is a Target whose fields getStage and getPackage are
--- already assigned
-type StagePackageTarget = Target
+import Data.Char
+import Data.List.Extra
 
-stagePackageTarget :: Stage -> Package -> StagePackageTarget
-stagePackageTarget stage package = Target
-    {
-        getStage   = stage,
-        getPackage = package,
-        getFile    = error "stagePackageTarget: File not set",
-        getBuilder = error "stagePackageTarget: Builder not set",
-        getWay     = error "stagePackageTarget: Way not set"
-    }
+import qualified Hadrian.Target as H
+import Hadrian.Target hiding (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
+import Builder
+import Context
+
+type Target = H.Target Context Builder
+
+-- | Some arguments do not affect build results and therefore do not need to be
+-- tracked by the build system. A notable example is "-jN" that controls Make's
+-- parallelism. Given a 'Target' and an argument, this function should return
+-- 'True' only if the argument needs to be tracked.
+trackArgument :: Target -> String -> Bool
+trackArgument target arg = case builder target of
+    (Make _) -> not $ threadArg arg
+    _        -> True
+  where
+    threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="]