Commit 4b6707a6 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Improve infrastructure for Cabal file parsing

parent 48ad1e76
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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])
-----------------------------------------------------------------------------
-- |
-- 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
{-# 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
{-# 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
......@@ -3,7 +3,7 @@ module Oracles.Flag (
ghcWithSMP, ghcWithNativeCodeGen, supportsSplitObjects
) where
import Hadrian.Oracles.KeyValue
import Hadrian.Oracles.TextFile
import Base
import Oracles.Setting
......
......@@ -2,7 +2,7 @@ module Oracles.PackageData (
PackageData (..), PackageDataList (..), pkgData, pkgDataList
) where
import Hadrian.Oracles.KeyValue
import Hadrian.Oracles.TextFile
import Base
......
......@@ -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
......
......@@ -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]
......
module Rules.Compile (compilePackage) where
import Hadrian.Oracles.KeyValue
import Hadrian.Oracles.TextFile
import Base
import Context
......
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
......
......@@ -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]
......
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