[commit: ghc] wip/nfs-locking: Move `renderBox` to `Base` (26e64ed)
git at git.haskell.org
git at git.haskell.org
Thu Oct 26 23:26:48 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/26e64ed57d5b0d85e740baedd529e845002103e9/ghc
>---------------------------------------------------------------
commit 26e64ed57d5b0d85e740baedd529e845002103e9
Author: Ben Gamari <ben at smart-cactus.org>
Date: Sun Dec 20 21:41:36 2015 +0100
Move `renderBox` to `Base`
>---------------------------------------------------------------
26e64ed57d5b0d85e740baedd529e845002103e9
src/Base.hs | 18 ++++++++++++++++++
src/Rules/Actions.hs | 20 ++------------------
2 files changed, 20 insertions(+), 18 deletions(-)
diff --git a/src/Base.hs b/src/Base.hs
index 7edae37..fb3b5e1 100644
--- a/src/Base.hs
+++ b/src/Base.hs
@@ -21,6 +21,7 @@ module Base (
-- * Output
putColoured, putOracle, putBuild, putSuccess, putError,
+ renderBox,
module System.Console.ANSI,
-- * Miscellaneous utilities
@@ -130,6 +131,23 @@ putError msg = do
putColoured Red msg
error $ "GHC build system error: " ++ msg
+-- | Render the given set of lines in a ASCII box
+renderBox :: [String] -> String
+renderBox ls =
+ unlines $ [begin] ++ map (bar++) ls ++ [end]
+ where
+ (begin,bar,end)
+ | useUnicode = ( "╭──────────"
+ , "│ "
+ , "╰──────────"
+ )
+ | otherwise = ( "/----------"
+ , "| "
+ , "\\----------"
+ )
+ -- FIXME: See Shake #364.
+ useUnicode = False
+
-- Depending on Data.Bifunctor only for this function seems an overkill
bimap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
bimap f g (x, y) = (f x, g y)
diff --git a/src/Rules/Actions.hs b/src/Rules/Actions.hs
index 775524a..5a3d113 100644
--- a/src/Rules/Actions.hs
+++ b/src/Rules/Actions.hs
@@ -7,22 +7,6 @@ import Settings.Args
import Settings.Builders.Ar
import qualified Target
-insideBox :: [String] -> String
-insideBox ls =
- unlines $ [begin] ++ map (bar++) ls ++ [end]
- where
- (begin,bar,end)
- | useUnicode = ( "╭──────────"
- , "│ "
- , "╰──────────"
- )
- | otherwise = ( "/----------"
- , "| "
- , "\\----------"
- )
- -- FIXME: See Shake #364.
- useUnicode = False
-
-- Build a given target using an appropriate builder and acquiring necessary
-- resources. Force a rebuilt if the argument list has changed since the last
-- built (that is, track changes in the build system).
@@ -38,8 +22,8 @@ buildWithResources rs target = do
checkArgsHash target
withResources rs $ do
unless verbose $ do
- putBuild $ insideBox $ [ "Running " ++ show builder ++ " with arguments:" ]
- ++ map (" "++) (interestingInfo builder argList)
+ putBuild $ renderBox $ [ "Running " ++ show builder ++ " with arguments:" ]
+ ++ map (" "++) (interestingInfo builder argList)
quietlyUnlessVerbose $ case builder of
Ar -> arCmd path argList
More information about the ghc-commits
mailing list