{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

{-|
Module      : $header$
Copyright   : (c) Laurent P René de Cotret, 2020
License     : GNU GPL, version 2 or above
Maintainer  : laurent.decotret@outlook.com
Stability   : internal
Portability : portable

Logging primitives.
-}

module Text.Pandoc.Filter.Plot.Monad.Logging 
    ( Verbosity(..)
    , LogSink(..)
    , Logger(..)
    , withLogger
    ) 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           Data.Char                    (toLower)
import           Data.List                    (intercalate)
import           Data.String                  (IsString(..))
import           Data.Text                    (Text, unpack)
import           Data.Text.IO                 (hPutStr)
import           Data.Yaml

import           System.IO                    (stderr, withFile, IOMode (AppendMode) )



-- | Verbosity of the logger.

data Verbosity = Debug    -- ^ Log all messages, including debug messages.

               | Info     -- ^ Log information, warning, and error messages.

               | Warning  -- ^ Log warning and error messages.

               | Error    -- ^ Only log errors.

               | Silent   -- ^ Don't log anything. 

               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, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
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 :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum, Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded)


-- | Description of the possible ways to sink log messages.

data LogSink = StdErr           -- ^ Standard error stream.

             | LogFile FilePath -- ^ Appended to file.

             deriving (LogSink -> LogSink -> Bool
(LogSink -> LogSink -> Bool)
-> (LogSink -> LogSink -> Bool) -> Eq LogSink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogSink -> LogSink -> Bool
$c/= :: LogSink -> LogSink -> Bool
== :: LogSink -> LogSink -> Bool
$c== :: LogSink -> LogSink -> Bool
Eq, Int -> LogSink -> ShowS
[LogSink] -> ShowS
LogSink -> String
(Int -> LogSink -> ShowS)
-> (LogSink -> String) -> ([LogSink] -> ShowS) -> Show LogSink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogSink] -> ShowS
$cshowList :: [LogSink] -> ShowS
show :: LogSink -> String
$cshow :: LogSink -> String
showsPrec :: Int -> LogSink -> ShowS
$cshowsPrec :: Int -> LogSink -> ShowS
Show)


-- | The logging implementation is very similar to Hakyll's.

data Logger = Logger
    { Logger -> Verbosity
lVerbosity :: Verbosity
    , Logger -> Chan (Maybe Text)
lChannel   :: Chan (Maybe Text)
    , Logger -> Text -> IO ()
lSink      :: Text -> IO ()
    , Logger -> MVar ()
lSync      :: MVar ()
    }


-- | Perform an IO action with a logger. Using this function

-- ensures that logging will be gracefully shut down.

withLogger :: Verbosity -> LogSink -> (Logger -> IO a) -> IO a
withLogger :: Verbosity -> LogSink -> (Logger -> IO a) -> IO a
withLogger Verbosity
v LogSink
s Logger -> IO a
f = do
    Logger
logger <- Verbosity
-> Chan (Maybe Text) -> (Text -> IO ()) -> MVar () -> Logger
Logger (Verbosity
 -> Chan (Maybe Text) -> (Text -> IO ()) -> MVar () -> Logger)
-> IO Verbosity
-> IO (Chan (Maybe Text) -> (Text -> IO ()) -> MVar () -> Logger)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> IO Verbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure Verbosity
v
                     IO (Chan (Maybe Text) -> (Text -> IO ()) -> MVar () -> Logger)
-> IO (Chan (Maybe Text))
-> IO ((Text -> IO ()) -> MVar () -> Logger)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Chan (Maybe Text))
forall a. IO (Chan a)
newChan
                     IO ((Text -> IO ()) -> MVar () -> Logger)
-> IO (Text -> IO ()) -> IO (MVar () -> Logger)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> IO ()) -> IO (Text -> IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LogSink -> Text -> IO ()
sink LogSink
s)
                     IO (MVar () -> Logger) -> IO (MVar ()) -> IO Logger
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar 

    -- The logger either logs messages (if Just "message"),

    -- or stops working on Nothing.

    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
$ 
            Chan (Maybe Text) -> IO (Maybe Text)
forall a. Chan a -> IO a
readChan (Logger -> Chan (Maybe Text)
lChannel Logger
logger) 
                IO (Maybe Text) -> (Maybe Text -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> (Text -> IO ()) -> Maybe Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Logger -> MVar ()
lSync Logger
logger) ()) (Logger -> Text -> IO ()
lSink Logger
logger)

    a
result <- Logger -> IO a
f Logger
logger
    
    -- Flushing the logger

    -- To signal to the logger that logging duties are over,

    -- we append Nothing to the channel, and wait for it to finish

    -- dealing with all items in the channel.

    Chan (Maybe Text) -> Maybe Text -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (Logger -> Chan (Maybe Text)
lChannel Logger
logger) Maybe Text
forall a. Maybe a
Nothing
    () <- MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar (Logger -> MVar ()
lSync Logger
logger)

    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

    where
        sink :: LogSink -> Text -> IO ()
sink LogSink
StdErr       = Handle -> Text -> IO ()
hPutStr Handle
stderr
        sink (LogFile String
fp) = \Text
t -> String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
fp IOMode
AppendMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Text -> IO ()
hPutStr Handle
h Text
t


instance IsString Verbosity where
    fromString :: String -> Verbosity
fromString String
s
        | String
ls String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"silent"  = Verbosity
Silent
        | String
ls String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"info"    = Verbosity
Info
        | String
ls String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"warning" = Verbosity
Warning
        | String
ls String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"error"   = Verbosity
Error
        | String
ls String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"debug"   = Verbosity
Debug
        | Bool
otherwise = String -> Verbosity
forall a. String -> a
errorWithoutStackTrace (String -> Verbosity) -> String -> Verbosity
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"Unrecognized verbosity '", String
s, String
"'. Valid choices are: " ] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
choices
        where
            ls :: String
ls = Char -> Char
toLower (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
s
            choices :: String
choices = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " 
                    ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Verbosity -> String) -> [Verbosity] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ShowS -> (Verbosity -> String) -> Verbosity -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> String
forall a. Show a => a -> String
show) 
                    ([Verbosity] -> [String]) -> [Verbosity] -> [String]
forall a b. (a -> b) -> a -> b
$ Verbosity -> Verbosity -> [Verbosity]
forall a. Enum a => a -> a -> [a]
enumFromTo Verbosity
forall a. Bounded a => a
minBound (Verbosity
forall a. Bounded a => a
maxBound::Verbosity)

instance FromJSON Verbosity where
    parseJSON :: Value -> Parser Verbosity
parseJSON (String Text
t) = Verbosity -> Parser Verbosity
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Verbosity -> Parser Verbosity) -> Verbosity -> Parser Verbosity
forall a b. (a -> b) -> a -> b
$ String -> Verbosity
forall a. IsString a => String -> a
fromString (String -> Verbosity) -> (Text -> String) -> Text -> Verbosity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Verbosity) -> Text -> Verbosity
forall a b. (a -> b) -> a -> b
$ Text
t
    parseJSON Value
_ = String -> Parser Verbosity
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Verbosity) -> String -> Parser Verbosity
forall a b. (a -> b) -> a -> b
$ String
"Could not parse the logging verbosity."