Factor out file cache functionality into the library
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Thu, 17 Aug 2017 01:16:45 +0000 (02:16 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Thu, 17 Aug 2017 01:16:45 +0000 (02:16 +0100)
See #347

hadrian.cabal
src/Base.hs
src/Hadrian/Oracles/FileCache.hs [new file with mode: 0644]
src/Rules.hs
src/Rules/Cabal.hs [deleted file]
src/Settings/Builders/GhcCabal.hs
src/Utilities.hs

index 1520881..7c45af6 100644 (file)
@@ -30,6 +30,7 @@ executable hadrian
                        , Hadrian.Haskell.Cabal
                        , Hadrian.Oracles.ArgsHash
                        , Hadrian.Oracles.DirectoryContents
+                       , Hadrian.Oracles.FileCache
                        , Hadrian.Oracles.KeyValue
                        , Hadrian.Oracles.Path
                        , Hadrian.Target
@@ -40,7 +41,6 @@ executable hadrian
                        , Oracles.PackageData
                        , Package
                        , Rules
-                       , Rules.Cabal
                        , Rules.Clean
                        , Rules.Compile
                        , Rules.Configure
index deccab6..8c81706 100644 (file)
@@ -71,13 +71,11 @@ configH = "mk/config.h"
 shakeFilesDir :: FilePath
 shakeFilesDir = "hadrian"
 
--- | The file storing boot package versions extracted from @.cabal@ files. It
--- is generated by "Rules.Cabal".
+-- | The file storing boot package constraints extracted from @.cabal@ files.
 bootPackageConstraints :: FilePath
 bootPackageConstraints = shakeFilesDir -/- "boot-package-constraints"
 
--- | The file storing package dependencies extracted from @.cabal@ files. It
--- is generated by "Rules.Cabal".
+-- | The file storing package dependencies extracted from @.cabal@ files.
 packageDependencies :: FilePath
 packageDependencies = shakeFilesDir -/- "package-dependencies"
 
diff --git a/src/Hadrian/Oracles/FileCache.hs b/src/Hadrian/Oracles/FileCache.hs
new file mode 100644 (file)
index 0000000..e6b2e57
--- /dev/null
@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Oracles.FileCache
+-- Copyright  : (c) Andrey Mokhov 2014-2017
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- Build and read text file caches. File caches can be used to cache expensive
+-- computations whose results are not expected to change between builds. One
+-- example is parsing package @.cabal@ files to determine all inter-package
+-- dependencies. Use "Hadrian.Oracles.KeyValue" to read and track individual
+-- lines in text file caches.
+-----------------------------------------------------------------------------
+module Hadrian.Oracles.FileCache (readFileCache, fileCacheRules) where
+
+import Control.Monad
+import Development.Shake
+import Development.Shake.Classes
+
+import Hadrian.Utilities
+
+newtype FileCache = FileCache FilePath
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+
+-- | Read a text file, caching and tracking the result. To read and track
+-- individual lines of the file, see "Hadrian.Oracles.KeyValue".
+readFileCache :: FilePath -> Action String
+readFileCache = askOracle . FileCache
+
+-- | This oracle builds text files using supplied generators and caches access
+-- to them to efficiently answer 'readFileCache' queries, tracking the results.
+-- The argument is a list of pairs @(pattern, generator)@, where @pattern@
+-- describes the files that can be built using the corresponding @generator@
+-- action. The latter takes a specific file path to be generated as the input.
+fileCacheRules :: [(FilePattern, FilePath -> Action String)] -> Rules ()
+fileCacheRules patternGenerators = do
+    -- Generate file contents
+    forM_ patternGenerators $ \(pattern, generate) ->
+        pattern %> \file -> do
+            contents <- generate file
+            writeFileChanged file contents
+            putSuccess $ "| Successfully generated " ++ file
+    -- Cache file reading
+    cache <- newCache $ \file -> do
+        need [file]
+        putLoud $ "Reading " ++ file ++ "..."
+        liftIO $ readFile file
+    void $ addOracle $ \(FileCache file) -> cache file
index 254aedf..02dc879 100644 (file)
@@ -2,6 +2,7 @@ module Rules (buildRules, oracleRules, packageTargets, topLevelTargets) where
 
 import qualified Hadrian.Oracles.ArgsHash
 import qualified Hadrian.Oracles.DirectoryContents
+import qualified Hadrian.Oracles.FileCache
 import qualified Hadrian.Oracles.KeyValue
 import qualified Hadrian.Oracles.Path
 
@@ -15,7 +16,6 @@ import qualified Rules.Data
 import qualified Rules.Dependencies
 import qualified Rules.Documentation
 import qualified Rules.Generate
-import qualified Rules.Cabal
 import qualified Rules.Configure
 import qualified Rules.Gmp
 import qualified Rules.Libffi
@@ -24,14 +24,15 @@ import qualified Rules.Perl
 import qualified Rules.Program
 import qualified Rules.Register
 import Settings
+import Settings.Builders.GhcCabal
 import Target
 import Utilities
 
 allStages :: [Stage]
 allStages = [minBound ..]
 
--- | This rule 'need' all top-level build targets
--- or Stage1Only targets
+-- | This rule calls 'need' on all top-level build targets, respecting the
+-- 'Stage1Only' flag.
 topLevelTargets :: Rules ()
 topLevelTargets = action $ do
     let libraryPackages = filter isLibrary (knownPackages \\ [rts, libffi])
@@ -98,7 +99,6 @@ packageRules = do
 
 buildRules :: Rules ()
 buildRules = do
-    Rules.Cabal.cabalRules
     Rules.Configure.configureRules
     Rules.Generate.copyRules
     Rules.Generate.generateRules
@@ -107,16 +107,19 @@ buildRules = do
     packageRules
     Rules.Perl.perlScriptRules
 
+generators :: [(FilePattern, FilePath -> Action String)]
+generators = [ ("//" -/- bootPackageConstraints, bootPackageConstraintsGenerator)
+             , ("//" -/- packageDependencies   , packageDependenciesGenerator   ) ]
+
 oracleRules :: Rules ()
 oracleRules = do
     Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs
     Hadrian.Oracles.DirectoryContents.directoryContentsOracle
+    Hadrian.Oracles.FileCache.fileCacheRules generators
     Hadrian.Oracles.KeyValue.keyValueOracle
     Hadrian.Oracles.Path.pathOracle
     Oracles.ModuleFiles.moduleFilesOracle
 
 programsStage1Only :: [Package]
-programsStage1Only =
-    [ deriveConstants, genprimopcode, hp2ps, runGhc
-    , ghcCabal, hpc, dllSplit, ghcPkg, hsc2hs
-    , genapply, ghc ]
+programsStage1Only = [ deriveConstants, dllSplit, genapply, genprimopcode, ghc
+                     , ghcCabal, ghcPkg, hp2ps, hpc, hsc2hs, runGhc ]
diff --git a/src/Rules/Cabal.hs b/src/Rules/Cabal.hs
deleted file mode 100644 (file)
index ab8c6f9..0000000
+++ /dev/null
@@ -1,30 +0,0 @@
-module Rules.Cabal (cabalRules) where
-
-import Hadrian.Haskell.Cabal
-
-import Base
-import GHC
-import Settings
-
-cabalRules :: Rules ()
-cabalRules = do
-    -- Cache boot package constraints (to be used in 'cabalArgs').
-    "//" -/- bootPackageConstraints %> \out -> do
-        bootPkgs <- stagePackages Stage0
-        let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
-        constraints <- forM (sort pkgs) $ \pkg -> do
-            (name, version) <- cabalNameVersion (pkgCabalFile pkg)
-            return $ name ++ " == " ++ version
-        writeFileChanged out . unlines $ constraints
-        putSuccess $ "| Successfully generated boot package constraints"
-
-    -- Cache package dependencies.
-    "//" -/- packageDependencies %> \out -> do
-        pkgDeps <- forM (sort knownPackages) $ \pkg -> do
-            exists <- doesFileExist (pkgCabalFile pkg)
-            if not exists then return $ pkgNameString pkg
-            else do
-                deps <- sort <$> cabalDependencies (pkgCabalFile pkg)
-                return . unwords $ pkgNameString pkg : (deps \\ [pkgNameString pkg])
-        writeFileChanged out $ unlines pkgDeps
-        putSuccess $ "| Successfully generated package dependencies"
index a792437..d6c1c74 100644 (file)
@@ -1,7 +1,10 @@
 module Settings.Builders.GhcCabal (
-    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs
+    bootPackageConstraintsGenerator, ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs
     ) where
 
+import Hadrian.Haskell.Cabal
+import Hadrian.Oracles.FileCache
+
 import Context
 import Flavour
 import Settings.Builders.Common hiding (package)
@@ -88,10 +91,20 @@ configureArgs = do
         , crossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull)
         , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage ]
 
+bootPackageConstraintsGenerator :: FilePath -> Action String
+bootPackageConstraintsGenerator _ = do
+    bootPkgs <- stagePackages Stage0
+    let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
+    constraints <- forM (sort pkgs) $ \pkg -> do
+        (name, version) <- cabalNameVersion (pkgCabalFile pkg)
+        return (name ++ " == " ++ version)
+    return (unlines constraints)
+
 packageConstraints :: Args
 packageConstraints = stage0 ? do
+    -- 'bootPackageConstraints' is generated by 'bootPackageConstraintsGenerator'.
     path <- getBuildRoot <&> (-/- bootPackageConstraints)
-    constraints <- expr $ readFileLines path
+    constraints <- lines <$> expr (readFileCache path)
     pure $ concat [ ["--constraint", c] | c <- constraints ]
 
 cppArgs :: Args
index 0887646..82f9b9b 100644 (file)
@@ -2,11 +2,13 @@ module Utilities (
     build, buildWithCmdOptions, buildWithResources, applyPatch, runBuilder,
     runBuilderWith, builderEnvironment, needBuilder, needLibrary,
     installDirectory, installData, installScript, installProgram, linkSymbolic,
-    contextDependencies, pkgDependencies, libraryTargets, topsortPackages
+    contextDependencies, pkgDependencies, libraryTargets, topsortPackages,
+    packageDependenciesGenerator
     ) where
 
 import qualified System.Directory.Extra as IO
 
+import Hadrian.Haskell.Cabal
 import Hadrian.Oracles.ArgsHash
 import Hadrian.Oracles.KeyValue
 import Hadrian.Oracles.Path
@@ -183,15 +185,26 @@ runBuilderWith options builder args = do
     putBuild $ "| Run " ++ show builder ++ note
     quietly $ cmd options [path] args
 
+packageDependenciesGenerator :: FilePath -> Action String
+packageDependenciesGenerator _ = do
+    pkgDeps <- forM (sort knownPackages) $ \pkg -> do
+        exists <- doesFileExist (pkgCabalFile pkg)
+        if not exists then return (pkgNameString pkg)
+        else do
+            deps <- nubOrd . sort <$> cabalDependencies (pkgCabalFile pkg)
+            return . unwords $ pkgNameString pkg : (deps \\ [pkgNameString pkg])
+    return (unlines pkgDeps)
+
 -- | Given a 'Context' this 'Action' looks up its package dependencies in
 -- 'Base.packageDependencies' and wraps the results in appropriate contexts.
 -- The only subtlety here is that we never depend on packages built in 'Stage2'
 -- or later, therefore the stage of the resulting dependencies is bounded from
 -- above at 'Stage1'. To compute package dependencies we scan package cabal
--- files, see "Rules.Cabal".
+-- files, see 'cabalDependencies' defined in "Hadrian.Haskell.Cabal".
 contextDependencies :: Context -> Action [Context]
 contextDependencies Context {..} = do
     let pkgContext = \pkg -> Context (min stage Stage1) pkg way
+    -- 'packageDependencies' is generated by 'packageDependenciesGenerator'.
     path <- buildRoot <&> (-/- packageDependencies)
     deps <- lookupValuesOrError path (pkgNameString package)
     pkgs <- sort <$> interpretInContext (pkgContext package) getPackages