Improve infrastructure for Cabal file parsing

hadrian.cabal

@@ -28,12 +28,12 @@ executable hadrian
                        , GHC
                        , Hadrian.Expression
                        , Hadrian.Haskell.Cabal
+                       , Hadrian.Haskell.Cabal.Parse
                        , Hadrian.Haskell.Package
                        , Hadrian.Oracles.ArgsHash
                        , Hadrian.Oracles.DirectoryContents
-                       , Hadrian.Oracles.FileCache
-                       , Hadrian.Oracles.KeyValue
                        , Hadrian.Oracles.Path
+                       , Hadrian.Oracles.TextFile
                        , Hadrian.Target
                        , Hadrian.Utilities
                        , Oracles.Flag

src/Base.hs

@@ -21,9 +21,9 @@ module Base (
 
     -- * Paths
     hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir,
-    bootPackageConstraints, packageDependencies, generatedDir, inplaceBinPath,
-    inplaceLibBinPath, inplaceLibPath, inplaceLibCopyTargets, templateHscPath,
-    stage0PackageDbDir, inplacePackageDbPath, packageDbStamp
+    generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
+    inplaceLibCopyTargets, templateHscPath, stage0PackageDbDir,
+    inplacePackageDbPath, packageDbStamp
     ) where
 
 import Control.Applicative
@@ -71,14 +71,6 @@ configH = "mk/config.h"
 shakeFilesDir :: FilePath
 shakeFilesDir = "hadrian"
 
--- | 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.
-packageDependencies :: FilePath
-packageDependencies = shakeFilesDir -/- "package-dependencies"
-
 -- | The directory in 'buildRoot' containing generated source files that are not
 -- package-specific, e.g. @ghcplatform.h@.
 generatedDir :: FilePath

src/GHC.hs

@@ -17,8 +17,8 @@ module GHC (
     systemBuilderPath, ghcSplitPath, stripCmdPath, inplaceInstallPath, buildDll0
     ) where
 
-import Hadrian.Oracles.KeyValue
 import Hadrian.Oracles.Path
+import Hadrian.Oracles.TextFile
 
 import Base
 import Context

src/Hadrian/Haskell/Cabal.hs

@@ -9,44 +9,27 @@
 -- Basic functionality for extracting Haskell package metadata stored in
 -- @.cabal@ files.
 -----------------------------------------------------------------------------
-module Hadrian.Haskell.Cabal (readCabal, pkgNameVersion, pkgDependencies) where
+module Hadrian.Haskell.Cabal (pkgNameVersion, pkgDependencies) where
 
+import Data.List
 import Development.Shake
-import qualified Distribution.Package                  as C
-import qualified Distribution.PackageDescription       as C
-import qualified Distribution.PackageDescription.Parse as C
-import qualified Distribution.Text                     as C
-import qualified Distribution.Types.CondTree           as C
-import qualified Distribution.Verbosity                as C
 
+import Hadrian.Haskell.Cabal.Parse
 import Hadrian.Haskell.Package
-
--- | Read the @.cabal@ file of a given package and return the
--- 'GenericPackageDescription'. The @.cabal@ file is tracked.
-readCabal :: Package -> Action C.GenericPackageDescription
-readCabal pkg = do
-    need [pkgCabalFile pkg]
-    liftIO $ C.readGenericPackageDescription C.silent (pkgCabalFile pkg)
+import Hadrian.Oracles.TextFile
 
 -- | Read the @.cabal@ file of a given package and return the package name and
 -- version. The @.cabal@ file is tracked.
 pkgNameVersion :: Package -> Action (PackageName, String)
 pkgNameVersion pkg = do
-    pkgId <- C.package . C.packageDescription <$> readCabal pkg
-    return (C.unPackageName $ C.pkgName pkgId, C.display $ C.pkgVersion pkgId)
+    cabal <- readCabalFile (pkgCabalFile pkg)
+    return (name cabal, version cabal)
 
--- | Read the @.cabal@ file of a given package and return the list of its
+-- | Read the @.cabal@ file of a given package and return the sorted list of its
 -- dependencies. The current version does not take care of Cabal conditionals
+-- and therefore returns a crude overapproximation of actual dependencies. The
+-- @.cabal@ file is tracked.
 pkgDependencies :: Package -> Action [PackageName]
 pkgDependencies pkg = do
-pkgDependencies pkg = do
-    gpd <- readCabal pkg
-    let libDeps = collectDeps (C.condLibrary gpd)
-        exeDeps = map (collectDeps . Just . snd) (C.condExecutables gpd)
-    return [ C.unPackageName p | C.Dependency p _ <- concat (libDeps : exeDeps) ]
-
-collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency]
-collectDeps Nothing = []
-collectDeps (Just (C.CondNode _ deps ifs)) = deps ++ concatMap f ifs
-  where
+    cabal <- readCabalFile (pkgCabalFile pkg)
+    return (dependencies cabal \\ [pkgName pkg])

src/Hadrian/Haskell/Cabal/Parse.hs

+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Haskell.Cabal.Parse
+-- Copyright  : (c) Andrey Mokhov 2014-2017
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- Extracting Haskell package metadata stored in @.cabal@ files.
+-----------------------------------------------------------------------------
+module Hadrian.Haskell.Cabal.Parse (Cabal (..), parseCabal) where
+
+import Data.List.Extra
+import Development.Shake
+import Development.Shake.Classes
+import qualified Distribution.Package                  as C
+import qualified Distribution.PackageDescription       as C
+import qualified Distribution.PackageDescription.Parse as C
+import qualified Distribution.Text                     as C
+import qualified Distribution.Types.CondTree           as C
+import qualified Distribution.Verbosity                as C
+
+import Hadrian.Haskell.Package
+
+-- | Haskell package metadata extracted from a @.cabal@ file.
+data Cabal = Cabal
+    { name         :: PackageName
+    , version      :: String
+    , dependencies :: [PackageName]
+    } deriving (Eq, Read, Show, Typeable)
+
+instance Binary Cabal where
+    put = put . show
+    get = fmap read get
+
+instance Hashable Cabal where
+    hashWithSalt salt = hashWithSalt salt . show
+
+instance NFData Cabal where
+    rnf (Cabal a b c) = a `seq` b `seq` c `seq` ()
+
+-- | Parse a @.cabal@ file.
+parseCabal :: FilePath -> IO Cabal
+parseCabal file = do
+    gpd <- liftIO $ C.readGenericPackageDescription C.silent file
+    let pkgId   = C.package (C.packageDescription gpd)
+        libDeps = collectDeps (C.condLibrary gpd)
+        exeDeps = map (collectDeps . Just . snd) (C.condExecutables gpd)
+        allDeps = concat (libDeps : exeDeps)
+        sorted  = sort [ C.unPackageName p | C.Dependency p _ <- allDeps ]
+    return $ Cabal
+        (C.unPackageName $ C.pkgName pkgId)
+        (C.display $ C.pkgVersion pkgId)
+        (nubOrd sorted)
+
+collectDeps :: Maybe (C.CondTree v [C.Dependency] a) -> [C.Dependency]
+collectDeps Nothing = []
+collectDeps (Just (C.CondNode _ deps ifs)) = deps ++ concatMap f ifs
+  where
+    f (C.CondBranch _ t mt) = collectDeps (Just t) ++ collectDeps mt

src/Hadrian/Oracles/FileCache.hs

-{-# LANGUAGE TypeFamilies #-}
------------------------------------------------------------------------------
--- |
--- 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)
-type instance RuleResult FileCache = String
-
--- | 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

src/Hadrian/Oracles/KeyValue.hs → src/Hadrian/Oracles/TextFile.hs

 {-# LANGUAGE TypeFamilies #-}
-module Hadrian.Oracles.KeyValue (
-    lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues,
-    lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, keyValueOracle
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Oracles.TextFile
+-- Copyright  : (c) Andrey Mokhov 2014-2017
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- Read and parse text files, tracking their contents. This oracle can be used
+-- to read configuration or package metadata files and cache the parsing.
+-----------------------------------------------------------------------------
+module Hadrian.Oracles.TextFile (
+    readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError,
+    lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies,
+    readCabalFile, textFileOracle
     ) where
 
 import Control.Monad
@@ -12,6 +24,15 @@ import Development.Shake.Classes
 import Development.Shake.Config
 
 import Hadrian.Utilities
+import Hadrian.Haskell.Cabal.Parse
+
+newtype TextFile = TextFile FilePath
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult TextFile = String
+
+newtype CabalFile = CabalFile FilePath
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult CabalFile = String
 
 newtype KeyValue = KeyValue (FilePath, String)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
@@ -21,6 +42,11 @@ newtype KeyValues = KeyValues (FilePath, String)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 type instance RuleResult KeyValues = Maybe [String]
 
+-- | Read a text file, caching and tracking the result. To read and track
+-- individual lines of a text file use 'lookupValue' and its derivatives.
+readTextFile :: FilePath -> Action String
+readTextFile = askOracle . TextFile
+
 -- | Lookup a value in a text file, tracking the result. Each line of the file
 -- is expected to have @key = value@ format.
 lookupValue :: FilePath -> String -> Action (Maybe String)
@@ -63,10 +89,18 @@ lookupDependencies depFile file = do
         Just [] -> error $ "No source file found for file " ++ quote file
         Just (source : files) -> return (source, files)
 
--- | This oracle reads and parses text files to answer 'lookupValue' and
--- 'lookupValues' queries, as well as their derivatives, tracking the results.
-keyValueOracle :: Rules ()
-keyValueOracle = void $ do
+-- | Read and parse a @.cabal@ file, caching and tracking the result.
+readCabalFile :: FilePath -> Action Cabal
+readCabalFile = askOracle . CabalFile
+
+-- | This oracle reads and parses text files to answer 'readTextFile' and
+-- 'lookupValue' queries, as well as their derivatives, tracking the results.
+textFileOracle :: Rules ()
+textFileOracle = do
+    text <- newCache $ \file -> do
+        need [file]
+        putLoud $ "Reading " ++ file ++ "..."
+        liftIO $ readFile file
     kv <- newCache $ \file -> do
         need [file]
         putLoud $ "Reading " ++ file ++ "..."
@@ -76,5 +110,11 @@ keyValueOracle = void $ do
         putLoud $ "Reading " ++ file ++ "..."
         contents <- map words <$> readFileLines file
         return $ Map.fromList [ (key, values) | (key:values) <- contents ]
+    cabal <- newCache $ \file -> do
+        need [file]
+        putLoud $ "Reading " ++ file ++ "..."
+        liftIO $ parseCabal file
+    void $ addOracle $ \(TextFile   file      ) -> text                   file
     void $ addOracle $ \(KeyValue  (file, key)) -> Map.lookup key <$> kv  file
     void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
+    void $ addOracle $ \(CabalFile  file      ) -> cabal                  file

src/Oracles/Flag.hs

@@ -3,7 +3,7 @@ module Oracles.Flag (
     ghcWithSMP, ghcWithNativeCodeGen, supportsSplitObjects
     ) where
 
-import Hadrian.Oracles.KeyValue
+import Hadrian.Oracles.TextFile
 
 import Base
 import Oracles.Setting

src/Oracles/PackageData.hs

@@ -2,7 +2,7 @@ module Oracles.PackageData (
     PackageData (..), PackageDataList (..), pkgData, pkgDataList
     ) where
 
-import Hadrian.Oracles.KeyValue
+import Hadrian.Oracles.TextFile
 
 import Base
 

src/Oracles/Setting.hs

@@ -7,7 +7,7 @@ module Oracles.Setting (
     ) where
 
 import Hadrian.Expression
-import Hadrian.Oracles.KeyValue
+import Hadrian.Oracles.TextFile
 import Hadrian.Oracles.Path
 
 import Base

src/Rules.hs

@@ -2,9 +2,8 @@ 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
+import qualified Hadrian.Oracles.TextFile
 
 import Context
 import Expression
@@ -24,7 +23,6 @@ import qualified Rules.Perl
 import qualified Rules.Program
 import qualified Rules.Register
 import Settings
-import Settings.Builders.GhcCabal
 import Target
 import Utilities
 
@@ -107,17 +105,12 @@ 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
+    Hadrian.Oracles.TextFile.textFileOracle
     Oracles.ModuleFiles.moduleFilesOracle
 
 programsStage1Only :: [Package]

src/Rules/Compile.hs

 module Rules.Compile (compilePackage) where
 
-import Hadrian.Oracles.KeyValue
+import Hadrian.Oracles.TextFile
 
 import Base
 import Context

src/Settings/Builders/GhcCabal.hs

 module Settings.Builders.GhcCabal (
-    bootPackageConstraintsGenerator, ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs
+    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs
     ) where
 
 import Hadrian.Haskell.Cabal
-import Hadrian.Oracles.FileCache
 
 import Context
 import Flavour
@@ -27,7 +26,7 @@ ghcCabalBuilderArgs = builder GhcCabal ? do
             , libraryArgs
             , with HsColour
             , configureArgs
-            , packageConstraints
+            , bootPackageConstraints
             , withStaged $ Cc CompileC
             , notStage0 ? with Ld
             , withStaged Ar
@@ -91,20 +90,13 @@ 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
+bootPackageConstraints :: Args
+bootPackageConstraints = stage0 ? do
+    bootPkgs <- expr $ stagePackages Stage0
     let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
-    constraints <- forM (sort pkgs) $ \pkg -> do
+    constraints <- expr $ forM (sort pkgs) $ \pkg -> do
         (name, version) <- pkgNameVersion pkg
         return (name ++ " == " ++ version)
-    return (unlines constraints)
-
-packageConstraints :: Args
-packageConstraints = stage0 ? do
-    -- 'bootPackageConstraints' is generated by 'bootPackageConstraintsGenerator'.
-    path <- getBuildRoot <&> (-/- bootPackageConstraints)
-    constraints <- lines <$> expr (readFileCache path)
     pure $ concat [ ["--constraint", c] | c <- constraints ]
 
 cppArgs :: Args

src/Utilities.hs

@@ -2,15 +2,13 @@ module Utilities (
     build, buildWithCmdOptions, buildWithResources, applyPatch, runBuilder,
     runBuilderWith, builderEnvironment, needBuilder, needLibrary,
     installDirectory, installData, installScript, installProgram, linkSymbolic,
-    contextDependencies, stage1Dependencies, libraryTargets, topsortPackages,
-    packageDependenciesGenerator
+    contextDependencies, stage1Dependencies, libraryTargets, topsortPackages
     ) where
 
 import qualified System.Directory.Extra as IO
 
 import Hadrian.Haskell.Cabal
 import Hadrian.Oracles.ArgsHash
-import Hadrian.Oracles.KeyValue
 import Hadrian.Oracles.Path
 import Hadrian.Utilities
 
@@ -185,30 +183,20 @@ 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 (pkgName pkg)
-        else do
-            deps <- nubOrd . sort <$> pkgDependencies pkg
-            return . unwords $ pkgName pkg : (deps \\ [pkgName 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 'pkgDependencies' defined in "Hadrian.Haskell.Cabal".
+-- | Given a 'Context' this 'Action' looks up its package dependencies 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 'pkgDependencies' 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 (pkgName package)
-    pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
-    return . map pkgContext $ intersectOrd (compare . pkgName) pkgs deps
+    exists <- doesFileExist (pkgCabalFile package)
+    if not exists then return [] else do
+        let pkgContext = \pkg -> Context (min stage Stage1) pkg way
+        deps <- pkgDependencies package
+        pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
+        return . map pkgContext $ intersectOrd (compare . pkgName) pkgs deps
 
 -- | Lookup dependencies of a 'Package' in the vanilla Stage1 context.
 stage1Dependencies :: Package -> Action [Package]