{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |Logging utility functions
module Chakra.Logging
  ( LogMessage,
    ModLogger,
    Formatter,
    jsonFormatter,
    newLogger,
    buildLogger,
  )
where

import Data.Aeson
  ( ToJSON (toEncoding),
    defaultOptions,
    encode,
    genericToEncoding,
  )
import Data.Has (Has (hasLens))
import qualified Data.Text.Encoding as T
import RIO
import System.Log.FastLogger

type ModLogger = LogFunc

type Formatter = TimedFastLogger -> CallStack -> LogSource -> LogLevel -> Utf8Builder -> IO ()

data LogMessage = LogMessage
  { LogMessage -> Text
message :: !Text,
    LogMessage -> Text
logSource :: !Text,
    LogMessage -> Text
callStack :: !Text,
    LogMessage -> Text
timestamp :: !Text,
    LogMessage -> Text
level :: !Text,
    LogMessage -> Text
appVersion :: !Text,
    LogMessage -> Text
appEnvironment :: !Text
  }
  deriving (LogMessage -> LogMessage -> Bool
(LogMessage -> LogMessage -> Bool)
-> (LogMessage -> LogMessage -> Bool) -> Eq LogMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogMessage -> LogMessage -> Bool
$c/= :: LogMessage -> LogMessage -> Bool
== :: LogMessage -> LogMessage -> Bool
$c== :: LogMessage -> LogMessage -> Bool
Eq, Int -> LogMessage -> ShowS
[LogMessage] -> ShowS
LogMessage -> String
(Int -> LogMessage -> ShowS)
-> (LogMessage -> String)
-> ([LogMessage] -> ShowS)
-> Show LogMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage] -> ShowS
$cshowList :: [LogMessage] -> ShowS
show :: LogMessage -> String
$cshow :: LogMessage -> String
showsPrec :: Int -> LogMessage -> ShowS
$cshowsPrec :: Int -> LogMessage -> ShowS
Show, (forall x. LogMessage -> Rep LogMessage x)
-> (forall x. Rep LogMessage x -> LogMessage) -> Generic LogMessage
forall x. Rep LogMessage x -> LogMessage
forall x. LogMessage -> Rep LogMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LogMessage x -> LogMessage
$cfrom :: forall x. LogMessage -> Rep LogMessage x
Generic)

instance ToJSON LogMessage where
  toEncoding :: LogMessage -> Encoding
toEncoding = Options -> LogMessage -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

instance ToLogStr LogMessage where
  toLogStr :: LogMessage -> LogStr
toLogStr LogMessage
a = (ByteString -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (ByteString -> LogStr)
-> (LogMessage -> ByteString) -> LogMessage -> LogStr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogMessage -> ByteString
forall a. ToJSON a => a -> ByteString
encode (LogMessage -> LogStr) -> LogMessage -> LogStr
forall a b. (a -> b) -> a -> b
$ LogMessage
a) LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n"

instance {-# OVERLAPPABLE #-} Has ModLogger a => HasLogFunc a where
  logFuncL :: (LogFunc -> f LogFunc) -> a -> f a
logFuncL = (LogFunc -> f LogFunc) -> a -> f a
forall a t. Has a t => Lens t a
hasLens

-- | Creates a logger module using a given formatting function.
-- | Also returns the underlying TimedFastLogger for use outside of your app (e.g. in some WAI middleware).
newLogger :: LogType -> Formatter -> IO (TimedFastLogger, ModLogger)
newLogger :: LogType -> Formatter -> IO (TimedFastLogger, LogFunc)
newLogger LogType
logtype Formatter
formatter = do
  IO FormattedTime
tc <- FormattedTime -> IO (IO FormattedTime)
newTimeCache FormattedTime
simpleTimeFormat'
  (TimedFastLogger
fl, IO ()
_cleanupAction) <- IO FormattedTime -> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger IO FormattedTime
tc LogType
logtype
  -- todo clean up
  (TimedFastLogger, LogFunc) -> IO (TimedFastLogger, LogFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return (TimedFastLogger
fl, (CallStack -> Text -> LogLevel -> Utf8Builder -> IO ()) -> LogFunc
mkLogFunc ((CallStack -> Text -> LogLevel -> Utf8Builder -> IO ())
 -> LogFunc)
-> (CallStack -> Text -> LogLevel -> Utf8Builder -> IO ())
-> LogFunc
forall a b. (a -> b) -> a -> b
$ Formatter
formatter TimedFastLogger
fl)

-- | Builds LogMessage and json encodes to string
jsonFormatter :: Text -> Text -> Formatter
jsonFormatter :: Text -> Text -> Formatter
jsonFormatter Text
envName Text
appVer TimedFastLogger
logger CallStack
cs Text
src LogLevel
logLvl Utf8Builder
msg = TimedFastLogger
logger FormattedTime -> LogStr
buildJsonLogMsg
  where
    showLevel :: LogLevel -> Text
showLevel LogLevel
LevelDebug = Text
"debug"
    showLevel LogLevel
LevelInfo = Text
"info"
    showLevel LogLevel
LevelWarn = Text
"warn"
    showLevel LogLevel
LevelError = Text
"error"
    showLevel (LevelOther Text
t) = Text
"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
""
    buildJsonLogMsg :: FormattedTime -> LogStr
buildJsonLogMsg FormattedTime
t =
      LogMessage -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (LogMessage -> LogStr) -> LogMessage -> LogStr
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> Text -> Text -> Text -> Text -> Text -> LogMessage
LogMessage
          (Utf8Builder -> Text
utf8BuilderToText Utf8Builder
msg)
          (Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (Text -> Utf8Builder) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattedTime -> Utf8Builder
displayBytesUtf8 (FormattedTime -> Utf8Builder)
-> (Text -> FormattedTime) -> Text -> Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogStr -> FormattedTime
fromLogStr (LogStr -> FormattedTime)
-> (Text -> LogStr) -> Text -> FormattedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LogStr
forall msg. ToLogStr msg => msg -> LogStr
toLogStr (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
src)
          (Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> Utf8Builder -> Text
forall a b. (a -> b) -> a -> b
$ CallStack -> Utf8Builder
displayCallStack CallStack
cs)
          (FormattedTime -> Text
T.decodeUtf8 FormattedTime
t)
          (LogLevel -> Text
showLevel LogLevel
logLvl)
          Text
appVer
          Text
envName

-- | Convenient function to create json formatted logger with appName & appVer values
buildLogger :: Text -> Text -> IO ModLogger
buildLogger :: Text -> Text -> IO LogFunc
buildLogger Text
envName Text
appVer = do
  (TimedFastLogger
_, LogFunc
lf) <- LogType -> Formatter -> IO (TimedFastLogger, LogFunc)
newLogger (Int -> LogType
LogStderr Int
defaultBufSize) (Text -> Text -> Formatter
jsonFormatter Text
envName Text
appVer)
  LogFunc -> IO LogFunc
forall (m :: * -> *) a. Monad m => a -> m a
return LogFunc
lf