content: {-# LANGUAGE ConstraintKinds #-}
  {-|
  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 qualified Prelude
  import CorePrelude hiding (putStr, putStrLn, print, error, show)
  import Data.Text as Text
  import Data.Default (Default (def))
  import System.Log.FastLogger (
      LogStr,
      LogType'(..),
      BufSize,
      FileLogSpec(..),
      TimedFileLogSpec(..),
      TimeFormat,
      toLogStr,
      fromLogStr,
      defaultBufSize,
      newTimeCache,
      simpleTimeFormat,
      simpleTimeFormat',
      newTimedFastLogger,
      ToLogStr (..)
      )
  
  import qualified System.Log.FastLogger as FastLogger (FormattedTime)
  import GHC.Records
  
  
  -- 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 value = Text.pack (Prelude.show value)
  
  show :: Show a => a -> Text
  show = 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 {
      write     :: !((FastLogger.FormattedTime -> LogStr) -> IO ()),
      level     :: !LogLevel,
      formatter :: !LogFormatter,
      timeCache :: !(IO FastLogger.FormattedTime),
      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 (Enum, Eq, Ord, Show)
  
  instance ToLogStr LogLevel where
      toLogStr Debug = "DEBUG"
      toLogStr Info = "INFO"
      toLogStr Warn = "WARN"
      toLogStr Error = "ERROR"
      toLogStr Fatal = "FATAL"
      toLogStr Unknown = "UNKNOWN"
  
  -- | The timestamp in the formatted defined by the logger's timeFormat string.
  type FormattedTime = ByteString
  
  -- | 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 -> LogStr -> LogStr
  
  -- | 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 {
      level       :: LogLevel,
      formatter   :: LogFormatter,
      destination :: LogDestination,
      timeFormat  :: TimeFormat
  }
  
  instance Default LoggerSettings where
      def = LoggerSettings {
          level = Debug,
          formatter = defaultFormatter,
          destination = defaultDestination,
          timeFormat = simpleTimeFormat'
      }
  
  -- | Logger default destination is to standard out.
  defaultDestination :: LogDestination
  defaultDestination = Stdout defaultBufSize
  
  -- | Used to get the logger for a given environment.
  -- | Call in any instance of 'LoggingProvider' get the the environment's current logger.
  -- Useful in controller and model actions, which both have logging contexts.
  type LoggingProvider context = HasField "logger" context Logger
  
  instance HasField "logger" Logger Logger where
      getField logger = logger
  
  -- | 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 { .. } = do
      timeCache <- newTimeCache timeFormat
      (write, cleanup) <- makeFastLogger timeCache destination
      pure Logger { .. }
      where
          makeFastLogger timeCache destination = newTimedFastLogger timeCache $
              case destination of
                  None                    -> LogNone
                  Stdout buf              -> LogStdout buf
                  Stderr buf              -> LogStderr buf
                  File path settings buf  -> makeFileLogger path settings buf
                  Callback callback flush -> LogCallback callback flush
  
          makeFileLogger path NoRotate = LogFileNoRotate path
          makeFileLogger path (SizeRotate (Bytes size) count) = LogFile (FileLogSpec path size count)
          makeFileLogger path (TimedRotate fmt cmp post) = LogFileTimedRotate (TimedFileLogSpec path fmt cmp post)
  
  -- | Formats logs as-is to stdout.
  defaultLogger :: IO Logger
  defaultLogger = newLogger def
  
  -- | Formats the log as-is with a newline added.
  defaultFormatter :: LogFormatter
  defaultFormatter _ _ msg = msg <> "\n"
  
  -- | Prepends the timestamp to the log message and adds a new line.
  withTimeFormatter :: LogFormatter
  withTimeFormatter  time _ msg = "[" <> toLogStr time <> "] " <> msg <> "\n"
  
  -- | Prepends the log level to the log message and adds a new line.
  withLevelFormatter :: LogFormatter
  withLevelFormatter time level msg = "[" <> (toLogStr level) <> "] " <> msg <> "\n"
  
  -- | Prepends the log level and timestamp to the log message and adds a new line.
  withTimeAndLevelFormatter :: LogFormatter
  withTimeAndLevelFormatter time level msg = "[" <> (toLogStr level) <> "] [" <> toLogStr time <> "] " <> msg <> "\n"
  