From c2d73d5fcd5d6cca4463caf69912ae0b65c92abe Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 23 Feb 2021 13:00:32 -0500 Subject: Add Biz.Log middleware that works with systemd Perhaps this is not as performant as the wai-provided one, but it is *much* simpler and follows my output format, which I think is much easier to quickly read. Anyway I doubt logging will ever be a bottleneck, and if it is then I should be able to create some instrument to detect that. --- Biz/Log.hs | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) (limited to 'Biz/Log.hs') 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 -- cgit v1.2.3