hadrian: Use a stamp file to record when a package is built in a certain way

Before this patch which library ways we had built wasn't recorded
directly. So you would run into issues if you build the .conf file with
some library ways before switching the library ways which you wanted to
build.

Now there is one stamp file for each way, so in order to build a
specific way you can need that specific stamp file rather than going
indirectly via the .conf file.

5 files changed, 92 insertions, 4 deletions

diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index c37974914a..6e277094e5 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -154,6 +154,7 @@ executable hadrian
                        , directory            >= 1.3.1.0 && < 1.4
                        , extra                >= 1.4.7
                        , filepath
+                       , time
                        , mtl                  == 2.2.*
                        , parsec               >= 3.1     && < 3.2
                        , shake                >= 0.18.3  && < 0.20
diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs
index eb9d7caf81..2b8f1948c3 100644
--- a/hadrian/src/Context.hs
+++ b/hadrian/src/Context.hs
@@ -9,7 +9,7 @@ module Context (
     contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
     pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName,
     pkgLibraryFile, pkgGhciLibraryFile,
-    pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir,
+    pkgConfFile, pkgStampFile, objectPath, contextPath, getContextPath, libPath, distDir,
     haddockStatsFilesDir
     ) where
 
@@ -132,6 +132,12 @@ pkgConfFile Context {..} = do
     dbPath <- packageDbPath stage
     return $ dbPath -/- pid <.> "conf"
 
+pkgStampFile :: Context -> Action FilePath
+pkgStampFile c@Context{..} = do
+    let extension = waySuffix way
+    pkgFile c "stamp-" extension
+
+
 -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
 -- to its object file. For example:
 -- * "Task.c"                              -> "_build/stage1/rts/Task.thr_o"
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
index bb502f9875..46747f9d35 100644
--- a/hadrian/src/Rules/Library.hs
+++ b/hadrian/src/Rules/Library.hs
@@ -15,6 +15,11 @@ import Rules.Register
 import Settings
 import Target
 import Utilities
+import Data.Time.Clock
+import Rules.Generate (generatedDependencies)
+import Hadrian.Oracles.Cabal (readPackageData)
+import Oracles.Flag
+
 
 -- * Library 'Rules'
 
@@ -25,6 +30,7 @@ libraryRules = do
     root -/- "**/libHS*-*.so"          %> buildDynamicLib root "so"
     root -/- "**/libHS*-*.dll"         %> buildDynamicLib root "dll"
     root -/- "**/*.a"                  %> buildStaticLib  root
+    root -/- "**/stamp-*"              %> buildPackage root
     priority 2 $ do
         root -/- "stage*/lib/**/libHS*-*.dylib" %> registerDynamicLib root "dylib"
         root -/- "stage*/lib/**/libHS*-*.so"    %> registerDynamicLib root "so"
@@ -105,6 +111,60 @@ buildGhciLibO root ghcilibPath = do
     need objs
     build $ target context (MergeObjects stage) objs [ghcilibPath]
 
+
+{-
+Note [Stamp Files]
+~~~~~~~~~~~~~~~~~~
+
+A package stamp file exists to communicate that all the objects for a certain
+package are built.
+
+If you need a stamp file, then it needs all the library dependencies
+
+The format for a stamp file is defined in `pkgStampFile`. The stamp file is named
+"stamp-<way>" so if you want to build base in dynamic way then need `_build/stage1/libraries/base/stamp-dyn`
+
+By using stamp files you can easily say you want to build a library in a certain
+way by needing the stamp file for that context.
+
+Before these stamp files existed the way to declare that all objects in a certain way
+were build was by needing the .conf file for the package. Stamp files decouple this
+decision from creating the .conf file which does extra stuff such as linking, copying
+files etc.
+
+-}
+
+
+buildPackage :: FilePath -> FilePath -> Action ()
+buildPackage root fp = do
+  l@(BuildPath _ stage _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp
+  let ctx = stampContext l
+  srcs <- hsSources ctx
+  gens <- interpretInContext ctx generatedDependencies
+
+  depPkgs <- packageDependencies <$> readPackageData (package ctx)
+  -- Stage packages are those we have in this stage.
+  stagePkgs <- stagePackages stage
+  -- We'll need those packages in our package database.
+  deps <- sequence [ pkgConfFile (ctx { package = pkg })
+                   | pkg <- depPkgs, pkg `elem` stagePkgs ]
+  need deps
+  need (srcs ++ gens)
+
+  need =<< libraryTargets True ctx
+  time <- liftIO $ getCurrentTime
+  liftIO $ writeFile fp (show time)
+  ways <- interpretInContext ctx getLibraryWays
+  let hasVanilla = elem vanilla ways
+      hasDynamic = elem dynamic ways
+  support <- platformSupportsSharedLibs
+  when ((hasVanilla && hasDynamic) &&
+        support && way == vanilla) $ do
+    stamp <- (pkgStampFile (ctx { way = dynamic }))
+    liftIO $ writeFile stamp (show time)
+
+
+
 -- * Helpers
 
 -- | Return all Haskell and non-Haskell object files for the given 'Context'.
@@ -199,6 +259,22 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) =
   where
     pkg = library pkgname pkgpath
 
+-- | Get the 'Context' corresponding to the build path for a given static library.
+stampContext :: BuildPath PkgStamp -> Context
+stampContext (BuildPath _ stage _ (PkgStamp pkgname _ way)) =
+    Context stage pkg way
+  where
+    pkg = unsafeFindPackageByName pkgname
+
+data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show)
+
+
+-- | Parse a path to a ghci library to be built, making sure the path starts
+-- with the given build root.
+parseStampPath :: FilePath -> Parsec.Parsec String () (BuildPath PkgStamp)
+parseStampPath root = parseBuildPath root parseStamp
+
+
 -- | Parse a path to a registered ghc-pkg static library to be built, making
 -- sure the path starts with the given build root.
 parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA)
@@ -262,6 +338,13 @@ parseLibDynFilename ext = do
     _ <- Parsec.string ("." ++ ext)
     return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib)
 
+parseStamp :: Parsec.Parsec String () PkgStamp
+parseStamp = do
+    _ <- Parsec.string "stamp-"
+    (pkgname, pkgver) <- parsePkgId
+    way <- parseWaySuffix vanilla
+    return (PkgStamp pkgname pkgver way)
+
 -- | Get the package identifier given the package name and version.
 pkgId :: String -> [Integer] -> String
 pkgId name version = name ++ "-" ++ intercalate "." (map show version)
diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs
index 64b32283cb..dcd05e240c 100644
--- a/hadrian/src/Rules/Register.hs
+++ b/hadrian/src/Rules/Register.hs
@@ -124,7 +124,7 @@ buildConf _ context@Context {..} _conf = do
     need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds
 
     ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty)
-    need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- Set.toList ways ]
+    need =<< mapM pkgStampFile [ context { way = w } | w <- Set.toList ways ]
 
     -- We might need some package-db resource to limit read/write, see packageRules.
     path <- buildPath context
diff --git a/hadrian/src/Settings/Builders/Haddock.hs b/hadrian/src/Settings/Builders/Haddock.hs
index 38c786de43..9ecdabfec7 100644
--- a/hadrian/src/Settings/Builders/Haddock.hs
+++ b/hadrian/src/Settings/Builders/Haddock.hs
@@ -9,8 +9,6 @@ import Packages
 import Rules.Documentation
 import Settings.Builders.Common
 import Settings.Builders.Ghc
-import Utilities
-import Context.Type as C
 import CommandLine
 import qualified Data.Text as T