{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# OPTIONS_GHC -fno-warn-orphans   #-}
module LuminescentDreams.Logger.Standard where

import           Control.Monad            (when)
import           Data.Monoid
import qualified Data.Text.Format         as TF
import qualified Data.Text                as T
import qualified Data.Text.Lazy           as TL
import qualified Data.Text.Buildable      as TFB
import qualified Data.Time                as Time
import qualified Data.List                as List

import           LuminescentDreams.Logger.Types


data LogMsg = LogMsg LogLevel [(String, String)] String

logMsgStd :: Logger -> LogLevel -> [(String, String)] -> String -> IO ()
logMsgStd l lvl tags text = logMsg_ l (LogMsg lvl tags text)

logMsg_ :: Logger -> LogMsg -> IO ()
logMsg_ (Logger writer pri app tags) msg@(LogMsg lvl _ _) =
    when (lvl >= pri) $ do
        t <-  Time.getCurrentTime
        writer $ formatMsgStd app tags t msg


formatMsgStd :: T.Text -> [T.Text] -> Time.UTCTime -> LogMsg -> T.Text
formatMsgStd _ _ t (LogMsg lvl tags text) =
    TL.toStrict $ TF.format "{} {} {} {}" ( Time.formatTime Time.defaultTimeLocale tzFormat t
                                          , lvl
                                          , tags
                                          , text
                                          )


instance TFB.Buildable (String, String) where
    build (name, value) = TFB.build $ "(" <> name <> ", " <> value <> ")"

instance TFB.Buildable [(String, String)] where
    -- build lst = TFB.build "[" <> TFB.build `fmap` lst "]"
    build lst =
        mconcat $ [TFB.build ("[" :: String)]
               <> List.intersperse (TFB.build (", " :: String)) (TFB.build `fmap` lst)
               <> [TFB.build ("]" :: String)]