[commit: ghc] wip/nfs-locking: Factor out cabal parsing functionality into the library (4a46d14)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:56:05 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/4a46d14ec3631672d2a3733c45f0aa61eb861eab/ghc

>---------------------------------------------------------------

commit 4a46d14ec3631672d2a3733c45f0aa61eb861eab
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Aug 16 22:18:45 2017 +0100

    Factor out cabal parsing functionality into the library
    
    See #347


>---------------------------------------------------------------

4a46d14ec3631672d2a3733c45f0aa61eb861eab
 hadrian.cabal                     |  1 +
 src/Hadrian/Haskell/Cabal.hs      | 38 ++++++++++++++++++++++++++++++++++++++
 src/Rules/Cabal.hs                | 31 ++++++-------------------------
 src/Settings/Packages/GhcCabal.hs | 13 ++-----------
 4 files changed, 47 insertions(+), 36 deletions(-)

diff --git a/hadrian.cabal b/hadrian.cabal
index 8ad971f..1520881 100644
--- a/hadrian.cabal
+++ b/hadrian.cabal
@@ -27,6 +27,7 @@ executable hadrian
                        , Flavour
                        , GHC
                        , Hadrian.Expression
+                       , Hadrian.Haskell.Cabal
                        , Hadrian.Oracles.ArgsHash
                        , Hadrian.Oracles.DirectoryContents
                        , Hadrian.Oracles.KeyValue
diff --git a/src/Hadrian/Haskell/Cabal.hs b/src/Hadrian/Haskell/Cabal.hs
new file mode 100644
index 0000000..b8f874c
--- /dev/null
+++ b/src/Hadrian/Haskell/Cabal.hs
@@ -0,0 +1,38 @@
+module Hadrian.Haskell.Cabal (readCabal, cabalNameVersion, cabalDependencies) where
+
+import Development.Shake
+import Distribution.Package
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Parse
+import Distribution.Text
+import Distribution.Types.CondTree
+import Distribution.Verbosity
+
+-- TODO: Track the values?
+
+-- | Read a given @.cabal@ file and return the 'GenericPackageDescription'.
+readCabal :: FilePath -> Action GenericPackageDescription
+readCabal cabal = do
+    need [cabal]
+    liftIO $ readGenericPackageDescription silent cabal
+
+-- | Read a given @.cabal@ file and return the package name and version.
+cabalNameVersion :: FilePath -> Action (String, String)
+cabalNameVersion cabal = do
+    identifier <- package . packageDescription <$> readCabal cabal
+    return (unPackageName $ pkgName identifier, display $ pkgVersion identifier)
+
+-- | Read a given @.cabal@ file and return the package dependencies.
+cabalDependencies :: FilePath -> Action [String]
+cabalDependencies cabal = do
+    gpd <- readCabal cabal
+    let depsLib  = collectDeps $ condLibrary gpd
+        depsExes = map (collectDeps . Just . snd) $ condExecutables gpd
+        deps     = concat $ depsLib : depsExes
+    return $ [ unPackageName name | Dependency name _ <- deps ]
+
+collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]
+collectDeps Nothing = []
+collectDeps (Just (CondNode _ deps ifs)) = deps ++ concatMap f ifs
+  where
+    f (CondBranch _ t mt) = collectDeps (Just t) ++ collectDeps mt
diff --git a/src/Rules/Cabal.hs b/src/Rules/Cabal.hs
index a9a9b51..ab8c6f9 100644
--- a/src/Rules/Cabal.hs
+++ b/src/Rules/Cabal.hs
@@ -1,11 +1,6 @@
 module Rules.Cabal (cabalRules) where
 
-import Distribution.Package as DP
-import Distribution.PackageDescription
-import Distribution.PackageDescription.Parse
-import Distribution.Text
-import Distribution.Types.CondTree
-import Distribution.Verbosity
+import Hadrian.Haskell.Cabal
 
 import Base
 import GHC
@@ -18,32 +13,18 @@ cabalRules = do
         bootPkgs <- stagePackages Stage0
         let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
         constraints <- forM (sort pkgs) $ \pkg -> do
-            need [pkgCabalFile pkg]
-            pd <- liftIO . readGenericPackageDescription silent $ pkgCabalFile pkg
-            let identifier          = package . packageDescription $ pd
-                version             = display . pkgVersion $ identifier
-            return $ unPackageName (DP.pkgName identifier) ++ " == " ++ version
+            (name, version) <- cabalNameVersion (pkgCabalFile pkg)
+            return $ name ++ " == " ++ version
         writeFileChanged out . unlines $ constraints
         putSuccess $ "| Successfully generated boot package constraints"
 
     -- Cache package dependencies.
     "//" -/- packageDependencies %> \out -> do
         pkgDeps <- forM (sort knownPackages) $ \pkg -> do
-            exists <- doesFileExist $ pkgCabalFile pkg
+            exists <- doesFileExist (pkgCabalFile pkg)
             if not exists then return $ pkgNameString pkg
             else do
-                need [pkgCabalFile pkg]
-                pd <- liftIO . readGenericPackageDescription silent $ pkgCabalFile pkg
-                let depsLib  = collectDeps $ condLibrary pd
-                    depsExes = map (collectDeps . Just . snd) $ condExecutables pd
-                    deps     = concat $ depsLib : depsExes
-                    depNames = [ unPackageName name | Dependency name _ <- deps ]
-                return . unwords $ pkgNameString pkg : (sort depNames \\ [pkgNameString pkg])
+                deps <- sort <$> cabalDependencies (pkgCabalFile pkg)
+                return . unwords $ pkgNameString pkg : (deps \\ [pkgNameString pkg])
         writeFileChanged out $ unlines pkgDeps
         putSuccess $ "| Successfully generated package dependencies"
-
-collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]
-collectDeps Nothing = []
-collectDeps (Just (CondNode _ deps ifs)) = deps ++ concatMap f ifs
-  where
-    f (CondBranch _ t mt) = collectDeps (Just t) ++ collectDeps mt
diff --git a/src/Settings/Packages/GhcCabal.hs b/src/Settings/Packages/GhcCabal.hs
index c7b82ca..79e92c7 100644
--- a/src/Settings/Packages/GhcCabal.hs
+++ b/src/Settings/Packages/GhcCabal.hs
@@ -1,11 +1,6 @@
 module Settings.Packages.GhcCabal (ghcCabalPackageArgs) where
 
-import Distribution.Package (pkgVersion)
-import Distribution.PackageDescription (packageDescription)
-import Distribution.PackageDescription.Parse
-import qualified Distribution.PackageDescription as DP
-import Distribution.Text (display)
-import Distribution.Verbosity (silent)
+import Hadrian.Haskell.Cabal
 
 import Base
 import Expression
@@ -15,11 +10,7 @@ import Utilities
 ghcCabalPackageArgs :: Args
 ghcCabalPackageArgs = stage0 ? package ghcCabal ? builder Ghc ? do
     cabalDeps <- expr $ pkgDependencies cabal
-    expr $ need [pkgCabalFile cabal]
-    pd <- exprIO . readGenericPackageDescription silent $ pkgCabalFile cabal
-    let identifier   = DP.package . packageDescription $ pd
-        cabalVersion = display . pkgVersion $ identifier
-
+    (_, cabalVersion) <- expr $ cabalNameVersion (pkgCabalFile cabal)
     mconcat
         [ pure [ "-package " ++ pkgNameString pkg | pkg <- cabalDeps ]
         , arg "--make"



More information about the ghc-commits mailing list