Rework parsing of Cabal metadata (#692)
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 29 Sep 2018 10:43:17 +0000 (11:43 +0100)
committerGitHub <noreply@github.com>
Sat, 29 Sep 2018 10:43:17 +0000 (11:43 +0100)
The current implementation of parsing Cabal data is a big mess, which affects performance as described in #671 and #550. In this PR we simplify the implementation and avoid unnecessary reparsing.

As a result, the zero build time is reduced from 30 seconds to 5 seconds on my machine. The full build time seems to have been improved as well, since now all CI bots complete within the time limit. On the other hand, the speed up of the full build with `-j` on my machine does not appear to be significant.

32 files changed:
hadrian.cabal
src/Context.hs
src/Expression.hs
src/Hadrian/Expression.hs
src/Hadrian/Haskell/Cabal.hs
src/Hadrian/Haskell/Cabal/CabalData.hs [deleted file]
src/Hadrian/Haskell/Cabal/PackageData.hs [deleted file]
src/Hadrian/Haskell/Cabal/Parse.hs
src/Hadrian/Haskell/Cabal/Type.hs [new file with mode: 0644]
src/Hadrian/Oracles/Cabal.hs [new file with mode: 0644]
src/Hadrian/Oracles/Cabal/Rules.hs [new file with mode: 0644]
src/Hadrian/Oracles/Cabal/Type.hs [new file with mode: 0644]
src/Hadrian/Oracles/Path.hs
src/Hadrian/Oracles/TextFile.hs
src/Hadrian/Oracles/TextFile/Rules.hs [deleted file]
src/Hadrian/Oracles/TextFile/Type.hs [deleted file]
src/Oracles/ModuleFiles.hs
src/Rules.hs
src/Rules/BinaryDist.hs
src/Rules/Documentation.hs
src/Rules/Library.hs
src/Rules/Program.hs
src/Rules/Selftest.hs
src/Settings/Builders/Cabal.hs
src/Settings/Builders/Cc.hs
src/Settings/Builders/Common.hs
src/Settings/Builders/Ghc.hs
src/Settings/Builders/Haddock.hs
src/Settings/Builders/Hsc2Hs.hs
src/Settings/Default.hs
src/Utilities.hs
stack.yaml

index 2fd2c8c..9d83c0b 100644 (file)
@@ -34,15 +34,15 @@ executable hadrian
                        , Hadrian.Builder.Tar
                        , Hadrian.Expression
                        , Hadrian.Haskell.Cabal
-                       , Hadrian.Haskell.Cabal.CabalData
-                       , Hadrian.Haskell.Cabal.PackageData
+                       , Hadrian.Haskell.Cabal.Type
                        , Hadrian.Haskell.Cabal.Parse
                        , Hadrian.Oracles.ArgsHash
+                       , Hadrian.Oracles.Cabal
+                       , Hadrian.Oracles.Cabal.Rules
+                       , Hadrian.Oracles.Cabal.Type
                        , Hadrian.Oracles.DirectoryContents
                        , Hadrian.Oracles.Path
                        , Hadrian.Oracles.TextFile
-                       , Hadrian.Oracles.TextFile.Rules
-                       , Hadrian.Oracles.TextFile.Type
                        , Hadrian.Package
                        , Hadrian.Target
                        , Hadrian.Utilities
@@ -121,7 +121,7 @@ executable hadrian
                        , mtl                  == 2.2.*
                        , parsec               >= 3.1     && < 3.2
                        , QuickCheck           >= 2.6     && < 2.11
-                       , shake                >= 0.16.1
+                       , shake                >= 0.16.4
                        , transformers         >= 0.4     && < 0.6
                        , unordered-containers >= 0.2.1   && < 0.3
     build-tools:         alex  >= 3.1
index f619645..3269714 100644 (file)
@@ -53,7 +53,7 @@ libPath context = buildRoot <&> (-/- libDir context)
 pkgFile :: Context -> String -> String -> Action FilePath
 pkgFile context@Context {..} prefix suffix = do
     path <- buildPath context
-    pid  <- pkgIdentifier context
+    pid  <- pkgIdentifier package
     return $ path -/- prefix ++ pid ++ suffix
 
 -- | Path to inplace package configuration file of a given 'Context'.
@@ -91,9 +91,9 @@ pkgGhciLibraryFile context = pkgFile context "HS" ".o"
 
 -- | Path to the configuration file of a given 'Context'.
 pkgConfFile :: Context -> Action FilePath
-pkgConfFile ctx@Context {..} = do
+pkgConfFile Context {..} = do
     root <- buildRoot
-    pid  <- pkgIdentifier ctx
+    pid  <- pkgIdentifier package
     return $ root -/- relativePackageDbPath stage -/- pid <.> "conf"
 
 -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
index 088fc5e..a520c0b 100644 (file)
@@ -14,7 +14,7 @@ module Expression (
 
     -- * Convenient accessors
     getBuildRoot, getContext, getOutputs, getInputs,
-    getInput, getOutput, getPackageData,
+    getInput, getOutput, getContextData,
 
     -- * Re-exports
     module Base,
@@ -27,14 +27,14 @@ import Builder
 import Context hiding (stage, package, way)
 import Expression.Type
 import Hadrian.Expression hiding (Expr, Predicate, Args)
-import Hadrian.Haskell.Cabal.PackageData
-import Hadrian.Oracles.TextFile
+import Hadrian.Haskell.Cabal.Type
+import Hadrian.Oracles.Cabal
 
 -- | Get values from a configured cabal stage.
-getPackageData :: (PackageData -> a) -> Expr a
-getPackageData key = do
-    packageData <- expr . readPackageData =<< getContext
-    return $ key packageData
+getContextData :: (ContextData -> a) -> Expr a
+getContextData key = do
+    contextData <- expr . readContextData =<< getContext
+    return $ key contextData
 
 -- | Is the build currently in the provided stage?
 stage :: Stage -> Predicate
index e5c01f8..6649565 100644 (file)
@@ -19,7 +19,7 @@ module Hadrian.Expression (
 import Control.Monad.Extra
 import Control.Monad.Trans
 import Control.Monad.Trans.Reader
-import Data.Semigroup
+import Data.Semigroup (Semigroup, (<>))
 import Development.Shake
 import Development.Shake.Classes
 
index 1d7167a..327e6a0 100644 (file)
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Hadrian.Haskell.Cabal
--- Copyright  : (c) Andrey Mokhov 2014-2017
+-- Copyright  : (c) Andrey Mokhov 2014-2018
 -- License    : MIT (see the file LICENSE)
 -- Maintainer : andrey.mokhov@gmail.com
 -- Stability  : experimental
 -- Cabal files.
 -----------------------------------------------------------------------------
 module Hadrian.Haskell.Cabal (
-    pkgVersion, pkgIdentifier, pkgDependencies, pkgSynopsis
+    pkgVersion, pkgIdentifier, pkgSynopsis, pkgDescription, pkgDependencies,
+    pkgGenericDescription
     ) where
 
 import Development.Shake
+import Distribution.PackageDescription (GenericPackageDescription)
 
-import Context.Type
-import Hadrian.Haskell.Cabal.CabalData
-import Hadrian.Oracles.TextFile
+import Hadrian.Haskell.Cabal.Type
+import Hadrian.Oracles.Cabal
 import Hadrian.Package
 
 -- | Read a Cabal file and return the package version. The Cabal file is tracked.
-pkgVersion :: Context -> Action String
-pkgVersion = fmap version . readCabalData
+pkgVersion :: Package -> Action String
+pkgVersion = fmap version . readPackageData
 
 -- | Read a Cabal file and return the package identifier, e.g. @base-4.10.0.0@.
 -- The Cabal file is tracked.
-pkgIdentifier :: Context -> Action String
-pkgIdentifier context = do
-    cabal <- readCabalData context
+pkgIdentifier :: Package -> Action String
+pkgIdentifier package = do
+    cabal <- readPackageData package
     return $ if null (version cabal)
         then name cabal
         else name cabal ++ "-" ++ version cabal
 
+-- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
+pkgSynopsis :: Package -> Action String
+pkgSynopsis = fmap synopsis . readPackageData
+
+-- | Read a Cabal file and return the package description. The Cabal file is
+-- tracked.
+pkgDescription :: Package -> Action String
+pkgDescription = fmap description . readPackageData
+
 -- | Read a Cabal file and return the sorted list of the package 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 :: Context -> Action [PackageName]
-pkgDependencies = fmap (map pkgName . packageDependencies) . readCabalData
+pkgDependencies :: Package -> Action [PackageName]
+pkgDependencies = fmap (map pkgName . packageDependencies) . readPackageData
 
--- | Read a Cabal file and return the package synopsis. The Cabal file is tracked.
-pkgSynopsis :: Context -> Action String
-pkgSynopsis = fmap synopsis . readCabalData
+-- | Read a Cabal file and return the 'GenericPackageDescription'. The Cabal
+-- file is tracked.
+pkgGenericDescription :: Package -> Action GenericPackageDescription
+pkgGenericDescription = fmap genericPackageDescription . readPackageData
diff --git a/src/Hadrian/Haskell/Cabal/CabalData.hs b/src/Hadrian/Haskell/Cabal/CabalData.hs
deleted file mode 100644 (file)
index 6e0ac76..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-module Hadrian.Haskell.Cabal.CabalData where
-
-import Development.Shake.Classes
-import Distribution.PackageDescription
-import GHC.Generics
-import Hadrian.Package
-
--- | Haskell package metadata extracted from a Cabal file, without performing
--- the resolution of package configuration flags and associated conditionals.
--- One consequence is that 'packageDependencies' is an overappoximation of
--- actual package dependencies; for example, both @unix@ and @win32@ packages
--- may be included even if only one of them is required on the target OS.
-data CabalData = CabalData
-    { name                      :: PackageName
-    , version                   :: String
-    , synopsis                  :: String
-    , genericPackageDescription :: GenericPackageDescription
-    , packageDescription        :: PackageDescription
-    , packageDependencies       :: [Package]
-    } deriving (Eq, Show, Typeable, Generic)
-
-instance Binary   CabalData
-instance Hashable CabalData where hashWithSalt salt = hashWithSalt salt . show
-instance NFData   CabalData
diff --git a/src/Hadrian/Haskell/Cabal/PackageData.hs b/src/Hadrian/Haskell/Cabal/PackageData.hs
deleted file mode 100644 (file)
index be45f6f..0000000
+++ /dev/null
@@ -1,46 +0,0 @@
-module Hadrian.Haskell.Cabal.PackageData where
-
-import Development.Shake.Classes
-import GHC.Generics
-import Hadrian.Package
-
--- | Most of these fields used to be provided in @package-data.mk@ files.
-data PackageData = PackageData
-    { dependencies    :: [PackageName]
-    , name            :: PackageName
-    , version         :: String
-    , componentId     :: String
-    , mainIs          :: Maybe (String, FilePath)  -- ("Main", filepath)
-    , modules         :: [String]
-    , otherModules    :: [String]
-    , synopsis        :: String
-    , description     :: String
-    , srcDirs         :: [String]
-    , deps            :: [String]
-    , depIpIds        :: [String]
-    , depNames        :: [String]
-    , depCompIds      :: [String]
-    , includeDirs     :: [String]
-    , includes        :: [String]
-    , installIncludes :: [String]
-    , extraLibs       :: [String]
-    , extraLibDirs    :: [String]
-    , asmSrcs         :: [String]
-    , cSrcs           :: [String]
-    , cmmSrcs         :: [String]
-    , dataFiles       :: [String]
-    , hcOpts          :: [String]
-    , asmOpts         :: [String]
-    , ccOpts          :: [String]
-    , cmmOpts         :: [String]
-    , cppOpts         :: [String]
-    , ldOpts          :: [String]
-    , depIncludeDirs  :: [String]
-    , depCcOpts       :: [String]
-    , depLdOpts       :: [String]
-    , buildGhciLib    :: Bool
-    } deriving (Eq, Read, Show, Typeable, Generic)
-
-instance Binary   PackageData
-instance Hashable PackageData
-instance NFData   PackageData
index 8dce75e..e0edb78 100644 (file)
 -- Extracting Haskell package metadata stored in Cabal files.
 -----------------------------------------------------------------------------
 module Hadrian.Haskell.Cabal.Parse (
-    PackageData (..), parseCabalFile, parsePackageData, parseCabalPkgId,
+    ContextData (..), parsePackageData, resolveContextData, parseCabalPkgId,
     configurePackage, copyPackage, registerPackage
     ) where
 
+import Data.Bifunctor
 import Data.List.Extra
 import Development.Shake
 import qualified Distribution.ModuleName                       as C
@@ -22,7 +23,6 @@ import qualified Distribution.PackageDescription               as C
 import qualified Distribution.PackageDescription.Configuration as C
 import qualified Distribution.PackageDescription.Parsec        as C
 import qualified Distribution.Simple.Compiler                  as C
-import qualified Distribution.Simple.GHC                       as C
 import qualified Distribution.Simple.Program.Db                as C
 import qualified Distribution.Simple                           as C
 import qualified Distribution.Simple.Program.Builtin           as C
@@ -33,14 +33,15 @@ import qualified Distribution.Simple.Build                     as C
 import qualified Distribution.Types.ComponentRequestedSpec     as C
 import qualified Distribution.InstalledPackageInfo             as Installed
 import qualified Distribution.Simple.PackageIndex              as C
-import qualified Distribution.Types.LocalBuildInfo             as C
 import qualified Distribution.Text                             as C
+import qualified Distribution.Types.LocalBuildInfo             as C
+import qualified Distribution.Types.CondTree                   as C
 import qualified Distribution.Types.MungedPackageId            as C
 import qualified Distribution.Verbosity                        as C
 import Hadrian.Expression
-import Hadrian.Haskell.Cabal.CabalData
-import Hadrian.Haskell.Cabal.PackageData
-import Hadrian.Oracles.TextFile
+import Hadrian.Haskell.Cabal
+import Hadrian.Haskell.Cabal.Type
+import Hadrian.Oracles.Cabal
 import Hadrian.Target
 
 import Base
@@ -50,7 +51,31 @@ import Flavour
 import Packages
 import Settings
 
--- | Parse the Cabal package identifier from a @.cabal@ file.
+-- | Parse the Cabal file of a given 'Package'. This operation is cached by the
+-- "Hadrian.Oracles.TextFile.readPackageData" oracle.
+parsePackageData :: Package -> Action PackageData
+parsePackageData pkg = do
+    gpd <- liftIO $ C.readGenericPackageDescription C.verbose (pkgCabalFile pkg)
+    let pd      = C.packageDescription gpd
+        pkgId   = C.package pd
+        name    = C.unPackageName (C.pkgName pkgId)
+        version = C.display (C.pkgVersion pkgId)
+        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 ]
+        deps    = nubOrd sorted \\ [name]
+        depPkgs = catMaybes $ map findPackageByName deps
+    return $ PackageData name version (C.synopsis pd) (C.description pd) depPkgs gpd
+  where
+    -- Collect an overapproximation of dependencies by ignoring conditionals
+    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
+
+-- | Parse the package identifier from a Cabal file.
 parseCabalPkgId :: FilePath -> IO String
 parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file
 
@@ -75,46 +100,6 @@ biModules pd = go [ comp | comp@(bi,_,_) <-
     go [x] = x
     go _   = error "Cannot handle more than one buildinfo yet."
 
--- TODO: Add proper error handling for partiality due to Nothing/Left cases.
--- | Parse the Cabal file of the 'Package' from a given 'Context'. This function
--- reads the Cabal file, gets some information about the compiler to be used
--- corresponding to the 'Stage' it gets from the 'Context', and finalises the
--- package description it got from the Cabal file with additional information
--- such as platform, compiler version conditionals, and package flags.
-parseCabalFile :: Context -> Action CabalData
-parseCabalFile context@Context {..} = do
-    let file = pkgCabalFile package
-
-    -- Read the package description from the Cabal file
-    gpd <- liftIO $ C.readGenericPackageDescription C.verbose file
-
-    -- Configure the package with the GHC for this stage
-    hcPath <- builderPath (Ghc CompileHs stage)
-    (compiler, Just platform, _pgdb) <- liftIO $
-        C.configure C.silent (Just hcPath) Nothing C.emptyProgramDb
-
-    flagList <- interpret (target context (Cabal Flags stage) [] []) =<< args <$> flavour
-    let flags = foldr addFlag mempty flagList
-          where
-            addFlag :: String -> C.FlagAssignment -> C.FlagAssignment
-            addFlag ('-':name) = C.insertFlagAssignment (C.mkFlagName name) False
-            addFlag ('+':name) = C.insertFlagAssignment (C.mkFlagName name) True
-            addFlag name       = C.insertFlagAssignment (C.mkFlagName name) True
-
-    let (Right (pd,_)) = C.finalizePD flags C.defaultComponentRequestedSpec
-                         (const True) platform (C.compilerInfo compiler) [] gpd
-    -- depPkgs are all those packages that are needed. These should be found in
-    -- the known build packages even if they are not build in this stage.
-    let depPkgs = map (findPackageByName' . C.unPackageName . C.depPkgName)
-                $ flip C.enabledBuildDepends C.defaultComponentRequestedSpec pd
-          where
-            findPackageByName' p = fromMaybe (error msg) (findPackageByName p)
-              where
-                msg = "Failed to find package " ++ quote (show p)
-    return $ CabalData (C.unPackageName . C.pkgName . C.package $ pd)
-                       (C.display . C.pkgVersion . C.package $ pd)
-                       (C.synopsis pd) gpd pd depPkgs
-
 -- TODO: Track command line arguments and package configuration flags.
 -- | Configure a package using the Cabal library by collecting all the command
 -- line arguments (to be passed to the setup script) and package configuration
@@ -124,7 +109,8 @@ configurePackage :: Context -> Action ()
 configurePackage context@Context {..} = do
     putLoud $ "| Configure package " ++ quote (pkgName package)
 
-    CabalData _ _ _ gpd _pd depPkgs <- readCabalData context
+    gpd     <- pkgGenericDescription package
+    depPkgs <- packageDependencies <$> readPackageData package
 
     -- Stage packages are those we have in this stage.
     stagePkgs <- stagePackages stage
@@ -136,22 +122,21 @@ configurePackage context@Context {..} = do
     -- Figure out what hooks we need.
     hooks <- case C.buildType (C.flattenPackageDescription gpd) of
         C.Configure -> pure C.autoconfUserHooks
-        -- time has a "Custom" Setup.hs, but it's actually Configure
-        -- plus a "./Setup test" hook. However, Cabal is also
-        -- "Custom", but doesn't have a configure script.
+        -- The 'time' package has a 'C.Custom' Setup.hs, but it's actually
+        -- 'C.Configure' plus a @./Setup test@ hook. However, Cabal is also
+        -- 'C.Custom', but doesn't have a configure script.
         C.Custom -> do
             configureExists <- doesFileExist $
                 replaceFileName (pkgCabalFile package) "configure"
             pure $ if configureExists then C.autoconfUserHooks else C.simpleUserHooks
         -- Not quite right, but good enough for us:
         _ | package == rts ->
-            -- Don't try to do post conf validation for rts. This will simply
-            -- not work, due to the ld-options and the Stg.h.
+            -- Don't try to do post configuration validation for 'rts'. This
+            -- will simply not work, due to the @ld-options@ and @Stg.h@.
             pure $ C.simpleUserHooks { C.postConf = \_ _ _ _ -> return () }
           | otherwise -> pure C.simpleUserHooks
 
-    -- Compute the list of flags
-    -- Compute the Cabal configurartion arguments
+    -- Compute the list of flags, and the Cabal configurartion arguments
     flavourArgs <- args <$> flavour
     flagList    <- interpret (target context (Cabal Flags stage) [] []) flavourArgs
     argList     <- interpret (target context (Cabal Setup stage) [] []) flavourArgs
@@ -165,7 +150,7 @@ configurePackage context@Context {..} = do
 copyPackage :: Context -> Action ()
 copyPackage context@Context {..} = do
     putLoud $ "| Copy package " ++ quote (pkgName package)
-    CabalData _ _ _ gpd _ _ <- readCabalData context
+    gpd <- pkgGenericDescription package
     ctxPath   <- Context.contextPath context
     pkgDbPath <- packageDbPath stage
     verbosity <- getVerbosity
@@ -178,15 +163,15 @@ registerPackage :: Context -> Action ()
 registerPackage context@Context {..} = do
     putLoud $ "| Register package " ++ quote (pkgName package)
     ctxPath <- Context.contextPath context
-    CabalData _ _ _ gpd _ _ <- readCabalData context
+    gpd <- pkgGenericDescription package
     verbosity <- getVerbosity
     let v = if verbosity >= Loud then "-v3" else "-v0"
     liftIO $ C.defaultMainWithHooksNoReadArgs C.autoconfUserHooks gpd
         [ "register", "--builddir", ctxPath, v ]
 
--- | Parse the 'PackageData' of the 'Package' of a given 'Context'.
-parsePackageData :: Context -> Action PackageData
-parsePackageData context@Context {..} = do
+-- | Parse the 'ContextData' of a given 'Context'.
+resolveContextData :: Context -> Action ContextData
+resolveContextData context@Context {..} = do
     -- TODO: This is conceptually wrong!
     -- We should use the gpd, the flagAssignment and compiler, hostPlatform, and
     -- other information from the lbi. And then compute the finalised PD (flags,
@@ -195,18 +180,34 @@ parsePackageData context@Context {..} = do
     -- let (Right (pd,_)) = C.finalizePackageDescription flags (const True) platform (compilerInfo compiler) [] gpd
     --
     -- However when using the new-build path's this might change.
-    CabalData _ _ _ _gpd pd _depPkgs <- readCabalData context
+
+    -- Read the package description from the Cabal file
+    gpd <- genericPackageDescription <$> readPackageData package
+
+    -- Configure the package with the GHC for this stage
+    (compiler, platform) <- configurePackageGHC package stage
+
+    flagList <- interpret (target context (Cabal Flags stage) [] []) =<< args <$> flavour
+    let flags = foldr addFlag mempty flagList
+          where
+            addFlag :: String -> C.FlagAssignment -> C.FlagAssignment
+            addFlag ('-':name) = C.insertFlagAssignment (C.mkFlagName name) False
+            addFlag ('+':name) = C.insertFlagAssignment (C.mkFlagName name) True
+            addFlag name       = C.insertFlagAssignment (C.mkFlagName name) True
+
+    let (Right (pd,_)) = C.finalizePD flags C.defaultComponentRequestedSpec
+                         (const True) platform (C.compilerInfo compiler) [] gpd
 
     cPath <- Context.contextPath context
     need [cPath -/- "setup-config"]
 
     lbi <- liftIO $ C.getPersistBuildConfig cPath
 
-    -- TODO: Move this into its own rule for "build/autogen/cabal_macros.h", and
-    -- "build/autogen/Path_*.hs" and 'need' them here.
-    -- create the cabal_macros.h, ...
-    -- Note: the `cPath` is ignored. The path that's used is the 'buildDir' path
-    -- from the local build info (lbi).
+    -- TODO: Move this into its own rule for @build/autogen/cabal_macros.h@, and
+    -- @build/autogen/Path_*.hs@ and 'need' these files here.
+    -- Create the @cabal_macros.h@, ...
+    -- Note: the @cPath@ is ignored. The path that's used is the 'buildDir' path
+    -- from the local build info @lbi@.
     pdi <- liftIO $ getHookedBuildInfo (pkgPath package)
     let pd'  = C.updatePackageDescription pdi pd
         lbi' = lbi { C.localPkgDescr = pd' }
@@ -216,12 +217,12 @@ parsePackageData context@Context {..} = do
     -- See: https://github.com/snowleopard/hadrian/issues/548
     let extDeps      = C.externalPackageDeps lbi'
         deps         = map (C.display . snd) extDeps
-        dep_direct   = map (fromMaybe (error "parsePackageData: dep_keys failed")
-                          . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps
-        dep_ipids    = map (C.display . Installed.installedUnitId) dep_direct
+        depDirect    = map (fromMaybe (error "resolveContextData: depDirect failed")
+                     . C.lookupUnitId (C.installedPkgs lbi') . fst) extDeps
+        depIds       = map (C.display . Installed.installedUnitId) depDirect
         Just ghcProg = C.lookupProgram C.ghcProgram (C.withPrograms lbi')
-        dep_pkgs     = C.topologicalOrder (packageHacks (C.installedPkgs lbi'))
-        forDeps f    = concatMap f dep_pkgs
+        depPkgs      = C.topologicalOrder (packageHacks (C.installedPkgs lbi'))
+        forDeps f    = concatMap f depPkgs
 
         -- Copied from Distribution.Simple.PreProcess.ppHsc2Hs
         packageHacks = case C.compilerFlavor (C.compiler lbi') of
@@ -236,37 +237,28 @@ parsePackageData context@Context {..} = do
         hackRtsPackage index | null (C.allPackages index) = index
         -- ^ do not hack the empty index
         hackRtsPackage index = case C.lookupPackageName index (C.mkPackageName "rts") of
-            [(_,[rts])] -> C.insert rts {
+            [(_, [rts])] -> C.insert rts {
                 Installed.ldOptions   = [],
                 Installed.libraryDirs = filter (not . ("gcc-lib" `isSuffixOf`))
                                                (Installed.libraryDirs rts)} index
-            -- GHC <= 6.12 had $topdir/gcc-lib in their library-dirs for the rts
-            -- package, which causes problems when we try to use the in-tree
-            -- mingw, due to accidentally picking up the incompatible libraries
-            -- there. So we filter out gcc-lib from the RTS's library-dirs here.
+            -- GHC <= 6.12 had @$topdir/gcc-lib@ in their @library-dirs@ for the
+            -- 'rts' package, which causes problems when we try to use the
+            -- in-tree @mingw@, due to accidentally picking up the incompatible
+            -- libraries there. So we filter out @gcc-lib@ from the RTS's
+            -- @library-dirs@ here.
             _ -> error "No (or multiple) GHC rts package is registered!"
 
         (buildInfo, modules, mainIs) = biModules pd'
 
-      in return $ PackageData
+      in return $ ContextData
           { dependencies    = deps
-          , name            = C.unPackageName . C.pkgName    . C.package $ pd'
-          , version         = C.display       . C.pkgVersion . C.package $ pd'
           , componentId     = C.localCompatPackageKey lbi'
-          , mainIs          = case mainIs of
-                                   Just (mod, filepath) -> Just (C.display mod, filepath)
-                                   Nothing              -> Nothing
-          , modules         = map C.display $ modules
-          , otherModules    = map C.display . C.otherModules $ buildInfo
-          , synopsis        = C.synopsis    pd'
-          , description     = C.description pd'
+          , mainIs          = fmap (first C.display) mainIs
+          , modules         = map C.display modules
+          , otherModules    = map C.display $ C.otherModules buildInfo
           , srcDirs         = C.hsSourceDirs buildInfo
-          , deps            = deps
-          , depIpIds        = dep_ipids
+          , depIds          = depIds
           , depNames        = map (C.display . C.mungedName . snd) extDeps
-          , depCompIds      = if C.packageKeySupported (C.compiler lbi')
-                              then dep_ipids
-                              else deps
           , includeDirs     = C.includeDirs     buildInfo
           , includes        = C.includes        buildInfo
           , installIncludes = C.installIncludes buildInfo
@@ -275,7 +267,6 @@ parsePackageData context@Context {..} = do
           , asmSrcs         = C.asmSources      buildInfo
           , cSrcs           = C.cSources        buildInfo
           , cmmSrcs         = C.cmmSources      buildInfo
-          , dataFiles       = C.dataFiles pd'
           , hcOpts          = C.programDefaultArgs ghcProg
               ++ C.hcOptions C.GHC buildInfo
               ++ C.languageToFlags   (C.compiler lbi') (C.defaultLanguage buildInfo)
@@ -293,8 +284,9 @@ parsePackageData context@Context {..} = do
 
 getHookedBuildInfo :: FilePath -> IO C.HookedBuildInfo
 getHookedBuildInfo baseDir = do
-    -- TODO: We should probably better generate this in the build dir, rather
-    -- than in the base dir? However, @configure@ is run in the baseDir.
+    -- TODO: We should probably better generate this in the build directory,
+    -- rather than in the base directory? However, @configure@ is run in the
+    -- base directory.
     maybeInfoFile <- C.findHookedPackageDesc baseDir
     case maybeInfoFile of
         Nothing       -> return C.emptyHookedBuildInfo
diff --git a/src/Hadrian/Haskell/Cabal/Type.hs b/src/Hadrian/Haskell/Cabal/Type.hs
new file mode 100644 (file)
index 0000000..dd6e4bd
--- /dev/null
@@ -0,0 +1,75 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Haskell.Cabal.Type
+-- Copyright  : (c) Andrey Mokhov 2014-2018
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- Data types for storing basic Haskell package metadata, such as package name,
+-- version and dependencies, extracted from a Cabal file.
+-----------------------------------------------------------------------------
+module Hadrian.Haskell.Cabal.Type where
+
+import Development.Shake.Classes
+import Distribution.PackageDescription
+import GHC.Generics
+
+import Hadrian.Package
+
+-- | Haskell package metadata extracted from a Cabal file without performing
+-- the resolution of package configuration flags and associated conditionals,
+-- which are build context specific. Note that 'packageDependencies' is an
+-- overappoximation of actual package dependencies; for example, both @unix@ and
+-- @win32@ packages may be included even if only one of them is required on the
+-- target OS. See 'ContextData' for metadata obtained after resolving package
+-- configuration flags and conditionals according to the current build context.
+data PackageData = PackageData
+    { name                      :: PackageName
+    , version                   :: String
+    , synopsis                  :: String
+    , description               :: String
+    , packageDependencies       :: [Package]
+    , genericPackageDescription :: GenericPackageDescription
+    } deriving (Eq, Generic, Show, Typeable)
+
+-- | Haskell package metadata obtained after resolving package configuration
+-- flags and associated conditionals according to the current build context.
+-- See 'PackageData' for metadata that can be obtained without resolving package
+-- configuration flags and conditionals.
+data ContextData = ContextData
+    { dependencies    :: [PackageName]
+    , componentId     :: String
+    , mainIs          :: Maybe (String, FilePath)  -- ("Main", filepath)
+    , modules         :: [String]
+    , otherModules    :: [String]
+    , srcDirs         :: [String]
+    , depIds          :: [String]
+    , depNames        :: [String]
+    , includeDirs     :: [String]
+    , includes        :: [String]
+    , installIncludes :: [String]
+    , extraLibs       :: [String]
+    , extraLibDirs    :: [String]
+    , asmSrcs         :: [String]
+    , cSrcs           :: [String]
+    , cmmSrcs         :: [String]
+    , hcOpts          :: [String]
+    , asmOpts         :: [String]
+    , ccOpts          :: [String]
+    , cmmOpts         :: [String]
+    , cppOpts         :: [String]
+    , ldOpts          :: [String]
+    , depIncludeDirs  :: [String]
+    , depCcOpts       :: [String]
+    , depLdOpts       :: [String]
+    , buildGhciLib    :: Bool
+    } deriving (Eq, Generic, Show, Typeable)
+
+instance Binary   PackageData
+instance Hashable PackageData where hashWithSalt salt = hashWithSalt salt . show
+instance NFData   PackageData
+
+instance Binary   ContextData
+instance Hashable ContextData
+instance NFData   ContextData
diff --git a/src/Hadrian/Oracles/Cabal.hs b/src/Hadrian/Oracles/Cabal.hs
new file mode 100644 (file)
index 0000000..4c52162
--- /dev/null
@@ -0,0 +1,41 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Oracles.Cabal
+-- Copyright  : (c) Andrey Mokhov 2014-2018
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- This module defines oracles for reading and parsing Cabal files, as well as
+-- for configuring Haskell packages.
+-----------------------------------------------------------------------------
+module Hadrian.Oracles.Cabal (
+    readPackageData, readContextData, configurePackageGHC
+    ) where
+
+import Development.Shake
+import Distribution.Simple (Compiler)
+import Distribution.System (Platform)
+
+import Context.Type
+import Hadrian.Haskell.Cabal.Type
+import Hadrian.Oracles.Cabal.Type
+import Hadrian.Package
+import Stage
+
+-- | Read and parse a Cabal file, caching and tracking the result.
+readPackageData :: Package -> Action PackageData
+readPackageData = askOracle . PackageDataKey
+
+-- | Read and parse a Cabal file recording the obtained 'ContextData', caching
+-- and tracking the result. Note that unlike 'readPackageData' this function
+-- resolves all Cabal configuration flags and associated conditionals.
+readContextData :: Context -> Action ContextData
+readContextData = askOracle . ContextDataKey
+
+-- | Configure a 'Package' using the GHC corresponding to a given 'Stage',
+-- caching and tracking the result.
+configurePackageGHC :: Package -> Stage -> Action (Compiler, Platform)
+configurePackageGHC pkg stage = do
+    PackageConfiguration res <- askOracle $ PackageConfigurationKey (pkg, stage)
+    return res
diff --git a/src/Hadrian/Oracles/Cabal/Rules.hs b/src/Hadrian/Oracles/Cabal/Rules.hs
new file mode 100644 (file)
index 0000000..a069c73
--- /dev/null
@@ -0,0 +1,63 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Oracles.Cabal.Rules
+-- Copyright  : (c) Andrey Mokhov 2014-2018
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- This module defines Shake rules corresponing to the /Cabal oracle/; see
+-- the module "Hadrian.Oracles.Cabal" for various supported queries.
+-----------------------------------------------------------------------------
+module Hadrian.Oracles.Cabal.Rules where
+
+import Control.Monad
+import Data.Maybe
+import Development.Shake
+import Distribution.Simple.GHC
+import Distribution.Simple.Program.Db
+import Distribution.Verbosity
+
+import Builder
+import Context.Type
+import Hadrian.Haskell.Cabal.Parse
+import Hadrian.Oracles.Cabal.Type
+import Hadrian.Package
+import Hadrian.Utilities
+
+-- | These oracle rules are used to cache and track answers to the following
+-- queries, which are implemented via the Cabal library:
+--
+-- 1) 'Hadrian.Oracles.Cabal.readPackageData' that reads Cabal package data.
+--
+-- 2) 'Hadrian.Oracles.Cabal.readContextData' that reads 'Context'-dependent
+--    Cabal package data.
+--
+-- 3) 'Hadrian.Oracles.Cabal.configurePackageGHC' that configures a package.
+cabalOracle :: Rules ()
+cabalOracle = do
+    packageData <- newCache $ \package -> do
+        let file = pkgCabalFile package
+        need [file]
+        putLoud $ "| PackageData oracle: parsing " ++ quote file ++ "..."
+        parsePackageData package
+    void $ addOracleCache $ \(PackageDataKey package) -> packageData package
+
+    contextData <- newCache $ \(context@Context {..}) -> do
+        putLoud $ "| ContextData oracle: resolving data for "
+               ++ quote (pkgName package) ++ " (" ++ show stage
+               ++ ", " ++ show way ++ ")..."
+        resolveContextData context
+    void $ addOracleCache $ \(ContextDataKey context) -> contextData context
+
+    conf <- newCache $ \(pkg, stage) -> do
+        putLoud $ "| PackageConfiguration oracle: configuring "
+               ++ quote (pkgName pkg) ++ " (" ++ show stage ++ ")..."
+        -- Configure the package with the GHC corresponding to the given stage
+        hcPath <- builderPath (Ghc CompileHs stage)
+        (compiler, maybePlatform, _pkgdb) <- liftIO $
+            configure silent (Just hcPath) Nothing emptyProgramDb
+        let platform = fromMaybe (error msg) maybePlatform
+            msg      = "PackageConfiguration oracle: cannot detect platform"
+        return $ PackageConfiguration (compiler, platform)
+    void $ addOracleCache $ \(PackageConfigurationKey pkgStage) -> conf pkgStage
diff --git a/src/Hadrian/Oracles/Cabal/Type.hs b/src/Hadrian/Oracles/Cabal/Type.hs
new file mode 100644 (file)
index 0000000..d1b0947
--- /dev/null
@@ -0,0 +1,62 @@
+{-# LANGUAGE TypeFamilies #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Oracles.Cabal.Type
+-- Copyright  : (c) Andrey Mokhov 2014-2018
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- This module defines the types of keys used by the /Cabal oracles/. See the
+-- module "Hadrian.Oracles.Cabal" for supported Cabal oracle queries, and the
+-- module "Hadrian.Oracles.Cabal.Rules" for the corresponing Shake rules.
+-----------------------------------------------------------------------------
+module Hadrian.Oracles.Cabal.Type where
+
+import Development.Shake
+import Development.Shake.Classes
+import qualified Distribution.Simple as C
+import qualified Distribution.System as C
+
+import Context.Type
+import Hadrian.Haskell.Cabal.Type
+import Hadrian.Package
+import Stage
+
+-- | This type of oracle key is used by 'Hadrian.Oracles.Cabal.readPackageData'
+-- to cache reading and parsing of 'Hadrian.Haskell.Cabal.Type.PackageData'.
+newtype PackageDataKey = PackageDataKey Package
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult PackageDataKey = PackageData
+
+-- | This type of oracle key is used by 'Hadrian.Oracles.Cabal.readContextData'
+-- to cache reading and parsing of 'Hadrian.Haskell.Cabal.Type.ContextData'.
+newtype ContextDataKey = ContextDataKey Context
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult ContextDataKey = ContextData
+
+-- TODO: Should @PackageConfiguration@ be simply @()@? Presumably the pair
+-- @(Compiler, Maybe Platform)@ is fully determined by the current build Stage.
+-- | The result of Cabal package configuration produced by the oracle
+-- 'Hadrian.Oracles.Cabal.configurePackageGHC'.
+newtype PackageConfiguration = PackageConfiguration (C.Compiler, C.Platform)
+    deriving (Binary, Eq, Show, Typeable)
+
+instance NFData PackageConfiguration where
+    rnf (PackageConfiguration (c, p)) =
+        rnf (C.compilerId c)                      `seq`
+        rnf (C.abiTagString $ C.compilerAbiTag c) `seq`
+        rnf (C.compilerCompat c)                  `seq`
+        rnf (C.compilerLanguages c)               `seq`
+        rnf (C.compilerExtensions c)              `seq`
+        rnf (C.compilerProperties c)              `seq`
+        rnf p
+
+instance Hashable PackageConfiguration where
+    hashWithSalt _ = hash . show
+
+-- | This type of oracle key is used by 'Hadrian.Oracles.Cabal.configurePackageGHC'
+-- to cache configuration of a Cabal package.
+newtype PackageConfigurationKey = PackageConfigurationKey (Package, Stage)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult PackageConfigurationKey = PackageConfiguration
index ceccc23..ab771a4 100644 (file)
@@ -49,13 +49,13 @@ type instance RuleResult WindowsPath = String
 -- | Oracles for looking up paths. These are slow and require caching.
 pathOracle :: Rules ()
 pathOracle = do
-    void $ addOracle $ \(WindowsPath path) -> do
+    void $ addOracleCache $ \(WindowsPath path) -> do
         Stdout out <- quietly $ cmd ["cygpath", "-m", path]
         let windowsPath = unifyPath $ dropWhileEnd isSpace out
         putLoud $ "| Windows path mapping: " ++ path ++ " => " ++ windowsPath
         return windowsPath
 
-    void $ addOracle $ \(LookupInPath name) -> do
+    void $ addOracleCache $ \(LookupInPath name) -> do
         let unpack = fromMaybe . error $ "Cannot find executable " ++ quote name
         path <- unifyPath . unpack <$> liftIO (findExecutable name)
         putLoud $ "| Executable found: " ++ name ++ " => " ++ path
index f82e79d..08670c0 100644 (file)
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module     : Hadrian.Oracles.TextFile
@@ -8,29 +9,21 @@
 --
 -- Read and parse text files, tracking their contents. This oracle can be used
 -- to read configuration or package metadata files and cache the parsing.
--- This module exports various oracle queries, whereas the corresponing Shake
--- rules can be found in "Hadrian.Oracles.TextFile.Rules".
 -----------------------------------------------------------------------------
 module Hadrian.Oracles.TextFile (
-    readTextFile, lookupValue, lookupValueOrEmpty, lookupValueOrError,
-    lookupValues, lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies,
-    readCabalData, readPackageData
+    lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues,
+    lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, textFileOracle
     ) where
 
+import Control.Monad
+import qualified Data.HashMap.Strict as Map
 import Data.Maybe
 import Development.Shake
+import Development.Shake.Classes
+import Development.Shake.Config
 
-import Context.Type
-import Hadrian.Haskell.Cabal.CabalData
-import Hadrian.Haskell.Cabal.PackageData
-import Hadrian.Oracles.TextFile.Type
 import Hadrian.Utilities
 
--- | 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)
@@ -73,12 +66,45 @@ lookupDependencies depFile file = do
         Just [] -> error $ "No source file found for file " ++ quote file
         Just (source : files) -> return (source, files)
 
--- | Read and parse a @.cabal@ file, caching and tracking the result.
-readCabalData :: Context -> Action CabalData
-readCabalData = askOracle . CabalFile
+newtype TextFile = TextFile FilePath
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult TextFile = String
+
+newtype KeyValue = KeyValue (FilePath, String)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult KeyValue = Maybe String
+
+newtype KeyValues = KeyValues (FilePath, String)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+type instance RuleResult KeyValues = Maybe [String]
+
+-- | These oracle rules are used to cache and track answers to the following
+-- queries, which are implemented by parsing text files:
+--
+-- 1) Looking up key-value pairs formatted as @key = value1 value2 ...@ that
+--    are often used in text configuration files. See functions 'lookupValue',
+--    'lookupValueOrEmpty', 'lookupValueOrError', 'lookupValues',
+--    'lookupValuesOrEmpty' and 'lookupValuesOrError'.
+--
+-- 2) Parsing Makefile dependecy files generated by commands like @gcc -MM@:
+--    see 'lookupDependencies'.
+textFileOracle :: Rules ()
+textFileOracle = do
+    text <- newCache $ \file -> do
+        need [file]
+        putLoud $ "| TextFile oracle: reading " ++ quote file ++ "..."
+        liftIO $ readFile file
+    void $ addOracleCache $ \(TextFile file) -> text file
+
+    kv <- newCache $ \file -> do
+        need [file]
+        putLoud $ "| KeyValue oracle: reading " ++ quote file ++ "..."
+        liftIO $ readConfigFile file
+    void $ addOracleCache $ \(KeyValue (file, key)) -> Map.lookup key <$> kv file
 
--- | Read and parse a @.cabal@ file recording the obtained 'PackageData',
--- caching and tracking the result. Note that unlike 'readCabalData' this
--- function resolves all Cabal configuration flags and associated conditionals.
-readPackageData :: Context -> Action PackageData
-readPackageData = askOracle . PackageDataFile
+    kvs <- newCache $ \file -> do
+        need [file]
+        putLoud $ "| KeyValues oracle: reading " ++ quote file ++ "..."
+        contents <- map words <$> readFileLines file
+        return $ Map.fromList [ (key, values) | (key:values) <- contents ]
+    void $ addOracleCache $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
diff --git a/src/Hadrian/Oracles/TextFile/Rules.hs b/src/Hadrian/Oracles/TextFile/Rules.hs
deleted file mode 100644 (file)
index a80e7d8..0000000
+++ /dev/null
@@ -1,63 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module     : Hadrian.Oracles.TextFile.Rules
--- Copyright  : (c) Andrey Mokhov 2014-2018
--- License    : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability  : experimental
---
--- This module defines Shake rules corresponing to the /text file oracle/; see
--- the module "Hadrian.Oracles.TextFile" for various supported queries.
------------------------------------------------------------------------------
-module Hadrian.Oracles.TextFile.Rules (textFileOracle) where
-
-import Control.Monad
-import qualified Data.HashMap.Strict as Map
-import Development.Shake
-import Development.Shake.Config
-
-import Context.Type
-import Hadrian.Haskell.Cabal.Parse
-import Hadrian.Oracles.TextFile.Type
-import Hadrian.Package
-import Hadrian.Utilities
-import Stage
-
--- | This oracle reads and parses text files to answer various queries, caching
--- and tracking the results.
-textFileOracle :: Rules ()
-textFileOracle = do
-    text <- newCache $ \file -> do
-        need [file]
-        putLoud $ "| TextFile oracle: reading " ++ quote file ++ "..."
-        liftIO $ readFile file
-    void $ addOracle $ \(TextFile file) -> text file
-
-    kv <- newCache $ \file -> do
-        need [file]
-        putLoud $ "| KeyValue oracle: reading " ++ quote file ++ "..."
-        liftIO $ readConfigFile file
-    void $ addOracle $ \(KeyValue (file, key)) -> Map.lookup key <$> kv file
-
-    kvs <- newCache $ \file -> do
-        need [file]
-        putLoud $ "| KeyValues oracle: reading " ++ quote file ++ "..."
-        contents <- map words <$> readFileLines file
-        return $ Map.fromList [ (key, values) | (key:values) <- contents ]
-    void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
-
-    cabal <- newCache $ \(ctx@Context {..}) -> do
-        let file = pkgCabalFile package
-        need [file]
-        putLoud $ "| CabalFile oracle: reading " ++ quote file
-               ++ " (Stage: " ++ stageString stage ++ ")..."
-        parseCabalFile ctx
-    void $ addOracle $ \(CabalFile ctx) -> cabal ctx
-
-    confCabal <- newCache $ \(ctx@Context {..}) -> do
-        let file = pkgCabalFile package
-        need [file]
-        putLoud $ "| PackageDataFile oracle: reading " ++ quote file
-               ++ " (Stage: " ++ stageString stage ++ ")..."
-        parsePackageData ctx
-    void $ addOracle $ \(PackageDataFile ctx) -> confCabal ctx
diff --git a/src/Hadrian/Oracles/TextFile/Type.hs b/src/Hadrian/Oracles/TextFile/Type.hs
deleted file mode 100644 (file)
index c16c165..0000000
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
------------------------------------------------------------------------------
--- |
--- Module     : Hadrian.Oracles.TextFile.Type
--- Copyright  : (c) Andrey Mokhov 2014-2018
--- License    : MIT (see the file LICENSE)
--- Maintainer : andrey.mokhov@gmail.com
--- Stability  : experimental
---
--- This module defines the types of keys used by the /text file oracle/. See the
--- module "Hadrian.Oracles.TextFile" for various supported queries, and the
--- module "Hadrian.Oracles.TextFile.Rules" for the corresponing Shake rules.
------------------------------------------------------------------------------
-module Hadrian.Oracles.TextFile.Type where
-
-import Development.Shake
-import Development.Shake.Classes
-
-import Context.Type
-import Hadrian.Haskell.Cabal.CabalData
-import Hadrian.Haskell.Cabal.PackageData
-
-newtype TextFile = TextFile FilePath
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult TextFile = String
-
-newtype CabalFile = CabalFile Context
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult CabalFile = CabalData
-
-newtype PackageDataFile = PackageDataFile Context
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult PackageDataFile = PackageData
-
-newtype KeyValue = KeyValue (FilePath, String)
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult KeyValue = Maybe String
-
-newtype KeyValues = KeyValues (FilePath, String)
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-type instance RuleResult KeyValues = Maybe [String]
index ee7c9bd..1e508c0 100644 (file)
@@ -5,7 +5,7 @@ module Oracles.ModuleFiles (
     ) where
 
 import qualified Data.HashMap.Strict as Map
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type as PD
 
 import Base
 import Builder
@@ -92,7 +92,7 @@ hsSources context = do
 -- the build directory regardless of whether they are generated or not.
 hsObjects :: Context -> Action [FilePath]
 hsObjects context = do
-    modules <- interpretInContext context (getPackageData PD.modules)
+    modules <- interpretInContext context (getContextData PD.modules)
     mapM (objectPath context . moduleSource) modules
 
 -- | Generated module files live in the 'Context' specific build directory.
@@ -107,7 +107,7 @@ moduleSource moduleName = replaceEq '.' '/' moduleName <.> "hs"
 contextFiles :: Context -> Action [(ModuleName, Maybe FilePath)]
 contextFiles context@Context {..} = do
     modules <- fmap sort . interpretInContext context $
-        getPackageData PD.modules
+        getContextData PD.modules
     zip modules <$> askOracle (ModuleFiles (stage, package))
 
 -- | This is an important oracle whose role is to find and cache module source
@@ -123,14 +123,14 @@ contextFiles context@Context {..} = do
 -- Just "compiler/parser/Lexer.x"]. The oracle ignores @.(l)hs-boot@ files.
 moduleFilesOracle :: Rules ()
 moduleFilesOracle = void $ do
-    void . addOracle $ \(ModuleFiles (stage, package)) -> do
+    void . addOracleCache $ \(ModuleFiles (stage, package)) -> do
         let context = vanillaContext stage package
-        srcDirs <- interpretInContext context (getPackageData PD.srcDirs)
-        mainIs  <- interpretInContext context (getPackageData PD.mainIs)
+        srcDirs <- interpretInContext context (getContextData PD.srcDirs)
+        mainIs  <- interpretInContext context (getContextData PD.mainIs)
         let removeMain = case mainIs of
                               Just (mod, _) -> delete mod
                               Nothing       -> id
-        modules <- fmap sort $ interpretInContext context (getPackageData PD.modules)
+        modules <- fmap sort $ interpretInContext context (getContextData PD.modules)
         autogen <- autogenPath context
         let dirs = autogen : map (pkgPath package -/-) srcDirs
             -- Don't resolve the file path for module `Main` twice.
@@ -178,5 +178,5 @@ moduleFilesOracle = void $ do
                           , takeExtension src `notElem` haskellExtensions ]
         return $ Map.fromList list
 
-    addOracle $ \(Generator (stage, package, file)) ->
+    addOracleCache $ \(Generator (stage, package, file)) ->
         Map.lookup file <$> generators (stage, package)
index 2b2a15f..852bd5d 100644 (file)
@@ -1,9 +1,10 @@
 module Rules (buildRules, oracleRules, packageTargets, topLevelTargets) where
 
 import qualified Hadrian.Oracles.ArgsHash
+import qualified Hadrian.Oracles.Cabal.Rules
 import qualified Hadrian.Oracles.DirectoryContents
 import qualified Hadrian.Oracles.Path
-import qualified Hadrian.Oracles.TextFile.Rules
+import qualified Hadrian.Oracles.TextFile
 
 import Expression
 import qualified Oracles.ModuleFiles
@@ -135,7 +136,8 @@ buildRules = do
 oracleRules :: Rules ()
 oracleRules = do
     Hadrian.Oracles.ArgsHash.argsHashOracle trackArgument getArgs
+    Hadrian.Oracles.Cabal.Rules.cabalOracle
     Hadrian.Oracles.DirectoryContents.directoryContentsOracle
     Hadrian.Oracles.Path.pathOracle
-    Hadrian.Oracles.TextFile.Rules.textFileOracle
+    Hadrian.Oracles.TextFile.textFileOracle
     Oracles.ModuleFiles.moduleFilesOracle
index 570d4b1..f0aeb4b 100644 (file)
@@ -21,7 +21,7 @@ bindistRules = do
         targetPlatform <- setting TargetPlatformFull
         hostOs         <- setting BuildOs
         hostArch       <- setting BuildArch
-        rtsDir         <- pkgIdentifier $ vanillaContext Stage1 rts
+        rtsDir         <- pkgIdentifier rts
 
         let ghcBuildDir      = root -/- stageString Stage1
             bindistFilesDir  = root -/- "bindist" -/- ghcVersionPretty
index 7b10d56..9e236f0 100644 (file)
@@ -6,11 +6,12 @@ module Rules.Documentation (
     haddockDependencies
     ) where
 
-import qualified Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal
+import Hadrian.Haskell.Cabal.Type
 
 import Base
 import Context
-import Expression (getPackageData, interpretInContext)
+import Expression (getContextData, interpretInContext)
 import Flavour
 import Oracles.ModuleFiles
 import Packages
@@ -141,8 +142,8 @@ buildPackageDocumentation context@Context {..} = when (stage == Stage1 && packag
     root -/- htmlRoot -/- "libraries" -/- pkgName package -/- "haddock-prologue.txt" %> \file -> do
         need [root -/- haddockHtmlLib]
         -- This is how @ghc-cabal@ used to produces "haddock-prologue.txt" files.
-        (syn, desc) <- interpretInContext context . getPackageData $ \p ->
-            (PD.synopsis p, PD.description p)
+        syn  <- pkgSynopsis    package
+        desc <- pkgDescription package
         let prologue = if null desc then syn else desc
         liftIO $ writeFile file prologue
 
@@ -204,6 +205,6 @@ buildManPage = do
 -- | Find the Haddock files for the dependencies of the current library.
 haddockDependencies :: Context -> Action [FilePath]
 haddockDependencies context = do
-    depNames <- interpretInContext context (getPackageData PD.depNames)
+    depNames <- interpretInContext context (getContextData depNames)
     sequence [ pkgHaddockFile $ vanillaContext Stage1 depPkg
              | Just depPkg <- map findPackageByName depNames, depPkg /= rts ]
index 13f2ea3..b53bcc8 100644 (file)
@@ -2,7 +2,7 @@ module Rules.Library (libraryRules) where
 
 import Data.Functor
 import Hadrian.Haskell.Cabal
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type
 import qualified System.Directory as IO
 import qualified Text.Parsec      as Parsec
 
@@ -41,7 +41,7 @@ buildStaticLib root archivePath = do
     objs <- libraryObjects context
     removeFile archivePath
     build $ target context (Ar Pack stage) objs [archivePath]
-    synopsis <- pkgSynopsis context
+    synopsis <- pkgSynopsis (package context)
     putSuccess $ renderLibrary
         (quote pkgname ++ " (" ++ show stage ++ ", way " ++ show way ++ ").")
         archivePath synopsis
@@ -82,7 +82,7 @@ allObjects context = (++) <$> nonHsObjects context <*> hsObjects context
 nonHsObjects :: Context -> Action [FilePath]
 nonHsObjects context = do
     cObjs   <- cObjects context
-    cmmSrcs <- interpretInContext context (getPackageData PD.cmmSrcs)
+    cmmSrcs <- interpretInContext context (getContextData cmmSrcs)
     cmmObjs <- mapM (objectPath context) cmmSrcs
     eObjs   <- extraObjects context
     return $ cObjs ++ cmmObjs ++ eObjs
@@ -90,7 +90,7 @@ nonHsObjects context = do
 -- | Return all the C object files needed to build the given library context.
 cObjects :: Context -> Action [FilePath]
 cObjects context = do
-    srcs <- interpretInContext context (getPackageData PD.cSrcs)
+    srcs <- interpretInContext context (getContextData cSrcs)
     objs <- mapM (objectPath context) srcs
     return $ if Threaded `wayUnit` way context
         then objs
index 76390e3..f5be21a 100644 (file)
@@ -1,7 +1,7 @@
 module Rules.Program (buildProgram) where
 
 import Hadrian.Haskell.Cabal
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type
 
 import Base
 import Context
@@ -66,12 +66,12 @@ buildBinary rs bin context@Context {..} = do
     when (stage > Stage0) $ do
         ways <- interpretInContext context (getLibraryWays <> getRtsWays)
         needLibrary [ rtsContext { way = w } | w <- ways ]
-    cSrcs  <- interpretInContext context (getPackageData PD.cSrcs)
+    cSrcs  <- interpretInContext context (getContextData cSrcs)
     cObjs  <- mapM (objectPath context) cSrcs
     hsObjs <- hsObjects context
     let binDeps = cObjs ++ hsObjs
     need binDeps
     buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
-    synopsis <- pkgSynopsis context
+    synopsis <- pkgSynopsis package
     putSuccess $ renderProgram
         (quote (pkgName package) ++ " (" ++ show stage ++ ").") bin synopsis
index d6c1702..68aa6e3 100644 (file)
@@ -55,10 +55,10 @@ testDependencies :: Action ()
 testDependencies = do
     putBuild "==== pkgDependencies"
     let pkgs = ghcPackages \\ [libffi] -- @libffi@ does not have a Cabal file.
-    depLists <- mapM (pkgDependencies . vanillaContext Stage1) pkgs
+    depLists <- mapM pkgDependencies pkgs
     test $ and [ deps == sort deps | deps <- depLists ]
     putBuild "==== Dependencies of the 'ghc-bin' binary"
-    ghcDeps <- pkgDependencies (vanillaContext Stage1 ghc)
+    ghcDeps <- pkgDependencies ghc
     test $ pkgName compiler `elem` ghcDeps
     stage0Deps <- contextDependencies (vanillaContext Stage0 ghc)
     stage1Deps <- contextDependencies (vanillaContext Stage1 ghc)
index 3a91de0..9a68a4c 100644 (file)
@@ -110,9 +110,8 @@ bootPackageConstraints :: Args
 bootPackageConstraints = stage0 ? do
     bootPkgs <- expr $ stagePackages Stage0
     let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
-    context <- getContext
     constraints <- expr $ forM (sort pkgs) $ \pkg -> do
-        version <- pkgVersion (context { Context.package = pkg })
+        version <- pkgVersion pkg
         return $ ((pkgName pkg ++ " == ") ++) version
     pure $ concat [ ["--constraint", c] | c <- constraints ]
 
index c78a19d..e0055f3 100644 (file)
@@ -1,13 +1,13 @@
 module Settings.Builders.Cc (ccBuilderArgs) where
 
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type
 import Settings.Builders.Common
 
 ccBuilderArgs :: Args
 ccBuilderArgs = do
     way <- getWay
     builder Cc ? mconcat
-        [ getPackageData PD.ccOpts
+        [ getContextData ccOpts
         , getStagedSettingList ConfCcArgs
 
         , builder (Cc CompileC) ? mconcat
index c845650..6846c4b 100644 (file)
@@ -9,7 +9,7 @@ module Settings.Builders.Common (
     packageDatabaseArgs, bootPackageDatabaseArgs
     ) where
 
-import Hadrian.Haskell.Cabal.PackageData
+import Hadrian.Haskell.Cabal.Type
 
 import Base
 import Expression
@@ -24,8 +24,8 @@ cIncludeArgs = do
     pkg     <- getPackage
     root    <- getBuildRoot
     path    <- getBuildPath
-    incDirs <- getPackageData includeDirs
-    depDirs <- getPackageData depIncludeDirs
+    incDirs <- getContextData includeDirs
+    depDirs <- getContextData depIncludeDirs
     iconvIncludeDir <- getSetting IconvIncludeDir
     gmpIncludeDir   <- getSetting GmpIncludeDir
     ffiIncludeDir   <- getSetting FfiIncludeDir
index d70a034..8212b5f 100644 (file)
@@ -1,7 +1,7 @@
 module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where
 
 import Hadrian.Haskell.Cabal
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type
 
 import Flavour
 import Packages
@@ -25,7 +25,7 @@ compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
 compileC :: Args
 compileC = builder (Ghc CompileCWithGhc) ? do
     way <- getWay
-    let ccArgs = [ getPackageData PD.ccOpts
+    let ccArgs = [ getContextData ccOpts
                  , getStagedSettingList ConfCcArgs
                  , cIncludeArgs
                  , Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
@@ -65,7 +65,7 @@ findHsDependencies = builder (Ghc FindHsDependencies) ? do
             , getInputs ]
 
 haddockGhcArgs :: Args
-haddockGhcArgs = mconcat [ commonGhcArgs, getPackageData PD.hcOpts ]
+haddockGhcArgs = mconcat [ commonGhcArgs, getContextData hcOpts ]
 
 -- | Common GHC command line arguments used in 'ghcBuilderArgs',
 -- 'ghcCBuilderArgs', 'ghcMBuilderArgs' and 'haddockGhcArgs'.
@@ -87,7 +87,7 @@ commonGhcArgs = do
             , package rts ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion)
             , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
             , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
-            , map ("-optP" ++) <$> getPackageData PD.cppOpts
+            , map ("-optP" ++) <$> getContextData cppOpts
             , arg "-odir"    , arg path
             , arg "-hidir"   , arg path
             , arg "-stubdir" , arg path ]
@@ -108,13 +108,13 @@ wayGhcArgs = do
 
 packageGhcArgs :: Args
 packageGhcArgs = do
-    context <- getContext
-    pkgId   <- expr $ pkgIdentifier context
+    package <- getPackage
+    pkgId   <- expr $ pkgIdentifier package
     mconcat [ arg "-hide-all-packages"
             , arg "-no-user-package-db"
             , packageDatabaseArgs
             , libraryPackage ? arg ("-this-unit-id " ++ pkgId)
-            , map ("-package-id " ++) <$> getPackageData PD.depIpIds ]
+            , map ("-package-id " ++) <$> getContextData depIds ]
 
 includeGhcArgs :: Args
 includeGhcArgs = do
@@ -122,7 +122,7 @@ includeGhcArgs = do
     path    <- getBuildPath
     root    <- getBuildRoot
     context <- getContext
-    srcDirs <- getPackageData PD.srcDirs
+    srcDirs <- getContextData srcDirs
     autogen <- expr $ autogenPath context
     mconcat [ arg "-i"
             , arg $ "-i" ++ path
index 4124023..2830c20 100644 (file)
@@ -1,7 +1,7 @@
 module Settings.Builders.Haddock (haddockBuilderArgs) where
 
 import Hadrian.Haskell.Cabal
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type
 import Hadrian.Utilities
 
 import Packages
@@ -37,11 +37,11 @@ haddockBuilderArgs = mconcat
         root     <- getBuildRoot
         path     <- getBuildPath
         context  <- getContext
-        version  <- expr $ pkgVersion  context
-        synopsis <- expr $ pkgSynopsis context
-        deps     <- getPackageData PD.depNames
+        version  <- expr $ pkgVersion  pkg
+        synopsis <- expr $ pkgSynopsis pkg
+        deps     <- getContextData depNames
         haddocks <- expr $ haddockDependencies context
-        hVersion <- expr $ pkgVersion (vanillaContext Stage2 haddock)
+        hVersion <- expr $ pkgVersion haddock
         ghcOpts  <- haddockGhcArgs
         mconcat
             [ arg "--verbosity=0"
@@ -59,7 +59,7 @@ haddockBuilderArgs = mconcat
             , arg $ "--prologue=" ++ takeDirectory output -/- "haddock-prologue.txt"
             , arg $ "--optghc=-D__HADDOCK_VERSION__="
                     ++ show (versionToInt hVersion)
-            , map ("--hide=" ++) <$> getPackageData PD.otherModules
+            , map ("--hide=" ++) <$> getContextData otherModules
             , pure [ "--read-interface=../" ++ dep
                      ++ ",../" ++ dep ++ "/src/%{MODULE}.html#%{NAME},"
                      ++ haddock | (dep, haddock) <- zip deps haddocks ]
index 10fbb1b..0d5363d 100644 (file)
@@ -1,6 +1,6 @@
 module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where
 
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type
 
 import Builder
 import Packages
@@ -43,10 +43,10 @@ getCFlags = do
     mconcat [ remove ["-O"] (cArgs <> getStagedSettingList ConfCcArgs)
             , getStagedSettingList ConfCppArgs
             , cIncludeArgs
-            , getPackageData PD.ccOpts
+            , getContextData ccOpts
             -- we might be able to leave out cppOpts, to be investigated.
-            , getPackageData PD.cppOpts
-            , getPackageData PD.depCcOpts
+            , getContextData cppOpts
+            , getContextData depCcOpts
             , cWarnings
             , arg "-include", arg $ autogen -/- "cabal_macros.h" ]
 
@@ -54,5 +54,5 @@ getLFlags :: Expr [String]
 getLFlags =
     mconcat [ getStagedSettingList ConfGccLinkerArgs
             , ldArgs
-            , getPackageData PD.ldOpts
-            , getPackageData PD.depLdOpts ]
+            , getContextData ldOpts
+            , getContextData depLdOpts ]
index 82bfc9a..7b04170 100644 (file)
@@ -16,7 +16,7 @@ module Settings.Default (
 import qualified Hadrian.Builder.Ar
 import qualified Hadrian.Builder.Sphinx
 import qualified Hadrian.Builder.Tar
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type
 
 import CommandLine
 import Expression
@@ -181,7 +181,7 @@ data SourceArgs = SourceArgs
 sourceArgs :: SourceArgs -> Args
 sourceArgs SourceArgs {..} = builder Ghc ? mconcat
     [ hsDefault
-    , getPackageData PD.hcOpts
+    , getContextData hcOpts
     , libraryPackage   ? hsLibrary
     , package compiler ? hsCompiler
     , package ghc      ? hsGhc ]
index a7abcb9..7fe6a89 100644 (file)
@@ -8,7 +8,7 @@ module Utilities (
 
 import qualified Hadrian.Builder as H
 import Hadrian.Haskell.Cabal
-import Hadrian.Haskell.Cabal.PackageData as PD
+import Hadrian.Haskell.Cabal.Type
 import Hadrian.Utilities
 
 import Context
@@ -33,10 +33,10 @@ askWithResources rs target = H.askWithResources rs target getArgs
 -- 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 transitively scan @.cabal@ files using 'pkgDependencies'
--- defined in "Hadrian.Haskell.Cabal".
+-- dependencies we transitively scan Cabal files using 'pkgDependencies' defined
+-- in "Hadrian.Haskell.Cabal".
 contextDependencies :: Context -> Action [Context]
-contextDependencies ctx@Context {..} = do
+contextDependencies Context {..} = do
     depPkgs <- go [package]
     return [ Context depStage pkg way | pkg <- depPkgs, pkg /= package ]
   where
@@ -46,14 +46,14 @@ contextDependencies ctx@Context {..} = do
         let newPkgs = nubOrd $ sort (deps ++ pkgs)
         if pkgs == newPkgs then return pkgs else go newPkgs
     step pkg = do
-        deps   <- pkgDependencies $ ctx { Context.package = pkg }
+        deps   <- pkgDependencies pkg
         active <- sort <$> stagePackages depStage
         return $ intersectOrd (compare . pkgName) active deps
 
 cabalDependencies :: Context -> Action [String]
-cabalDependencies ctx = interpretInContext ctx $ getPackageData PD.depIpIds
+cabalDependencies ctx = interpretInContext ctx $ getContextData depIds
 
--- | Lookup dependencies of a 'Package' in the vanilla Stage1 context.
+-- | Lookup dependencies of a 'Package' in the @vanilla Stage1 context@.
 stage1Dependencies :: Package -> Action [Package]
 stage1Dependencies =
     fmap (map Context.package) . contextDependencies . vanillaContext Stage1
@@ -65,7 +65,7 @@ libraryTargets includeGhciLib context = do
     libFile  <- pkgLibraryFile     context
     ghciLib  <- pkgGhciLibraryFile context
     ghci     <- if includeGhciLib
-                then interpretInContext context $ getPackageData PD.buildGhciLib
+                then interpretInContext context $ getContextData buildGhciLib
                 else return False
     return $ [ libFile ] ++ [ ghciLib | ghci ]
 
index 6a529e7..d379133 100644 (file)
@@ -1,7 +1,7 @@
 # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration.html
 
 # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-12.9
+resolver: lts-12.10
 
 # Local packages, usually specified by relative directory name
 packages:
@@ -9,9 +9,6 @@ packages:
 - '../libraries/Cabal/Cabal'
 - '../libraries/text'
 
-extra-deps:
-- shake-0.16.1
-
 # This is necessary to build until happy's version bounds are updated to work
 # with the new Cabal version.  Stack's error message explains the issue:
 #