{-# LANGUAGE NamedFieldPuns #-}
module Graphics.GPipe.Context.GLFW.Logger where

import           System.IO   (hPutStrLn, stderr)
import           Text.Printf (printf)

-- | Levels of severity for log messages.
data LogLevel = DEBUG | INFO | WARNING | ERROR
    deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord, Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFrom :: LogLevel -> [LogLevel]
fromEnum :: LogLevel -> Int
$cfromEnum :: LogLevel -> Int
toEnum :: Int -> LogLevel
$ctoEnum :: Int -> LogLevel
pred :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$csucc :: LogLevel -> LogLevel
Enum, LogLevel
LogLevel -> LogLevel -> Bounded LogLevel
forall a. a -> a -> Bounded a
maxBound :: LogLevel
$cmaxBound :: LogLevel
minBound :: LogLevel
$cminBound :: LogLevel
Bounded)

-- | An arbitrary sink into which log messages may be passed.
newtype LogSink = LogSink { LogSink -> String -> IO ()
runSink :: String -> IO () }

-- | Very simple logger handle.
data Logger = Logger
    { Logger -> LogLevel
loggerLevel :: LogLevel
    , Logger -> LogSink
loggerSink  :: LogSink
    }

-- | Emit a message to the sink specified by 'Logger' if the provided
-- 'Loglevel' is more severe than the configured one.
emitLog :: Logger -> LogLevel -> String -> IO ()
emitLog :: Logger -> LogLevel -> String -> IO ()
emitLog Logger{LogLevel
loggerLevel :: LogLevel
loggerLevel :: Logger -> LogLevel
loggerLevel, LogSink
loggerSink :: LogSink
loggerSink :: Logger -> LogSink
loggerSink} LogLevel
messageLevel String
message
    | LogLevel
loggerLevel LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= LogLevel
messageLevel = LogSink -> String -> IO ()
runSink LogSink
loggerSink (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s %s" (LogLevel -> String
forall a. Show a => a -> String
show LogLevel
messageLevel) String
message
    | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | A 'LogSink' which writes to the @stderr@ stream.
stderrSink :: LogSink
stderrSink :: LogSink
stderrSink = (String -> IO ()) -> LogSink
LogSink ((String -> IO ()) -> LogSink) -> (String -> IO ()) -> LogSink
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr