{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
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)
data Verbosity
=
Debug
|
Info
|
Warning
|
Error
|
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)
data LogSink
=
StdErr
|
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)
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 ()
}
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
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
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."