[commit: ghc] wip/nfs-locking: Move `renderBox` to `Base` (26e64ed)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:43:44 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