{-|
Module: IHP.Log.Types
Description:  Types for the IHP logging system
-}

module IHP.Log.Types
( Bytes(..)
, LogStr
, BufSize
, TimeFormat
, RotateSettings(..)
, toLogStr
, fromLogStr
, defaultBufSize
, simpleTimeFormat
, simpleTimeFormat'
, Logger(..)
, LogLevel(..)
, LogDestination(..)
, LoggingProvider(..)
, LoggerSettings(..)
, LogFormatter
, FormattedTime
, newLogger
, defaultLogger
, defaultDestination
, defaultFormatter
, withLevelFormatter
, withTimeFormatter
, withTimeAndLevelFormatter
) where

import IHP.HaskellSupport
import qualified Prelude
import CorePrelude hiding (putStr, putStrLn, print, error, show)
import Data.Text as Text
import Data.Default (Default (def))
import Data.String.Conversions (cs)
import System.Log.FastLogger (
    LogStr,
    LogType'(..),
    BufSize,
    FileLogSpec(..),
    TimedFileLogSpec(..),
    TimeFormat,
    newFastLogger,
    toLogStr,
    fromLogStr,
    defaultBufSize,
    newTimeCache,
    simpleTimeFormat,
    simpleTimeFormat',
    )

import qualified System.Log.FastLogger as FastLogger (FormattedTime)


-- some functions brought over from IHP.Prelude
-- can't import due to circular dependency with IHP.ModelSupport which relies on this module

tshow :: Show a => a -> Text
tshow :: a -> Text
tshow a
value = String -> Text
Text.pack (a -> String
forall a. Show a => a -> String
Prelude.show a
value)

show :: Show a => a -> Text
show :: a -> Text
show = a -> Text
forall a. Show a => a -> Text
tshow

-- | Interal logger type that encapsulates information needed to perform
-- logging operations. Users can also access this though the 'LoggingProvider'
-- class in controller and model actions to perform logic based on the set log level.
data Logger = Logger {
    Logger -> Text -> IO ()
write     :: Text -> IO (),
    Logger -> LogLevel
level     :: LogLevel,
    Logger -> LogFormatter
formatter :: LogFormatter,
    Logger -> IO FormattedTime
timeCache :: IO FastLogger.FormattedTime,
    Logger -> IO ()
cleanup   :: IO ()
}

data LogLevel
    -- | For general messages to help with debugging during development.
    -- Default log level in development.
    -- Also the log level used for SQL queries.
    -- See 'IHP.Log.debug' for example usage.
    = Debug
    -- | For info messages that help montior application usage.
    -- Default log level for production.
    -- See 'IHP.Log.info' for example usage.
    | Info
    -- | For warning messages when something might be wrong.
    -- See 'IHP.Log.warn' for example usage.
    | Warn
    -- | For application errors that can be recovered from.
    -- See 'IHP.Log.error' for example usage.
    | Error
    -- | For application errors that are fatal
    -- See 'IHP.Log.fatal' for example usage.
    | Fatal
    -- | For miscallenaous log messages. Highest log level - will always be logged
    -- See 'IHP.Log.unknown' for example usage.
    | Unknown
    deriving (Int -> LogLevel
LogLevel -> Int
LogLevel -> [LogLevel]
LogLevel -> LogLevel
LogLevel -> LogLevel -> [LogLevel]
LogLevel -> LogLevel -> LogLevel -> [LogLevel]
(LogLevel -> LogLevel)
-> (LogLevel -> LogLevel)
-> (Int -> LogLevel)
-> (LogLevel -> Int)
-> (LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> [LogLevel])
-> (LogLevel -> LogLevel -> LogLevel -> [LogLevel])
-> Enum LogLevel
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 :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
$cenumFromThenTo :: LogLevel -> LogLevel -> LogLevel -> [LogLevel]
enumFromTo :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromTo :: LogLevel -> LogLevel -> [LogLevel]
enumFromThen :: LogLevel -> LogLevel -> [LogLevel]
$cenumFromThen :: LogLevel -> LogLevel -> [LogLevel]
enumFrom :: LogLevel -> [LogLevel]
$cenumFrom :: LogLevel -> [LogLevel]
fromEnum :: LogLevel -> Int
$cfromEnum :: LogLevel -> Int
toEnum :: Int -> LogLevel
$ctoEnum :: Int -> LogLevel
pred :: LogLevel -> LogLevel
$cpred :: LogLevel -> LogLevel
succ :: LogLevel -> LogLevel
$csucc :: LogLevel -> LogLevel
Enum, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
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 :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show)

-- | The timestamp in the formatted defined by the logger's timeFormat string.
type FormattedTime = Text

-- | Called every time a message is sent to the logger.
-- Since this is just a function type, it's trivial to define custom formatters:
--
-- @
--     withTimeAndLevelFormatterUpcaseAndHappy :: LogFormatter
--     withTimeAndLevelFormatterUpcaseAndHappy time level msg =
--        "[" <> toUpper (show level) <> "]"
--          <> "[" <> time <> "] "
--          <> toUpper msg <> " :) \n"
-- @
type LogFormatter = FormattedTime -> LogLevel -> Text -> Text

-- | A number of bytes, used in 'RotateSettings'
newtype Bytes = Bytes Integer

data RotateSettings
    -- | Log messages to a file which is never rotated.
    --
    -- @
    -- newLogger def {
    --    destination = File "Log/production.log" NoRotate defaultBufSize
    --    }
    -- @
    = NoRotate
    -- | Log messages to a file and rotate the file after it reaches the given size in bytes.
    -- Third argument is the max number of rotated log files to keep around before overwriting the oldest one.
    --
    -- Example: log to a file rotated once it is 4MB, and keep 7 files before overwriting the first file.
    --
    -- @
    --    newLogger def {
    --      destination = File "Log/production.log" (SizeRotate (Bytes (4 * 1024 * 1024)) 7) defaultBufSize
    --      }
    -- @
    | SizeRotate Bytes Int
    -- | Log messages to a file rotated on a timed basis.
    -- Expects a time format string as well as a function which compares two formatted time strings
    -- which is used to determine if the file should be rotated.
    -- Last argument is a function which is called on a log file once its rotated.
    --
    -- Example: rotate a file daily and compress the log file once rotated.
    --
    -- @
    --   let
    --       filePath = "Log/production.log"
    --       formatString = "%FT%H%M%S"
    --       timeCompare = (==) on C8.takeWhile (/=T))
    --       compressFile fp = void . forkIO $
    --           callProcess "tar" [ "--remove-files", "-caf", fp <> ".gz", fp ]
    --   in
    --     newLogger def {
    --        destination = File
    --          filePath
    --          (TimedRotate formatString timeCompare compressFile)
    --          defaultBufSize
    --        }
    -- @
    | TimedRotate TimeFormat (FastLogger.FormattedTime -> FastLogger.FormattedTime -> Bool) (FilePath -> IO ())

-- | Where logged messages will be delivered to.
data LogDestination
    = None
    -- | Log messages to standard output.
    | Stdout BufSize
    -- | Log messages to standard error.
    | Stderr BufSize
    -- | Log message to a file. Rotate the log file with the behavior given by 'RotateSettings'.
    | File FilePath RotateSettings BufSize
    -- | Send logged messages to a callback. Flush action called after every log.
    | Callback (LogStr -> IO ()) (IO ())

data LoggerSettings = LoggerSettings {
    LoggerSettings -> LogLevel
level       :: LogLevel,
    LoggerSettings -> LogFormatter
formatter   :: LogFormatter,
    LoggerSettings -> LogDestination
destination :: LogDestination,
    LoggerSettings -> FormattedTime
timeFormat  :: TimeFormat
}

instance Default LoggerSettings where
    def :: LoggerSettings
def = LoggerSettings :: LogLevel
-> LogFormatter
-> LogDestination
-> FormattedTime
-> LoggerSettings
LoggerSettings {
        $sel:level:LoggerSettings :: LogLevel
level = LogLevel
Debug,
        $sel:formatter:LoggerSettings :: LogFormatter
formatter = LogFormatter
defaultFormatter,
        $sel:destination:LoggerSettings :: LogDestination
destination = LogDestination
defaultDestination,
        $sel:timeFormat:LoggerSettings :: FormattedTime
timeFormat = FormattedTime
simpleTimeFormat'
    }

-- | Logger default destination is to standard out.
defaultDestination :: LogDestination
defaultDestination :: LogDestination
defaultDestination = Int -> LogDestination
Stdout Int
defaultBufSize

-- | Used to get the logger for a given environment.
class LoggingProvider a where
    -- | Call in any instance of 'LoggingProvider' get the the environment's current logger.
    -- Useful in controller and model actions, which both have logging contexts.
    getLogger :: a -> Logger

instance {-# OVERLAPS #-} LoggingProvider Logger where
    getLogger :: Logger -> Logger
getLogger = Logger -> Logger
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

-- | Create a new 'FastLogger' and wrap it in an IHP 'Logger'.
-- Use with the default logger settings and record update syntax for nice configuration:
--
-- > newLogger def { level = Error }
newLogger :: LoggerSettings -> IO Logger
newLogger :: LoggerSettings -> IO Logger
newLogger LoggerSettings { FormattedTime
LogDestination
LogLevel
LogFormatter
timeFormat :: FormattedTime
destination :: LogDestination
formatter :: LogFormatter
level :: LogLevel
$sel:timeFormat:LoggerSettings :: LoggerSettings -> FormattedTime
$sel:destination:LoggerSettings :: LoggerSettings -> LogDestination
$sel:formatter:LoggerSettings :: LoggerSettings -> LogFormatter
$sel:level:LoggerSettings :: LoggerSettings -> LogLevel
.. } = do
    IO FormattedTime
timeCache <- FormattedTime -> IO (IO FormattedTime)
newTimeCache FormattedTime
timeFormat
    (LogStr -> IO ()
write', IO ()
cleanup) <- LogDestination -> IO (LogStr -> IO (), IO ())
makeFastLogger LogDestination
destination
    let write :: Text -> IO ()
write = LogStr -> IO ()
write' (LogStr -> IO ()) -> (Text -> LogStr) -> Text -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr
    Logger -> IO Logger
forall (f :: * -> *) a. Applicative f => a -> f a
pure Logger :: (Text -> IO ())
-> LogLevel -> LogFormatter -> IO FormattedTime -> IO () -> Logger
Logger { IO ()
IO FormattedTime
LogLevel
Text -> IO ()
LogFormatter
write :: Text -> IO ()
cleanup :: IO ()
timeCache :: IO FormattedTime
formatter :: LogFormatter
level :: LogLevel
$sel:cleanup:Logger :: IO ()
$sel:timeCache:Logger :: IO FormattedTime
$sel:formatter:Logger :: LogFormatter
$sel:level:Logger :: LogLevel
$sel:write:Logger :: Text -> IO ()
.. }
    where
        makeFastLogger :: LogDestination -> IO (LogStr -> IO (), IO ())
makeFastLogger LogDestination
destination = LogType' LogStr -> IO (LogStr -> IO (), IO ())
forall v. LogType' v -> IO (v -> IO (), IO ())
newFastLogger (LogType' LogStr -> IO (LogStr -> IO (), IO ()))
-> LogType' LogStr -> IO (LogStr -> IO (), IO ())
forall a b. (a -> b) -> a -> b
$
            case LogDestination
destination of
                LogDestination
None                    -> LogType' LogStr
LogNone
                Stdout Int
buf              -> Int -> LogType' LogStr
LogStdout Int
buf
                Stderr Int
buf              -> Int -> LogType' LogStr
LogStderr Int
buf
                File String
path RotateSettings
settings Int
buf  -> String -> RotateSettings -> Int -> LogType' LogStr
makeFileLogger String
path RotateSettings
settings Int
buf
                Callback LogStr -> IO ()
callback IO ()
flush -> (LogStr -> IO ()) -> IO () -> LogType' LogStr
forall a. (a -> IO ()) -> IO () -> LogType' a
LogCallback LogStr -> IO ()
callback IO ()
flush

        makeFileLogger :: String -> RotateSettings -> Int -> LogType' LogStr
makeFileLogger String
path RotateSettings
NoRotate = String -> Int -> LogType' LogStr
LogFileNoRotate String
path
        makeFileLogger String
path (SizeRotate (Bytes Integer
size) Int
count) = FileLogSpec -> Int -> LogType' LogStr
LogFile (String -> Integer -> Int -> FileLogSpec
FileLogSpec String
path Integer
size Int
count)
        makeFileLogger String
path (TimedRotate FormattedTime
fmt FormattedTime -> FormattedTime -> Bool
cmp String -> IO ()
post) = TimedFileLogSpec -> Int -> LogType' LogStr
LogFileTimedRotate (String
-> FormattedTime
-> (FormattedTime -> FormattedTime -> Bool)
-> (String -> IO ())
-> TimedFileLogSpec
TimedFileLogSpec String
path FormattedTime
fmt FormattedTime -> FormattedTime -> Bool
cmp String -> IO ()
post)

-- | Formats logs as-is to stdout.
defaultLogger :: IO Logger
defaultLogger :: IO Logger
defaultLogger = LoggerSettings -> IO Logger
newLogger LoggerSettings
forall a. Default a => a
def

-- | Formats the log as-is with a newline added.
defaultFormatter :: LogFormatter
defaultFormatter :: LogFormatter
defaultFormatter Text
_ LogLevel
_ Text
msg = Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

-- | Prepends the timestamp to the log message and adds a new line.
withTimeFormatter :: LogFormatter
withTimeFormatter :: LogFormatter
withTimeFormatter  Text
time LogLevel
_ Text
msg = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
time Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

-- | Prepends the log level to the log message and adds a new line.
withLevelFormatter :: LogFormatter
withLevelFormatter :: LogFormatter
withLevelFormatter Text
time LogLevel
level Text
msg = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
toUpper (LogLevel -> Text
forall a. Show a => a -> Text
show LogLevel
level) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"

-- | Prepends the log level and timestamp to the log message and adds a new line.
withTimeAndLevelFormatter :: LogFormatter
withTimeAndLevelFormatter :: LogFormatter
withTimeAndLevelFormatter Text
time LogLevel
level Text
msg = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
toUpper (LogLevel -> Text
forall a. Show a => a -> Text
show LogLevel
level) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] [" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
time Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"] " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"