{-# LANGUAGE LambdaCase #-}

module Restyler.Logger
    ( restylerLogFunc
    )
where

import Restyler.Prelude

import Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Char8 as BS8
import Restyler.Options
import System.Console.ANSI

restylerLogFunc :: Options -> LogFunc
restylerLogFunc :: Options -> LogFunc
restylerLogFunc Options {..} = (CallStack -> Text -> LogLevel -> Utf8Builder -> IO ()) -> LogFunc
mkLogFunc ((CallStack -> Text -> LogLevel -> Utf8Builder -> IO ())
 -> LogFunc)
-> (CallStack -> Text -> LogLevel -> Utf8Builder -> IO ())
-> LogFunc
forall a b. (a -> b) -> a -> b
$ \_cs :: CallStack
_cs _source :: Text
_source level :: LogLevel
level msg :: Utf8Builder
msg ->
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
oLogLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        ByteString -> IO ()
BS8.putStr "["
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
oLogColor (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> IO ()
setSGR [LogLevel -> SGR
levelStyle LogLevel
level]
        ByteString -> IO ()
BS8.putStr (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> ByteString
levelStr LogLevel
level
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
oLogColor (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [SGR] -> IO ()
setSGR [SGR
Reset]
        ByteString -> IO ()
BS8.putStr "] "
        ByteString -> IO ()
BS8.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ LByteString -> ByteString
toStrictBytes (LByteString -> ByteString) -> LByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> LByteString
toLazyByteString (Builder -> LByteString) -> Builder -> LByteString
forall a b. (a -> b) -> a -> b
$ Utf8Builder -> Builder
getUtf8Builder Utf8Builder
msg

levelStr :: LogLevel -> ByteString
levelStr :: LogLevel -> ByteString
levelStr = \case
    LevelDebug -> "Debug"
    LevelInfo -> "Info"
    LevelWarn -> "Warn"
    LevelError -> "Error"
    LevelOther x :: Text
x -> Text -> ByteString
encodeUtf8 Text
x

levelStyle :: LogLevel -> SGR
levelStyle :: LogLevel -> SGR
levelStyle = \case
    LevelDebug -> ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Magenta
    LevelInfo -> ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Blue
    LevelWarn -> ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Yellow
    LevelError -> ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Red
    LevelOther _ -> SGR
Reset