{-# LANGUAGE UndecidableInstances #-}

module Mensam.Server.Application.LoggerCustom where

import Mensam.Server.Application.Environment.Class
import Mensam.Server.Application.LoggerCustom.Class

import Control.Monad.Catch
import Control.Monad.Logger.CallStack
import Control.Monad.Logger.OrphanInstances ()
import Control.Monad.Reader.Class
import Control.Monad.Trans
import Control.Monad.Trans.Compose
import Control.Monad.Trans.Control
import Control.Monad.Trans.Control.Identity
import Control.Monad.Trans.Reader qualified as T
import Data.ByteString.Char8 qualified as B
import Data.Foldable
import Data.Kind
import Data.List qualified as L
import Data.Maybe qualified as M
import Data.Text qualified as T
import Data.Time qualified as T
import Data.Time.Format.ISO8601 qualified as T
import System.IO

type CustomLoggingT :: (Type -> Type) -> Type -> Type
newtype CustomLoggingT m a = CustomLoggingT {forall (m :: * -> *) a.
CustomLoggingT m a -> ComposeT (ReaderT Bool) LoggingT m a
unCustomLoggingT :: ComposeT (T.ReaderT Bool) LoggingT m a}
  deriving newtype (Functor (CustomLoggingT m)
Functor (CustomLoggingT m) =>
(forall a. a -> CustomLoggingT m a)
-> (forall a b.
    CustomLoggingT m (a -> b)
    -> CustomLoggingT m a -> CustomLoggingT m b)
-> (forall a b c.
    (a -> b -> c)
    -> CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m c)
-> (forall a b.
    CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b)
-> (forall a b.
    CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m a)
-> Applicative (CustomLoggingT m)
forall a. a -> CustomLoggingT m a
forall a b.
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m a
forall a b.
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b
forall a b.
CustomLoggingT m (a -> b)
-> CustomLoggingT m a -> CustomLoggingT m b
forall a b c.
(a -> b -> c)
-> CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (CustomLoggingT m)
forall (m :: * -> *) a. Applicative m => a -> CustomLoggingT m a
forall (m :: * -> *) a b.
Applicative m =>
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m a
forall (m :: * -> *) a b.
Applicative m =>
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b
forall (m :: * -> *) a b.
Applicative m =>
CustomLoggingT m (a -> b)
-> CustomLoggingT m a -> CustomLoggingT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> CustomLoggingT m a
pure :: forall a. a -> CustomLoggingT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
CustomLoggingT m (a -> b)
-> CustomLoggingT m a -> CustomLoggingT m b
<*> :: forall a b.
CustomLoggingT m (a -> b)
-> CustomLoggingT m a -> CustomLoggingT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b
*> :: forall a b.
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m a
<* :: forall a b.
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m a
Applicative, (forall a b. (a -> b) -> CustomLoggingT m a -> CustomLoggingT m b)
-> (forall a b. a -> CustomLoggingT m b -> CustomLoggingT m a)
-> Functor (CustomLoggingT m)
forall a b. a -> CustomLoggingT m b -> CustomLoggingT m a
forall a b. (a -> b) -> CustomLoggingT m a -> CustomLoggingT m b
forall (m :: * -> *) a b.
Functor m =>
a -> CustomLoggingT m b -> CustomLoggingT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CustomLoggingT m a -> CustomLoggingT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CustomLoggingT m a -> CustomLoggingT m b
fmap :: forall a b. (a -> b) -> CustomLoggingT m a -> CustomLoggingT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> CustomLoggingT m b -> CustomLoggingT m a
<$ :: forall a b. a -> CustomLoggingT m b -> CustomLoggingT m a
Functor, Applicative (CustomLoggingT m)
Applicative (CustomLoggingT m) =>
(forall a b.
 CustomLoggingT m a
 -> (a -> CustomLoggingT m b) -> CustomLoggingT m b)
-> (forall a b.
    CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b)
-> (forall a. a -> CustomLoggingT m a)
-> Monad (CustomLoggingT m)
forall a. a -> CustomLoggingT m a
forall a b.
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b
forall a b.
CustomLoggingT m a
-> (a -> CustomLoggingT m b) -> CustomLoggingT m b
forall (m :: * -> *). Monad m => Applicative (CustomLoggingT m)
forall (m :: * -> *) a. Monad m => a -> CustomLoggingT m a
forall (m :: * -> *) a b.
Monad m =>
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b
forall (m :: * -> *) a b.
Monad m =>
CustomLoggingT m a
-> (a -> CustomLoggingT m b) -> CustomLoggingT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CustomLoggingT m a
-> (a -> CustomLoggingT m b) -> CustomLoggingT m b
>>= :: forall a b.
CustomLoggingT m a
-> (a -> CustomLoggingT m b) -> CustomLoggingT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b
>> :: forall a b.
CustomLoggingT m a -> CustomLoggingT m b -> CustomLoggingT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> CustomLoggingT m a
return :: forall a. a -> CustomLoggingT m a
Monad)
  deriving newtype ((forall (m :: * -> *). Monad m => Monad (CustomLoggingT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> CustomLoggingT m a)
-> MonadTrans CustomLoggingT
forall (m :: * -> *). Monad m => Monad (CustomLoggingT m)
forall (m :: * -> *) a. Monad m => m a -> CustomLoggingT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> CustomLoggingT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> CustomLoggingT m a
MonadTrans, MonadTrans CustomLoggingT
MonadTrans CustomLoggingT =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run CustomLoggingT -> m a) -> CustomLoggingT m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT CustomLoggingT a) -> CustomLoggingT m a)
-> MonadTransControl CustomLoggingT
forall (m :: * -> *) a.
Monad m =>
m (StT CustomLoggingT a) -> CustomLoggingT m a
forall (m :: * -> *) a.
Monad m =>
(Run CustomLoggingT -> m a) -> CustomLoggingT m a
forall (t :: (* -> *) -> * -> *).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run CustomLoggingT -> m a) -> CustomLoggingT m a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run CustomLoggingT -> m a) -> CustomLoggingT m a
$crestoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT CustomLoggingT a) -> CustomLoggingT m a
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT CustomLoggingT a) -> CustomLoggingT m a
MonadTransControl, MonadTransControl CustomLoggingT
MonadTransControl CustomLoggingT =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. CustomLoggingT m x -> m x) -> m a)
 -> CustomLoggingT m a)
-> MonadTransControlIdentity CustomLoggingT
forall (m :: * -> *) a.
Monad m =>
((forall x. CustomLoggingT m x -> m x) -> m a)
-> CustomLoggingT m a
forall (t :: (* -> *) -> * -> *).
MonadTransControl t =>
(forall (m :: * -> *) a.
 Monad m =>
 ((forall x. t m x -> m x) -> m a) -> t m a)
-> MonadTransControlIdentity t
$cliftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. CustomLoggingT m x -> m x) -> m a)
-> CustomLoggingT m a
liftWithIdentity :: forall (m :: * -> *) a.
Monad m =>
((forall x. CustomLoggingT m x -> m x) -> m a)
-> CustomLoggingT m a
MonadTransControlIdentity)

instance MonadIO m => MonadLogger (CustomLoggingT m) where
  monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> CustomLoggingT m ()
monadLoggerLog Loc
loc LogSource
logSource LogLevel
logLevel msg
logStr = do
    UTCTime
time <- m UTCTime -> CustomLoggingT m UTCTime
forall (m :: * -> *) a. Monad m => m a -> CustomLoggingT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m UTCTime -> CustomLoggingT m UTCTime)
-> m UTCTime -> CustomLoggingT m UTCTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
T.getCurrentTime
    let timeInfo :: String
timeInfo = UTCTime -> String
forall t. ISO8601 t => t -> String
T.iso8601Show UTCTime
time
    Bool
logColorCapability <- CustomLoggingT m Bool
forall (m :: * -> *). MonadLoggerCustom m => m Bool
colorfulLogCapability
    ComposeT (ReaderT Bool) LoggingT m () -> CustomLoggingT m ()
forall (m :: * -> *) a.
ComposeT (ReaderT Bool) LoggingT m a -> CustomLoggingT m a
CustomLoggingT (ComposeT (ReaderT Bool) LoggingT m () -> CustomLoggingT m ())
-> (LogStr -> ComposeT (ReaderT Bool) LoggingT m ())
-> LogStr
-> CustomLoggingT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc
-> LogSource
-> LogLevel
-> LogStr
-> ComposeT (ReaderT Bool) LoggingT m ()
forall msg.
ToLogStr msg =>
Loc
-> LogSource
-> LogLevel
-> msg
-> ComposeT (ReaderT Bool) LoggingT m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> m ()
monadLoggerLog Loc
loc LogSource
logSource LogLevel
logLevel (LogStr -> CustomLoggingT m ()) -> LogStr -> CustomLoggingT m ()
forall a b. (a -> b) -> a -> b
$
      Bool -> LogStrWithFontEffects -> LogStr
renderLogStrWithFontEffectsUnsafe Bool
logColorCapability (LogStrWithFontEffects -> LogStr)
-> LogStrWithFontEffects -> LogStr
forall a b. (a -> b) -> a -> b
$
        [LogStrWithFontEffects] -> LogStrWithFontEffects
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
          [ FontEffects -> LogStr -> LogStrWithFontEffects
withFontEffects ([Int] -> FontEffects
MkFontEffects [Int
2, Int
94]) (LogStr -> LogStrWithFontEffects)
-> LogStr -> LogStrWithFontEffects
forall a b. (a -> b) -> a -> b
$ LogStr
"@{" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> String -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr String
timeInfo LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"}"
          , LogStrWithFontEffects
" "
          , LogStr -> LogStrWithFontEffects
withoutFontEffects (LogStr -> LogStrWithFontEffects)
-> LogStr -> LogStrWithFontEffects
forall a b. (a -> b) -> a -> b
$ msg -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr msg
logStr
          ]

deriving via
  CustomLoggingT ((t2 :: (Type -> Type) -> Type -> Type) m)
  instance
    MonadIO (t2 m) => MonadLogger (ComposeT CustomLoggingT t2 m)

instance MonadIO m => MonadLoggerCustom (CustomLoggingT m) where
  colorfulLogCapability :: CustomLoggingT m Bool
colorfulLogCapability = ComposeT (ReaderT Bool) LoggingT m Bool -> CustomLoggingT m Bool
forall (m :: * -> *) a.
ComposeT (ReaderT Bool) LoggingT m a -> CustomLoggingT m a
CustomLoggingT ComposeT (ReaderT Bool) LoggingT m Bool
forall r (m :: * -> *). MonadReader r m => m r
ask

deriving via
  CustomLoggingT ((t2 :: (Type -> Type) -> Type -> Type) m)
  instance
    MonadIO (t2 m) => MonadLoggerCustom (ComposeT CustomLoggingT t2 m)

runCustomLoggingT ::
  forall m a.
  (MonadIO m, MonadMask m) =>
  Maybe FilePath ->
  LogLevel ->
  -- | color
  Bool ->
  CustomLoggingT m a ->
  m a
runCustomLoggingT :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Maybe String -> LogLevel -> Bool -> CustomLoggingT m a -> m a
runCustomLoggingT Maybe String
maybeFilePath LogLevel
configuredLogLevel Bool
configuredLogColor = LoggingT m a -> m a
run (LoggingT m a -> m a)
-> (CustomLoggingT m a -> LoggingT m a)
-> CustomLoggingT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggingT m a -> LoggingT m a
withFilter (LoggingT m a -> LoggingT m a)
-> (CustomLoggingT m a -> LoggingT m a)
-> CustomLoggingT m a
-> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Bool (LoggingT m) a -> Bool -> LoggingT m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`T.runReaderT` Bool
configuredLogColor) (ReaderT Bool (LoggingT m) a -> LoggingT m a)
-> (CustomLoggingT m a -> ReaderT Bool (LoggingT m) a)
-> CustomLoggingT m a
-> LoggingT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComposeT (ReaderT Bool) LoggingT m a -> ReaderT Bool (LoggingT m) a
forall (t1 :: (* -> *) -> * -> *) (t2 :: (* -> *) -> * -> *)
       (m :: * -> *) a.
ComposeT t1 t2 m a -> t1 (t2 m) a
deComposeT (ComposeT (ReaderT Bool) LoggingT m a
 -> ReaderT Bool (LoggingT m) a)
-> (CustomLoggingT m a -> ComposeT (ReaderT Bool) LoggingT m a)
-> CustomLoggingT m a
-> ReaderT Bool (LoggingT m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomLoggingT m a -> ComposeT (ReaderT Bool) LoggingT m a
forall (m :: * -> *) a.
CustomLoggingT m a -> ComposeT (ReaderT Bool) LoggingT m a
unCustomLoggingT
 where
  run :: LoggingT m a -> m a
run = (LoggingT m a -> m a)
-> (String -> LoggingT m a -> m a)
-> Maybe String
-> LoggingT m a
-> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LoggingT m a -> m a
runStdoutLoggingTCustom String -> LoggingT m a -> m a
runFileLoggingTCustom Maybe String
maybeFilePath
  withFilter :: LoggingT m a -> LoggingT m a
withFilter = (LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
forall (m :: * -> *) a.
(LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger ((LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a)
-> (LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
forall a b. (a -> b) -> a -> b
$ \LogSource
_src LogLevel
lvl -> LogLevel
lvl LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= LogLevel
configuredLogLevel
  runStdoutLoggingTCustom :: LoggingT m a -> m a
  runStdoutLoggingTCustom :: LoggingT m a -> m a
runStdoutLoggingTCustom = (LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
`runLoggingT` Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
withOutputHandle Handle
stdout)
  runFileLoggingTCustom :: FilePath -> LoggingT m a -> m a
  runFileLoggingTCustom :: String -> LoggingT m a -> m a
runFileLoggingTCustom String
file LoggingT m a
tma = m Handle -> (Handle -> m ()) -> (Handle -> m a) -> m a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket
    (IO Handle -> m Handle
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Handle -> m Handle) -> IO Handle -> m Handle
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> IO Handle
openFile String
file IOMode
AppendMode)
    (IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Handle -> IO ()) -> Handle -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> IO ()
hClose)
    ((Handle -> m a) -> m a) -> (Handle -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
      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
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
      LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
forall (m :: * -> *) a.
LoggingT m a
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT LoggingT m a
tma (Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
withOutputHandle Handle
h)
  withOutputHandle :: Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
  withOutputHandle :: Handle -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
withOutputHandle Handle
h Loc
loc LogSource
src LogLevel
lvl LogStr
msg = Handle -> ByteString -> IO ()
B.hPutStr Handle
h (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Loc -> LogSource -> LogLevel -> LogStr -> ByteString
logStrBS Loc
loc LogSource
src LogLevel
lvl LogStr
msg
  logStrBS :: Loc -> LogSource -> LogLevel -> LogStr -> B.ByteString
  logStrBS :: Loc -> LogSource -> LogLevel -> LogStr -> ByteString
logStrBS Loc
loc LogSource
src LogLevel
lvl LogStr
msg = LogStr -> ByteString
fromLogStr (LogStr -> ByteString) -> LogStr -> ByteString
forall a b. (a -> b) -> a -> b
$ Loc -> LogSource -> LogLevel -> LogStr -> LogStr
logStr Loc
loc LogSource
src LogLevel
lvl LogStr
msg
  logStr :: Loc -> LogSource -> LogLevel -> LogStr -> LogStr
  logStr :: Loc -> LogSource -> LogLevel -> LogStr -> LogStr
logStr Loc
loc LogSource
src LogLevel
lvl LogStr
msg =
    (LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n") (LogStr -> LogStr) -> LogStr -> LogStr
forall a b. (a -> b) -> a -> b
$
      Bool -> LogStrWithFontEffects -> LogStr
renderLogStrWithFontEffectsUnsafe Bool
configuredLogColor (LogStrWithFontEffects -> LogStr)
-> LogStrWithFontEffects -> LogStr
forall a b. (a -> b) -> a -> b
$
        [LogStrWithFontEffects] -> LogStrWithFontEffects
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([LogStrWithFontEffects] -> LogStrWithFontEffects)
-> [LogStrWithFontEffects] -> LogStrWithFontEffects
forall a b. (a -> b) -> a -> b
$
          LogStrWithFontEffects
-> [LogStrWithFontEffects] -> [LogStrWithFontEffects]
forall a. a -> [a] -> [a]
L.intersperse LogStrWithFontEffects
" " ([LogStrWithFontEffects] -> [LogStrWithFontEffects])
-> [LogStrWithFontEffects] -> [LogStrWithFontEffects]
forall a b. (a -> b) -> a -> b
$
            [Maybe LogStrWithFontEffects] -> [LogStrWithFontEffects]
forall a. [Maybe a] -> [a]
M.catMaybes
              [ LogStrWithFontEffects -> Maybe LogStrWithFontEffects
forall a. a -> Maybe a
Just (LogStrWithFontEffects -> Maybe LogStrWithFontEffects)
-> LogStrWithFontEffects -> Maybe LogStrWithFontEffects
forall a b. (a -> b) -> a -> b
$ FontEffects -> LogStr -> LogStrWithFontEffects
withFontEffects (LogLevel -> FontEffects
levelColor LogLevel
lvl) (LogStr -> LogStrWithFontEffects)
-> LogStr -> LogStrWithFontEffects
forall a b. (a -> b) -> a -> b
$ LogLevel -> LogSource -> LogStr
levelLogStr LogLevel
lvl LogSource
src
              , LogStrWithFontEffects -> Maybe LogStrWithFontEffects
forall a. a -> Maybe a
Just (LogStrWithFontEffects -> Maybe LogStrWithFontEffects)
-> LogStrWithFontEffects -> Maybe LogStrWithFontEffects
forall a b. (a -> b) -> a -> b
$ LogStr -> LogStrWithFontEffects
withoutFontEffects LogStr
msg
              , FontEffects -> LogStr -> LogStrWithFontEffects
withFontEffects ([Int] -> FontEffects
MkFontEffects [Int
2, Int
34]) (LogStr -> LogStrWithFontEffects)
-> Maybe LogStr -> Maybe LogStrWithFontEffects
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Loc -> Maybe LogStr
locLogStr Loc
loc
              ]
  levelLogStr :: LogLevel -> LogSource -> LogStr
  levelLogStr :: LogLevel -> LogSource -> LogStr
levelLogStr LogLevel
level LogSource
source =
    [LogStr] -> LogStr
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
      [ LogStr
"["
      , case LogLevel
level of
          LevelOther LogSource
otherLevelAsText -> LogSource -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr LogSource
otherLevelAsText
          LogLevel
_ -> ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> LogStr) -> ByteString -> LogStr
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
5 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ LogLevel -> String
forall a. Show a => a -> String
show LogLevel
level
      , if LogSource -> Bool
T.null LogSource
source
          then LogStr
forall a. Monoid a => a
mempty
          else LogStr
"#" LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogSource -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr LogSource
source
      , LogStr
"]"
      ]
  locLogStr :: Loc -> Maybe LogStr
  locLogStr :: Loc -> Maybe LogStr
locLogStr Loc
location =
    if Loc
location Loc -> Loc -> Bool
forall a. Eq a => a -> a -> Bool
== Loc
defaultLoc
      then Maybe LogStr
forall a. Maybe a
Nothing
      else
        LogStr -> Maybe LogStr
forall a. a -> Maybe a
Just (LogStr -> Maybe LogStr) -> LogStr -> Maybe LogStr
forall a b. (a -> b) -> a -> b
$
          [LogStr] -> LogStr
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
            [ LogStr
"@("
            , ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> LogStr) -> ByteString -> LogStr
forall a b. (a -> b) -> a -> b
$
                String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
                    [ Loc -> String
loc_package Loc
location
                    , Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: Loc -> String
loc_module Loc
location
                    , Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: Loc -> String
loc_filename Loc
location
                    , Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Loc -> Int) -> Loc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Loc -> (Int, Int)) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> (Int, Int)
loc_start) Loc
location
                    , Char
':' Char -> String -> String
forall a. a -> [a] -> [a]
: (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Loc -> Int) -> Loc -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Loc -> (Int, Int)) -> Loc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Loc -> (Int, Int)
loc_start) Loc
location
                    ]
            , LogStr
")"
            ]
  levelColor :: LogLevel -> FontEffects
  levelColor :: LogLevel -> FontEffects
levelColor = \case
    LogLevel
LevelDebug -> [Int] -> FontEffects
MkFontEffects [Int
36]
    LogLevel
LevelInfo -> [Int] -> FontEffects
MkFontEffects [Int
32]
    LogLevel
LevelWarn -> [Int] -> FontEffects
MkFontEffects [Int
33]
    LogLevel
LevelError -> [Int] -> FontEffects
MkFontEffects [Int
31]
    LevelOther LogSource
_ -> [Int] -> FontEffects
MkFontEffects [Int
35]

runAppCustomLoggingT :: (MonadEnvironment m, MonadIO m, MonadMask m) => CustomLoggingT m a -> m a
runAppCustomLoggingT :: forall (m :: * -> *) a.
(MonadEnvironment m, MonadIO m, MonadMask m) =>
CustomLoggingT m a -> m a
runAppCustomLoggingT CustomLoggingT m a
tma = do
  Maybe String
maybeLogFile <- ProxyEnvVarName (EnvVarName 'EnvVarLogFile)
-> m (EnvVarValue 'EnvVarLogFile)
forall (envVar :: EnvVar).
SingI envVar =>
ProxyEnvVarName (EnvVarName envVar) -> m (EnvVarValue envVar)
forall (m :: * -> *) (envVar :: EnvVar).
(MonadEnvironment m, SingI envVar) =>
ProxyEnvVarName (EnvVarName envVar) -> m (EnvVarValue envVar)
environmentVariable (ProxyEnvVarName (EnvVarName 'EnvVarLogFile)
 -> m (EnvVarValue 'EnvVarLogFile))
-> ProxyEnvVarName (EnvVarName 'EnvVarLogFile)
-> m (EnvVarValue 'EnvVarLogFile)
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol). ProxyEnvVarName name
EnvVar @"MENSAM_LOG_FILE"
  LogLevel
logLevel <- ProxyEnvVarName (EnvVarName 'EnvVarLogLevel)
-> m (EnvVarValue 'EnvVarLogLevel)
forall (envVar :: EnvVar).
SingI envVar =>
ProxyEnvVarName (EnvVarName envVar) -> m (EnvVarValue envVar)
forall (m :: * -> *) (envVar :: EnvVar).
(MonadEnvironment m, SingI envVar) =>
ProxyEnvVarName (EnvVarName envVar) -> m (EnvVarValue envVar)
environmentVariable (ProxyEnvVarName (EnvVarName 'EnvVarLogLevel)
 -> m (EnvVarValue 'EnvVarLogLevel))
-> ProxyEnvVarName (EnvVarName 'EnvVarLogLevel)
-> m (EnvVarValue 'EnvVarLogLevel)
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol). ProxyEnvVarName name
EnvVar @"MENSAM_LOG_LEVEL"
  Bool
logColor <- ProxyEnvVarName (EnvVarName 'EnvVarLogColor)
-> m (EnvVarValue 'EnvVarLogColor)
forall (envVar :: EnvVar).
SingI envVar =>
ProxyEnvVarName (EnvVarName envVar) -> m (EnvVarValue envVar)
forall (m :: * -> *) (envVar :: EnvVar).
(MonadEnvironment m, SingI envVar) =>
ProxyEnvVarName (EnvVarName envVar) -> m (EnvVarValue envVar)
environmentVariable (ProxyEnvVarName (EnvVarName 'EnvVarLogColor)
 -> m (EnvVarValue 'EnvVarLogColor))
-> ProxyEnvVarName (EnvVarName 'EnvVarLogColor)
-> m (EnvVarValue 'EnvVarLogColor)
forall a b. (a -> b) -> a -> b
$ forall (name :: Symbol). ProxyEnvVarName name
EnvVar @"MENSAM_LOG_COLOR"
  Maybe String -> LogLevel -> Bool -> CustomLoggingT m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Maybe String -> LogLevel -> Bool -> CustomLoggingT m a -> m a
runCustomLoggingT Maybe String
maybeLogFile LogLevel
logLevel Bool
logColor CustomLoggingT m a
tma

logLine ::
  MonadLogger m =>
  LogLine ->
  m ()
logLine :: forall (m :: * -> *). MonadLogger m => LogLine -> m ()
logLine (Loc
loc, LogSource
logSource, LogLevel
logLevel, LogStr
logStr) = Loc -> LogSource -> LogLevel -> LogStr -> m ()
forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> m ()
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> m ()
monadLoggerLog Loc
loc LogSource
logSource LogLevel
logLevel LogStr
logStr