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

-- |

-- Module      : $header$

-- Copyright   : (c) Laurent P René de Cotret, 2019 - 2021

-- 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 (FromJSON (parseJSON), Value (String))
import System.IO (IOMode (AppendMode), stderr, withFile)

-- | Verbosity of the logger.

data Verbosity
  = -- | Log all messages, including debug messages.

    Debug
  | -- | Log information, warning, and error messages.

    Info
  | -- | Log warning and error messages.

    Warning
  | -- | Only log errors.

    Error
  | -- | Don't log anything.

    Silent
  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
  = -- | Standard error stream.

    StdErr
  | -- | Appended to file.

    LogFile FilePath
  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."