Move `renderBox` to `Base`
authorBen Gamari <ben@smart-cactus.org>
Sun, 20 Dec 2015 20:41:36 +0000 (21:41 +0100)
committerBen Gamari <ben@smart-cactus.org>
Sun, 20 Dec 2015 20:47:32 +0000 (21:47 +0100)
src/Base.hs
src/Rules/Actions.hs

index 7edae37..fb3b5e1 100644 (file)
@@ -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)
index 775524a..5a3d113 100644 (file)
@@ -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