[commit: ghc] wip/nfs-locking: Minor revision (a0afb98)

[git at git.haskell.org]

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

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

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

commit a0afb987569ba2ac617b1bcd035f124c93463da3
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Oct 19 00:03:58 2016 +0100

    Minor revision


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

a0afb987569ba2ac617b1bcd035f124c93463da3
 src/Expression.hs    |  4 ++--
 src/Rules/Gmp.hs     | 11 ++++-------
 src/Rules/Libffi.hs  | 10 +++-------
 src/Rules/Library.hs |  4 ++--
 4 files changed, 11 insertions(+), 18 deletions(-)

diff --git a/src/Expression.hs b/src/Expression.hs
index 114bfe4..a572c2c 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -16,7 +16,7 @@ module Expression (
 
     -- * Convenient accessors
     getContext, getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
-    getInput, getOutput,
+    getInput, getOutput, getSingleton,
 
     -- * Re-exports
     module Control.Monad.Trans.Reader,
@@ -206,7 +206,7 @@ getOutput = do
     getSingleton getOutputs $
         "getOutput: exactly one output file expected in target " ++ show target
 
-getSingleton :: Expr [a] -> String -> Expr a
+getSingleton :: Monad m => m [a] -> String -> m a
 getSingleton expr msg = expr >>= \case
     [res] -> return res
     _     -> error msg
diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs
index 50c548b..3693ad4 100644
--- a/src/Rules/Gmp.hs
+++ b/src/Rules/Gmp.hs
@@ -1,4 +1,4 @@
-module Rules.Gmp (gmpRules, gmpContext) where
+module Rules.Gmp (gmpRules) where
 
 import Base
 import Builder
@@ -81,12 +81,9 @@ gmpRules = do
         -- gmp-4.2.4.tar.bz2 repacked without the doc/ directory contents.
         -- That's because the doc/ directory contents are under the GFDL,
         -- which causes problems for Debian.
-        tarballs <- getDirectoryFiles "" [gmpBase -/- "tarball/gmp*.tar.bz2"]
-        tarball  <- case tarballs of -- TODO: Drop code duplication.
-            [file] -> return $ unifyPath file
-            _      -> error $ "gmpRules: exactly one tarball expected"
-                      ++ "(found: " ++ show tarballs ++ ")."
-
+        let tarballs = gmpBase -/- "tarball/gmp*.tar.bz2"
+        tarball <- unifyPath <$> getSingleton (getDirectoryFiles "" [tarballs])
+                                 "Exactly one GMP tarball is expected."
         withTempDir $ \dir -> do
             let tmp = unifyPath dir
             need [tarball]
diff --git a/src/Rules/Libffi.hs b/src/Rules/Libffi.hs
index 5ca17ea..6dd92bc 100644
--- a/src/Rules/Libffi.hs
+++ b/src/Rules/Libffi.hs
@@ -80,13 +80,9 @@ libffiRules = do
     libffiMakefile <.> "in" %> \mkIn -> do
         removeDirectory libffiBuildPath
         createDirectory $ buildRootPath -/- stageString Stage0
-
-        tarballs <- getDirectoryFiles "" ["libffi-tarballs/libffi*.tar.gz"]
-        tarball  <- case tarballs of -- TODO: Drop code duplication.
-            [file] -> return $ unifyPath file
-            _      -> error $ "libffiRules: exactly one tarball expected"
-                      ++ "(found: " ++ show tarballs ++ ")."
-
+        let tarballs = "libffi-tarballs/libffi*.tar.gz"
+        tarball <- unifyPath <$> getSingleton (getDirectoryFiles "" [tarballs])
+                                 "Exactly one LibFFI tarball is expected."
         need [tarball]
         let libname = dropExtension . dropExtension $ takeFileName tarball
 
diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs
index 00a6be2..731bb7b 100644
--- a/src/Rules/Library.hs
+++ b/src/Rules/Library.hs
@@ -9,9 +9,9 @@ import Base
 import Context
 import Expression
 import Flavour
+import GHC
 import Oracles.PackageData
 import Rules.Actions
-import Rules.Gmp
 import Settings
 import Settings.Paths
 import Target
@@ -96,7 +96,7 @@ hSources context = do
 
 extraObjects :: Context -> Action [FilePath]
 extraObjects context
-    | context == gmpContext = do
+    | package context == integerGmp = do
         need [gmpLibraryH]
         map unifyPath <$> getDirectoryFiles "" [gmpObjects -/- "*.o"]
     | otherwise         = return []