Logger.hs

module Kevin.Util.Logger (
    klog,
    klog_,
    klogNow,
    klogError,
    klogWarn,
    Color(..),
    runLogger,
    printf
) where

import Control.Concurrent
import Control.Monad.State
import Data.Char (isSpace)
import qualified Data.Text as T
import Kevin.Types

data Color = Red | Blue | Green | Cyan | Magenta | Yellow | Gray

colorAsNum :: Color -> Int
colorAsNum Red = 31
colorAsNum Green = 32
colorAsNum Yellow = 33
colorAsNum Blue = 34
colorAsNum Magenta = 35
colorAsNum Cyan = 36
colorAsNum Gray = 37

runLogger :: Chan String -> IO ()
runLogger ch = void . forkIO . forever $ readChan ch >>= putStrLn

interleave :: [a] -> [a] -> [a]
interleave xs [] = xs
interleave [] ys = ys
interleave (x:xs) (y:ys) = x:y:interleave xs ys

printf :: T.Text -> [T.Text] -> T.Text
printf str reps = T.concat $ interleave (T.splitOn "%s" str) reps

render :: Color -> String -> String
render col str = "\027[" ++ show (colorAsNum col) ++ "m" ++ rtrimmed ++ "\027[0m"
    where
        rtrimmed = reverse . dropWhile (\x -> isSpace x || x == '\x0') . reverse $ str

klog_ :: Chan String -> Color -> String -> IO ()
klog_ ch col str = writeChan ch $ render col str

klogNow :: Color -> String -> IO ()
klogNow c s = putStrLn $ render c s

klog :: Color -> String -> KevinIO ()
klog c str = gets_ logger >>= \ch -> liftIO $ klog_ ch c str

klogError, klogWarn :: String -> KevinIO ()

klogError = klog Red . ("ERROR :: " ++)
klogWarn = klog Yellow . ("WARNING :: " ++)