module Data.Metrics.Reporter.StdOut (
printHealthCheck,
printHealthChecks,
reportMetrics,
dumpMetrics
) where
import Control.Applicative
import Control.Concurrent.MVar
import qualified Data.HashMap.Strict as H
import Data.HealthCheck
import Data.Metrics
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.Console.ANSI
prettyPrintMetric (m, v) = T.putStr m >> T.putStr ": " >> putStrLn v
reportMetrics :: MetricRegistry IO -> IO ()
reportMetrics m = dumpMetrics m >>= mapM_ prettyPrintMetric
dumpMetrics :: MetricRegistry IO -> IO [(T.Text, String)]
dumpMetrics r = do
ms <- readMVar $ metrics r
let readRep (k, metricVariety) = do
display <- case metricVariety of
(MetricGauge g) -> show <$> value g
(MetricCounter c) -> show <$> value c
(MetricHistogram h) -> return ""
(MetricMeter m) -> do
one <- (\x -> "\t" ++ show x ++ "/minute\n") <$> oneMinuteRate m
five <- (\x -> "\t" ++ show x ++ "/5 minutes\n") <$> fiveMinuteRate m
fifteen <- (\x -> "\t" ++ show x ++ "/15 minutes\n") <$> fifteenMinuteRate m
return ("\n" ++ one ++ five ++ fifteen)
(MetricTimer t) -> (\x -> show x ++ " s") <$> mean t
return (k, display)
mapM readRep $ H.toList ms
fg = SetColor Foreground Vivid
printHealthCheck :: HealthCheck -> IO ()
printHealthCheck (HealthCheck m name) = do
s <- m
setSGR $ case status s of
Good -> [fg Green]
Bad -> [fg Red]
Ugly -> [fg Yellow]
Unknown -> [fg Cyan]
T.putStr "● "
setSGR [Reset]
T.putStr name
maybe (T.putStr "\n") (\msg -> T.putStr ": " >> T.putStrLn msg) $ statusMessage s
printHealthChecks :: HealthChecks -> IO ()
printHealthChecks = mapM_ printHealthCheck