summaryrefslogtreecommitdiff
path: root/Biz/Log.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Log.hs')
-rw-r--r--Biz/Log.hs24
1 files changed, 20 insertions, 4 deletions
diff --git a/Biz/Log.hs b/Biz/Log.hs
index 8c7b043..9a790aa 100644
--- a/Biz/Log.hs
+++ b/Biz/Log.hs
@@ -22,15 +22,31 @@ where
import Alpha hiding (pass)
import qualified Data.Text as Text
-import Rainbow (chunk, fore, green, magenta, putChunk, red, white, yellow)
+import Rainbow (chunk, fore, green, magenta, red, white, yellow)
+import qualified Rainbow
+import qualified System.Environment as Env
+import qualified System.IO as IO
import System.IO.Unsafe (unsafePerformIO)
data Lvl = Good | Pass | Info | Warn | Fail | Mark
+-- | Get the environment. This should probably return 'Biz.Devalloc.Area'
+-- instead of 'String'.
+area :: String
+area =
+ Env.lookupEnv "AREA"
+ /> maybe "Test" identity
+ |> unsafePerformIO
+
msg :: Lvl -> [Text] -> IO ()
-msg lvl labels = putChunk <| fore color <| clear <> txt <> "\r"
+msg lvl labels =
+ case area of
+ -- systemd doesn't render msgs produced by putChunk, so when live we don't
+ -- use rainbow at all
+ "Live" -> putStr txt
+ _ -> Rainbow.putChunk <| fore color <| clear <> chunk txt <> "\r"
where
- txt = chunk <| Text.intercalate gap (label : labels)
+ txt = Text.intercalate gap (label : labels)
(color, label) = case lvl of
Good -> (green, "good")
Pass -> (green, "pass")
@@ -44,7 +60,7 @@ gap :: Text
gap = ": "
br :: IO ()
-br = putChunk "\n"
+br = Rainbow.putChunk "\n" >> IO.hFlush stdout
good, pass, info, warn, fail :: [Text] -> IO ()
good = msg Good