From a0afb987569ba2ac617b1bcd035f124c93463da3 Mon Sep 17 00:00:00 2001
From: Andrey Mokhov <andrey.mokhov@gmail.com>
Date: Wed, 19 Oct 2016 00:03:58 +0100
Subject: [PATCH] Minor revision
---
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 114bfe4e2bb9..a572c2c989be 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 50c548b6eae8..3693ad4b0157 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 5ca17ea3feec..6dd92bc623b1 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 00a6be299ff9..731bb7b27294 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 []
--
GitLab