-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.LogFormatter
-- Copyright   : (c) Ivan A. Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan A. Malison
-- Stability   : unstable
-- Portability : unportable
-----------------------------------------------------------------------------
module System.Taffybar.LogFormatter where

import System.Console.ANSI
import System.Log.Formatter
import System.Log.Handler.Simple
import System.Log.Logger
import Text.Printf
import System.IO
import Data.Monoid

import Prelude

setColor :: Color -> String
setColor :: Color -> String
setColor Color
color = [SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
color]

priorityToColor :: Priority -> Color
priorityToColor :: Priority -> Color
priorityToColor Priority
CRITICAL = Color
Red
priorityToColor Priority
ALERT = Color
Red
priorityToColor Priority
EMERGENCY = Color
Red
priorityToColor Priority
ERROR = Color
Red
priorityToColor Priority
WARNING = Color
Yellow
priorityToColor Priority
NOTICE = Color
Magenta
priorityToColor Priority
INFO = Color
Blue
priorityToColor Priority
DEBUG = Color
Green

reset :: String
reset :: String
reset = [SGR] -> String
setSGRCode [SGR
Reset]

colorize :: Color -> String -> String
colorize :: Color -> String -> String
colorize Color
color String
txt = Color -> String
setColor Color
color String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
txt String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
reset

taffyLogFormatter :: LogFormatter a
taffyLogFormatter :: forall a. LogFormatter a
taffyLogFormatter a
_ (Priority
level, String
msg) String
name =
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s %s - %s" String
colorizedPriority String
colorizedName String
msg
    where priorityColor :: Color
priorityColor = Priority -> Color
priorityToColor Priority
level
          colorizedPriority :: String
colorizedPriority = Color -> String -> String
colorize Color
priorityColor
                              (String
"[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Priority -> String
forall a. Show a => a -> String
show Priority
level String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"]")
          colorizedName :: String
colorizedName = Color -> String -> String
colorize Color
Green String
name

taffyLogHandler :: IO (GenericHandler Handle)
taffyLogHandler :: IO (GenericHandler Handle)
taffyLogHandler = GenericHandler Handle -> GenericHandler Handle
forall {a}. GenericHandler a -> GenericHandler a
setFormatter (GenericHandler Handle -> GenericHandler Handle)
-> IO (GenericHandler Handle) -> IO (GenericHandler Handle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
stderr Priority
DEBUG
  where setFormatter :: GenericHandler a -> GenericHandler a
setFormatter GenericHandler a
h = GenericHandler a
h { formatter :: LogFormatter (GenericHandler a)
formatter = LogFormatter (GenericHandler a)
forall a. LogFormatter a
taffyLogFormatter }