    --------------------------------------------------------------------------------
    -- | Produce pretty, thread-safe logs
    {-# LANGUAGE Rank2Types #-}
    module Hakyll.Core.Logger
        ( Verbosity (..)
        , Logger
        , new
        , flush
        , error
        , header
        , message
        , debug

        -- * Testing utilities
        , newInMem
        ) where

    --------------------------------------------------------------------------------
    import           Control.Concurrent      (forkIO)
    import           Control.Concurrent.Chan (newChan, readChan, writeChan)
    import           Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
    import           Control.Monad           (forever, when)
    import           Control.Monad.Trans     (MonadIO, liftIO)
    import qualified Data.IORef              as IORef
    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
    $c== :: Verbosity -> Verbosity -> Bool
    == :: Verbosity -> Verbosity -> Bool
    $c/= :: Verbosity -> Verbosity -> Bool
    /= :: 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
    $ccompare :: Verbosity -> Verbosity -> Ordering
    compare :: Verbosity -> Verbosity -> Ordering
    $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
    >= :: Verbosity -> Verbosity -> Bool
    $cmax :: Verbosity -> Verbosity -> Verbosity
    max :: Verbosity -> Verbosity -> Verbosity
    $cmin :: Verbosity -> Verbosity -> Verbosity
    min :: Verbosity -> Verbosity -> 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
    $cshowsPrec :: Int -> Verbosity -> ShowS
    showsPrec :: Int -> Verbosity -> ShowS
    $cshow :: Verbosity -> String
    show :: Verbosity -> String
    $cshowList :: [Verbosity] -> ShowS
    showList :: [Verbosity] -> ShowS
    Show)

    --------------------------------------------------------------------------------
    data Logger = Logger
        { -- | Flush the logger (blocks until flushed)
          Logger -> forall (m :: * -> *). MonadIO m => m ()
    flush  :: forall m. MonadIO m => m ()
        , Logger
    -> forall (m :: * -> *). MonadIO m => Verbosity -> String -> m ()
    string :: forall m. MonadIO m => Verbosity -> String -> m ()
        }

    --------------------------------------------------------------------------------
    -- | Create a new logger
    new :: Verbosity -> IO Logger
    new :: Verbosity -> IO Logger
    new Verbosity
    vbty = do
        Chan (Maybe String)
    chan <- IO (Chan (Maybe String))
    forall a. IO (Chan a)
    newChan
        MVar ()
    sync <- IO (MVar ())
    forall a. IO (MVar a)
    newEmptyMVar
        ThreadId
    _    <- IO () -> IO ThreadId
    forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
    forall a b. (a -> b) -> a -> b
    $ IO () -> IO ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (IO () -> IO ()) -> IO () -> IO ()
    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)
    chan
            case Maybe String
    msg of
                -- Stop: sync
                Maybe String
    Nothing -> MVar () -> () -> IO ()
    forall a. MVar a -> a -> IO ()
    putMVar MVar ()
    sync ()
                -- Print and continue
                Just String
    m  -> String -> IO ()
    putStrLn String
    m
        Logger -> IO Logger
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Logger -> IO Logger) -> Logger -> IO Logger
    forall a b. (a -> b) -> a -> b
    $ Logger
            { flush :: forall (m :: * -> *). MonadIO m => m ()
    flush = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ do
                Chan (Maybe String) -> Maybe String -> IO ()
    forall a. Chan a -> a -> IO ()
    writeChan Chan (Maybe String)
    chan Maybe String
    forall a. Maybe a
    Nothing
                () <- MVar () -> IO ()
    forall a. MVar a -> IO a
    takeMVar MVar ()
    sync
                () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            , string :: forall (m :: * -> *). MonadIO m => Verbosity -> String -> m ()
    string = \Verbosity
    v String
    m -> Bool -> m () -> m ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Verbosity
    vbty Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Verbosity
    v) (m () -> m ()) -> m () -> m ()
    forall a b. (a -> b) -> a -> b
    $
                IO () -> m ()
    forall a. IO a -> m a
    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 Chan (Maybe String)
    chan (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    m)
            }

    --------------------------------------------------------------------------------
    error :: MonadIO m => Logger -> String -> m ()
    error :: forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    error Logger
    l String
    m = Logger
    -> forall (m :: * -> *). MonadIO m => Verbosity -> String -> m ()
    string Logger
    l Verbosity
    Error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "  [ERROR] " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    indent String
    m

    --------------------------------------------------------------------------------
    header :: MonadIO m => Logger -> String -> m ()
    header :: forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    header Logger
    l = Logger
    -> forall (m :: * -> *). MonadIO m => Verbosity -> String -> m ()
    string Logger
    l Verbosity
    Message

    --------------------------------------------------------------------------------
    message :: MonadIO m => Logger -> String -> m ()
    message :: forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    message Logger
    l String
    m = Logger
    -> forall (m :: * -> *). MonadIO m => Verbosity -> String -> m ()
    string Logger
    l Verbosity
    Message (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "  " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    indent String
    m

    --------------------------------------------------------------------------------
    debug :: MonadIO m => Logger -> String -> m ()
    debug :: forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
    debug Logger
    l String
    m = Logger
    -> forall (m :: * -> *). MonadIO m => Verbosity -> String -> m ()
    string Logger
    l Verbosity
    Debug (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "  [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 String
    "\n    " ([String] -> String) -> (String -> [String]) -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines

    --------------------------------------------------------------------------------
    -- | Create a new logger that just stores all the messages, useful for writing
    -- tests.
    newInMem :: IO (Logger, IO [(Verbosity, String)])
    newInMem :: IO (Logger, IO [(Verbosity, String)])
    newInMem = do
        IORef [(Verbosity, String)]
    ref <- [(Verbosity, String)] -> IO (IORef [(Verbosity, String)])
    forall a. a -> IO (IORef a)
    IORef.newIORef []
        (Logger, IO [(Verbosity, String)])
    -> IO (Logger, IO [(Verbosity, String)])
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
            ( Logger
                { string :: forall (m :: * -> *). MonadIO m => Verbosity -> String -> m ()
    string = \Verbosity
    vbty String
    msg -> IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> IO () -> m ()
    forall a b. (a -> b) -> a -> b
    $ IORef [(Verbosity, String)]
    -> ([(Verbosity, String)] -> ([(Verbosity, String)], ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    IORef.atomicModifyIORef' IORef [(Verbosity, String)]
    ref (([(Verbosity, String)] -> ([(Verbosity, String)], ())) -> IO ())
    -> ([(Verbosity, String)] -> ([(Verbosity, String)], ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                    \[(Verbosity, String)]
    msgs -> ((Verbosity
    vbty, String
    msg) (Verbosity, String)
    -> [(Verbosity, String)] -> [(Verbosity, String)]
    forall a. a -> [a] -> [a]
    : [(Verbosity, String)]
    msgs, ())
                , flush :: forall (m :: * -> *). MonadIO m => m ()
    flush  = () -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                }
            , [(Verbosity, String)] -> [(Verbosity, String)]
    forall a. [a] -> [a]
    reverse ([(Verbosity, String)] -> [(Verbosity, String)])
    -> IO [(Verbosity, String)] -> IO [(Verbosity, String)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef [(Verbosity, String)] -> IO [(Verbosity, String)]
    forall a. IORef a -> IO a
    IORef.readIORef IORef [(Verbosity, String)]
    ref
            )