{-|
Module: IHP.Log
Description:  Functions to write logs at all log levels.

Import this module qualified! All code examples
assume you have imported the module as follows:

> import qualified IHP.Log as Log

-}
module IHP.Log
( module IHP.Log.Types
, debug
, info
, warn
, error
, fatal
, unknown
, makeRequestLogger
, defaultRequestLogger
) where

import IHP.HaskellSupport hiding (debug)

import qualified Prelude
import CorePrelude hiding (putStr, putStrLn, print, error, show, log, debug)
import Control.Monad (when)
import Data.Text as Text
import IHP.Log.Types
import Network.Wai (Middleware)
import Network.Wai.Middleware.RequestLogger (mkRequestLogger, RequestLoggerSettings, destination)
import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
import Data.Default (Default (def))
import Data.String.Conversions (cs)
import System.IO.Unsafe (unsafePerformIO)

-- | Format a log and send it to the logger.
-- Internal use only -- application code should call the
-- function corresponding to the desired log level.
log :: (?context :: context, LoggingProvider context) => LogLevel -> Text -> IO ()
log :: LogLevel -> Text -> IO ()
log LogLevel
level Text
text = do
    let logger :: Logger
logger = context -> Logger
forall a. LoggingProvider a => a -> Logger
getLogger context
?context::context
?context
    let formatter :: LogFormatter
formatter = Proxy "formatter" -> Logger -> LogFormatter
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "formatter" (Proxy "formatter")
Proxy "formatter"
#formatter Logger
logger
    Text
timestamp <- FormattedTime -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (FormattedTime -> Text) -> IO FormattedTime -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy "timeCache" -> Logger -> IO FormattedTime
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "timeCache" (Proxy "timeCache")
Proxy "timeCache"
#timeCache Logger
logger
    LogFormatter
formatter Text
timestamp LogLevel
level Text
text
        Text -> (Text -> IO ()) -> IO ()
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> LogLevel -> Logger -> Text -> IO ()
writeLog LogLevel
level Logger
logger

-- | Log a debug level message.
--
-- > action CreateUserAction { .. } = do
-- >     Log.debug "entered CreateUserAction"
-- >     ...
debug :: (?context :: context, LoggingProvider context) => Text -> IO ()
debug :: Text -> IO ()
debug = LogLevel -> Text -> IO ()
forall context.
(?context::context, LoggingProvider context) =>
LogLevel -> Text -> IO ()
log LogLevel
Debug

-- | Log an info level message.
--
-- > action UsersAction = do
-- >     users <- query @User |> fetch
-- >     Log.info $ show (lengh users) <> " users fetched."
-- >     ...
info :: (?context :: context, LoggingProvider context) => Text -> IO ()
info :: Text -> IO ()
info = LogLevel -> Text -> IO ()
forall context.
(?context::context, LoggingProvider context) =>
LogLevel -> Text -> IO ()
log LogLevel
Info

-- | Log a warning level message.
--
-- > action UsersAction = do
-- >     users <- query @User |> fetch
-- >     whenEmpty users $ Log.warn "No users found. Something might be wrong!"
-- >     ...
warn :: (?context :: context, LoggingProvider context) => Text -> IO ()
warn :: Text -> IO ()
warn = LogLevel -> Text -> IO ()
forall context.
(?context::context, LoggingProvider context) =>
LogLevel -> Text -> IO ()
log LogLevel
Warn

-- |Log a warning level message.
--
-- @
--    action CreatePostAction = do
--        let post = newRecord @Post
--        post
--            |> buildPost
--            |> ifValid \case
--                Left post -> do
--                    Log.error "Invalid post."
--                    render NewView { .. }
--                Right post -> do
--                    post <- post |> createRecord
--                    setSuccessMessage "Post created"
--                    redirectTo PostsAction
-- @
error :: (?context :: context, LoggingProvider context) => Text -> IO ()
error :: Text -> IO ()
error = LogLevel -> Text -> IO ()
forall context.
(?context::context, LoggingProvider context) =>
LogLevel -> Text -> IO ()
log LogLevel
Error

-- | Log a fatal level message.
-- Note this does not exit the program for you -- it only logs to the "Fatal" log level.
--
-- > Log.fatal "Unrecoverable application error!"
fatal :: (?context :: context, LoggingProvider context) => Text -> IO ()
fatal :: Text -> IO ()
fatal = LogLevel -> Text -> IO ()
forall context.
(?context::context, LoggingProvider context) =>
LogLevel -> Text -> IO ()
log LogLevel
Fatal

-- | Log an "unknown" level message.
-- This is the highest log level and will always be output by the logger.
--
-- > Log.unknown "This will be sent to the logger no matter what!"
unknown :: (?context :: context, LoggingProvider context) => Text -> IO ()
unknown :: Text -> IO ()
unknown = LogLevel -> Text -> IO ()
forall context.
(?context::context, LoggingProvider context) =>
LogLevel -> Text -> IO ()
log LogLevel
Unknown

-- | Write a log if the given log level is greater than or equal to the logger's log level.
writeLog :: LogLevel -> Logger -> Text -> IO ()
writeLog :: LogLevel -> Logger -> Text -> IO ()
writeLog LogLevel
level Logger
logger Text
text = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= Proxy "level" -> Logger -> LogLevel
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "level" (Proxy "level")
Proxy "level"
#level Logger
logger) (Text
text Text -> (Text -> IO ()) -> IO ()
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "write" -> Logger -> Text -> IO ()
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "write" (Proxy "write")
Proxy "write"
#write Logger
logger)

-- | Wraps 'RequestLogger' from wai-extra to log to an IHP logger.
-- See 'Network.Wai.Middleware.RequestLogger'.
makeRequestLogger :: RequestLoggerSettings -> Logger -> Middleware
makeRequestLogger :: RequestLoggerSettings -> Logger -> Middleware
makeRequestLogger RequestLoggerSettings
settings Logger
logger = IO Middleware -> Middleware
forall a. IO a -> a
unsafePerformIO (IO Middleware -> Middleware) -> IO Middleware -> Middleware
forall a b. (a -> b) -> a -> b
$
    RequestLoggerSettings -> IO Middleware
mkRequestLogger RequestLoggerSettings
settings {
        destination :: Destination
destination = Callback -> Destination
RequestLogger.Callback (\LogStr
logStr ->
            let ?context = logger in
                LogStr
logStr LogStr -> (LogStr -> FormattedTime) -> FormattedTime
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> LogStr -> FormattedTime
fromLogStr FormattedTime -> (FormattedTime -> Text) -> Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> FormattedTime -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text -> (Text -> IO ()) -> IO ()
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Text -> IO ()
forall context.
(?context::context, LoggingProvider context) =>
Text -> IO ()
info
            )
        }

-- | Create a request logger with default settings wrapped in an IHP logger.
-- See 'Network.Wai.Middleware.RequestLogger'.
defaultRequestLogger :: Logger -> Middleware
defaultRequestLogger :: Logger -> Middleware
defaultRequestLogger = RequestLoggerSettings -> Logger -> Middleware
makeRequestLogger RequestLoggerSettings
forall a. Default a => a
def