module Hakyll.Core.Logger
( Verbosity (..)
, Logger
, new
, flush
, error
, header
, message
, debug
) where
import Control.Concurrent (forkIO)
import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)
import Control.Monad (forever)
import Control.Monad.Trans (MonadIO, liftIO)
import Data.List (intercalate)
import Prelude hiding (error)
data Verbosity
= Error
| Message
| Debug
deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Eq Verbosity
Eq Verbosity =>
(Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
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 :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show)
data Logger = Logger
{ Logger -> Chan (Maybe String)
loggerChan :: Chan (Maybe String)
, Logger -> MVar ()
loggerSync :: MVar ()
, Logger -> String -> IO ()
loggerSink :: String -> IO ()
, Logger -> Verbosity
loggerVerbosity :: Verbosity
}
new :: Verbosity -> IO Logger
new :: Verbosity -> IO Logger
new vbty :: Verbosity
vbty = do
Logger
logger <- Chan (Maybe String)
-> MVar () -> (String -> IO ()) -> Verbosity -> Logger
Logger (Chan (Maybe String)
-> MVar () -> (String -> IO ()) -> Verbosity -> Logger)
-> IO (Chan (Maybe String))
-> IO (MVar () -> (String -> IO ()) -> Verbosity -> Logger)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
IO (Chan (Maybe String))
forall a. IO (Chan a)
newChan IO (MVar () -> (String -> IO ()) -> Verbosity -> Logger)
-> IO (MVar ()) -> IO ((String -> IO ()) -> Verbosity -> Logger)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar IO ((String -> IO ()) -> Verbosity -> Logger)
-> IO (String -> IO ()) -> IO (Verbosity -> Logger)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> IO ()) -> IO (String -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure String -> IO ()
putStrLn IO (Verbosity -> Logger) -> IO Verbosity -> IO Logger
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Verbosity -> IO Verbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
vbty
ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Logger -> IO ()
forall b. Logger -> IO b
loggerThread Logger
logger
Logger -> IO Logger
forall (m :: * -> *) a. Monad m => a -> m a
return Logger
logger
where
loggerThread :: Logger -> IO b
loggerThread logger :: Logger
logger = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
Maybe String
msg <- Chan (Maybe String) -> IO (Maybe String)
forall a. Chan a -> IO a
readChan (Chan (Maybe String) -> IO (Maybe String))
-> Chan (Maybe String) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ Logger -> Chan (Maybe String)
loggerChan Logger
logger
case Maybe String
msg of
Nothing -> MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Logger -> MVar ()
loggerSync Logger
logger) ()
Just m :: String
m -> Logger -> String -> IO ()
loggerSink Logger
logger String
m
flush :: Logger -> IO ()
flush :: Logger -> IO ()
flush logger :: Logger
logger = do
Chan (Maybe String) -> Maybe String -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (Logger -> Chan (Maybe String)
loggerChan Logger
logger) Maybe String
forall a. Maybe a
Nothing
() <- MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar (MVar () -> IO ()) -> MVar () -> IO ()
forall a b. (a -> b) -> a -> b
$ Logger -> MVar ()
loggerSync Logger
logger
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
string :: MonadIO m
=> Logger
-> Verbosity
-> String
-> m ()
string :: Logger -> Verbosity -> String -> m ()
string l :: Logger
l v :: Verbosity
v m :: String
m
| Logger -> Verbosity
loggerVerbosity Logger
l Verbosity -> Verbosity -> Bool
forall a. Ord a => a -> a -> Bool
>= Verbosity
v = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Chan (Maybe String) -> Maybe String -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (Logger -> Chan (Maybe String)
loggerChan Logger
l) (String -> Maybe String
forall a. a -> Maybe a
Just String
m)
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
error :: MonadIO m => Logger -> String -> m ()
error :: Logger -> String -> m ()
error l :: Logger
l m :: String
m = Logger -> Verbosity -> String -> m ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Verbosity -> String -> m ()
string Logger
l Verbosity
Error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ " [ERROR] " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
indent String
m
header :: MonadIO m => Logger -> String -> m ()
l :: Logger
l = Logger -> Verbosity -> String -> m ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Verbosity -> String -> m ()
string Logger
l Verbosity
Message
message :: MonadIO m => Logger -> String -> m ()
message :: Logger -> String -> m ()
message l :: Logger
l m :: String
m = Logger -> Verbosity -> String -> m ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Verbosity -> String -> m ()
string Logger
l Verbosity
Message (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ " " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
indent String
m
debug :: MonadIO m => Logger -> String -> m ()
debug :: Logger -> String -> m ()
debug l :: Logger
l m :: String
m = Logger -> Verbosity -> String -> m ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Verbosity -> String -> m ()
string Logger
l Verbosity
Debug (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ " [DEBUG] " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
indent String
m
indent :: String -> String
indent :: ShowS
indent = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n " ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines