    --------------------------------------------------------------------------------
    -- | Produce pretty, thread-safe logs
    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)

    --------------------------------------------------------------------------------
    -- | Logger structure. Very complicated.
    data Logger = Logger
        { Logger -> Chan (Maybe String)
    loggerChan      :: Chan (Maybe String)  -- ^ Nothing marks the end
        , Logger -> MVar ()
    loggerSync      :: MVar ()              -- ^ Used for sync on quit
        , Logger -> String -> IO ()
    loggerSink      :: String -> IO ()      -- ^ Out sink
        , Logger -> Verbosity
    loggerVerbosity :: Verbosity            -- ^ Verbosity
        }

    --------------------------------------------------------------------------------
    -- | Create a new logger
    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
                -- Stop: sync
                Nothing -> MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar (Logger -> MVar ()
    loggerSync Logger
    logger) ()
                -- Print and continue
                Just m :: String
    m  -> Logger -> String -> IO ()
    loggerSink Logger
    logger String
    m

    --------------------------------------------------------------------------------
    -- | Flush the logger (blocks until flushed)
    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     -- ^ Logger
           -> Verbosity  -- ^ Verbosity of the string
           -> String     -- ^ Section name
           -> m ()       -- ^ No result
    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 ()
    header :: Logger -> String -> m ()
    header 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