{- | Generate JSON logs compatible with LogZ.io. `logMsgJs` and `formatMsgJs` are both re-exported, so it should not be necessary to import this module directly.

TODO: Rename this to LogZ since it generates fields specific to that service.
-}
{-# LANGUAGE OverloadedStrings  #-}
module LuminescentDreams.Logger.JSON ( logMsgJs, formatMsgJs ) where

import           Control.Monad            (when)
import qualified Data.ByteString.Lazy     as BL
import qualified Data.Aeson               as Aeson
import qualified Data.Map                 as M
import           Data.Monoid
import           Data.String
import qualified Data.Text.Format         as TF
import qualified Data.Text                as T
import qualified Data.Text.Encoding       as TEnc
import qualified Data.Text.Lazy           as TL
import qualified Data.Time                as Time

import           LuminescentDreams.Logger.Types

logMsgJs :: Logger -> LogLevel -> [(String, Aeson.Value)] -> IO ()
logMsgJs (Logger writer pri app_ tags_) lvl msg =
    when (lvl >= pri) $ do
        t <- Time.getCurrentTime
        writer $ formatMsgJs app_ tags_ t lvl msg

{- | Format a message for LogZ JSON format. -}
formatMsgJs :: T.Text -> [T.Text] -> Time.UTCTime -> LogLevel -> [(String, Aeson.Value)] -> T.Text
formatMsgJs application tags time level msg =
  let msg_ = msg <> [ ("@timestamp", fromString $ Time.formatTime Time.defaultTimeLocale tzFormat time)
                    , ("@level", Aeson.String $ TL.toStrict $ TF.format "{}" (TF.Only level))
                    , ("@tags", Aeson.toJSON tags)
                    , ("@app", Aeson.String application)
                    ]
  in TEnc.decodeUtf8 $ BL.toStrict $ Aeson.encode $ M.fromList msg_