-- | This modules contains support for logging.
--
-- @since 0.5.65
module B9.B9Logging
  ( Logger (..),
    CommandIO,
    LoggerReader,
    withLogger,
    b9Log,
    traceL,
    dbgL,
    infoL,
    errorL,
    errorExitL,
    printHash,
  )
where

import B9.B9Config
import B9.B9Error
import Control.Eff
import Control.Eff.Reader.Lazy
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
  ( MonadBaseControl,
    liftBaseWith,
    restoreM,
  )
import Data.Hashable
import Data.Maybe
import Data.Time.Clock
import Data.Time.Format
import qualified System.IO as SysIO
import Text.Printf

-- | The logger to write log messages to.
--
-- @since 0.5.65
newtype Logger
  = MkLogger
      { Logger -> Maybe Handle
logFileHandle :: Maybe SysIO.Handle
      }

-- | Effect that reads a 'Logger'.
--
-- @since 0.5.65
type LoggerReader = Reader Logger

-- | Lookup the selected 'getLogVerbosity' and '_logFile' from the 'B9Config'
-- and open it.
--
-- Then run the given action; if the action crashes, the log file will be closed.
--
-- @since 0.5.65
withLogger ::
  (MonadBaseControl IO (Eff e), MonadIO (Eff e), Member B9ConfigReader e) =>
  Eff (LoggerReader ': e) a ->
  Eff e a
withLogger :: Eff (LoggerReader : e) a -> Eff e a
withLogger Eff (LoggerReader : e) a
action = do
  Maybe FilePath
lf <- B9Config -> Maybe FilePath
_logFile (B9Config -> Maybe FilePath)
-> Eff e B9Config -> Eff e (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff e B9Config
forall (e :: [* -> *]). Member B9ConfigReader e => Eff e B9Config
getB9Config
  StM (Eff e) a
effState <- (RunInBase (Eff e) IO -> IO (StM (Eff e) a))
-> Eff e (StM (Eff e) a)
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase (Eff e) IO -> IO (StM (Eff e) a))
 -> Eff e (StM (Eff e) a))
-> (RunInBase (Eff e) IO -> IO (StM (Eff e) a))
-> Eff e (StM (Eff e) a)
forall a b. (a -> b) -> a -> b
$ \RunInBase (Eff e) IO
runInIO ->
    let fInIO :: Maybe Handle -> IO (StM (Eff e) a)
fInIO = Eff e a -> IO (StM (Eff e) a)
RunInBase (Eff e) IO
runInIO (Eff e a -> IO (StM (Eff e) a))
-> (Maybe Handle -> Eff e a) -> Maybe Handle -> IO (StM (Eff e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Logger -> Eff (LoggerReader : e) a -> Eff e a)
-> Eff (LoggerReader : e) a -> Logger -> Eff e a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Logger -> Eff (LoggerReader : e) a -> Eff e a
forall e (r :: [* -> *]) w. e -> Eff (Reader e : r) w -> Eff r w
runReader Eff (LoggerReader : e) a
action (Logger -> Eff e a)
-> (Maybe Handle -> Logger) -> Maybe Handle -> Eff e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Handle -> Logger
MkLogger
     in IO (StM (Eff e) a)
-> (FilePath -> IO (StM (Eff e) a))
-> Maybe FilePath
-> IO (StM (Eff e) a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (Maybe Handle -> IO (StM (Eff e) a)
fInIO Maybe Handle
forall a. Maybe a
Nothing)
          (\FilePath
logf -> FilePath
-> IOMode -> (Handle -> IO (StM (Eff e) a)) -> IO (StM (Eff e) a)
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
SysIO.withFile FilePath
logf IOMode
SysIO.AppendMode (Maybe Handle -> IO (StM (Eff e) a)
fInIO (Maybe Handle -> IO (StM (Eff e) a))
-> (Handle -> Maybe Handle) -> Handle -> IO (StM (Eff e) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Maybe Handle
forall a. a -> Maybe a
Just))
          Maybe FilePath
lf
  StM (Eff e) a -> Eff e a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM (Eff e) a
effState

-- | Convenience type alias for 'Eff'ects that have a 'B9Config', a 'Logger', 'MonadIO' and 'MonadBaseControl'.
--
-- @since 0.5.65
type CommandIO e =
  ( MonadBaseControl IO (Eff e),
    MonadIO (Eff e),
    Member LoggerReader e,
    Member B9ConfigReader e
  )

traceL :: CommandIO e => String -> Eff e ()
traceL :: FilePath -> Eff e ()
traceL = LogLevel -> FilePath -> Eff e ()
forall (e :: [* -> *]).
CommandIO e =>
LogLevel -> FilePath -> Eff e ()
b9Log LogLevel
LogTrace

dbgL :: CommandIO e => String -> Eff e ()
dbgL :: FilePath -> Eff e ()
dbgL = LogLevel -> FilePath -> Eff e ()
forall (e :: [* -> *]).
CommandIO e =>
LogLevel -> FilePath -> Eff e ()
b9Log LogLevel
LogDebug

infoL :: CommandIO e => String -> Eff e ()
infoL :: FilePath -> Eff e ()
infoL = LogLevel -> FilePath -> Eff e ()
forall (e :: [* -> *]).
CommandIO e =>
LogLevel -> FilePath -> Eff e ()
b9Log LogLevel
LogInfo

errorL :: CommandIO e => String -> Eff e ()
errorL :: FilePath -> Eff e ()
errorL = LogLevel -> FilePath -> Eff e ()
forall (e :: [* -> *]).
CommandIO e =>
LogLevel -> FilePath -> Eff e ()
b9Log LogLevel
LogError

errorExitL :: (CommandIO e, Member ExcB9 e) => String -> Eff e a
errorExitL :: FilePath -> Eff e a
errorExitL FilePath
e = LogLevel -> FilePath -> Eff e ()
forall (e :: [* -> *]).
CommandIO e =>
LogLevel -> FilePath -> Eff e ()
b9Log LogLevel
LogError FilePath
e Eff e () -> Eff e a -> Eff e a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> Eff e a
forall (e :: [* -> *]) a. Member ExcB9 e => FilePath -> Eff e a
throwB9Error FilePath
e

b9Log :: CommandIO e => LogLevel -> String -> Eff e ()
b9Log :: LogLevel -> FilePath -> Eff e ()
b9Log LogLevel
level FilePath
msg = do
  Maybe LogLevel
lv <- Eff e (Maybe LogLevel)
forall (e :: [* -> *]).
Member B9ConfigReader e =>
Eff e (Maybe LogLevel)
getLogVerbosity
  Maybe Handle
lfh <- Logger -> Maybe Handle
logFileHandle (Logger -> Maybe Handle) -> Eff e Logger -> Eff e (Maybe Handle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff e Logger
forall e (r :: [* -> *]). Member (Reader e) r => Eff r e
ask
  IO () -> Eff e ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Eff e ()) -> IO () -> Eff e ()
forall a b. (a -> b) -> a -> b
$ Maybe LogLevel -> Maybe Handle -> LogLevel -> FilePath -> IO ()
logImpl Maybe LogLevel
lv Maybe Handle
lfh LogLevel
level FilePath
msg

logImpl :: Maybe LogLevel -> Maybe SysIO.Handle -> LogLevel -> String -> IO ()
logImpl :: Maybe LogLevel -> Maybe Handle -> LogLevel -> FilePath -> IO ()
logImpl Maybe LogLevel
minLevel Maybe Handle
mh LogLevel
level FilePath
msg = do
  FilePath
lm <- LogLevel -> FilePath -> IO FilePath
formatLogMsg LogLevel
level FilePath
msg
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe LogLevel -> Bool
forall a. Maybe a -> Bool
isJust Maybe LogLevel
minLevel Bool -> Bool -> Bool
&& LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= Maybe LogLevel -> LogLevel
forall a. HasCallStack => Maybe a -> a
fromJust Maybe LogLevel
minLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> IO ()
putStr FilePath
lm
    Handle -> IO ()
SysIO.hFlush Handle
SysIO.stdout
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Handle -> Bool
forall a. Maybe a -> Bool
isJust Maybe Handle
mh) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Handle -> FilePath -> IO ()
SysIO.hPutStr (Maybe Handle -> Handle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
mh) FilePath
lm
    Handle -> IO ()
SysIO.hFlush (Maybe Handle -> Handle
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Handle
mh)

formatLogMsg :: LogLevel -> String -> IO String
formatLogMsg :: LogLevel -> FilePath -> IO FilePath
formatLogMsg LogLevel
l FilePath
msg = do
  UTCTime
u <- IO UTCTime
getCurrentTime
  let time :: FilePath
time = TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%H:%M:%S" UTCTime
u
  FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"[%s] %s - %s" (LogLevel -> FilePath
printLevel LogLevel
l) FilePath
time (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath]
lines FilePath
msg

printLevel :: LogLevel -> String
printLevel :: LogLevel -> FilePath
printLevel LogLevel
l = case LogLevel
l of
  LogLevel
LogNothing -> FilePath
"NOTHING"
  LogLevel
LogError -> FilePath
" ERROR "
  LogLevel
LogInfo -> FilePath
" INFO  "
  LogLevel
LogDebug -> FilePath
" DEBUG "
  LogLevel
LogTrace -> FilePath
" TRACE "

printHash :: Hashable a => a -> String
printHash :: a -> FilePath
printHash = FilePath -> Int -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%x" (Int -> FilePath) -> (a -> Int) -> a -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Hashable a => a -> Int
hash