-- |Description: Formatting helpers
module Polysemy.Log.Format where

import qualified Data.Text as Text
import GHC.Exception (SrcLoc(..))
import System.Console.ANSI (Color(..), ColorIntensity(Dull), ConsoleLayer(Foreground), SGR (..), setSGRCode)

import Polysemy.Log.Data.LogEntry (LogEntry(LogEntry))
import qualified Polysemy.Log.Data.LogMessage as LogMessage
import Polysemy.Log.Data.LogMessage (LogMessage(LogMessage))
import Polysemy.Log.Data.Severity (Severity(..))

-- |Create a colored tag with the format @"[tag]"@ for a 'Severity' value.
formatSeverity :: Severity -> Text
formatSeverity :: Severity -> Text
formatSeverity = \case
  Severity
Trace -> Text
"[trace]"
  Severity
Debug -> Color -> Text -> Text
color Color
Green Text
"[debug]"
  Severity
Info -> Color -> Text -> Text
color Color
Blue Text
"[info] "
  Severity
Warn -> Color -> Text -> Text
color Color
Yellow Text
"[warn] "
  Severity
Error -> Color -> Text -> Text
color Color
Red Text
"[error]"
  Severity
Crit -> Color -> Text -> Text
color Color
Magenta Text
"[crit] "
 where
   color :: Color -> Text -> Text
color Color
c Text
txt =
     String -> Text
forall a. ToText a => a -> Text
toText ([SGR] -> String
setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
c]) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
     Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
     String -> Text
forall a. ToText a => a -> Text
toText ([SGR] -> String
setSGRCode [Item [SGR]
SGR
Reset])

-- |Turn a module string like @Foo.Bar.Baz@ into an abbreviated @F.B.Baz@.
shortModule :: Text -> Text
shortModule :: Text -> Text
shortModule =
  [Text] -> Text
spin ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
"."
  where
    spin :: [Text] -> Text
spin = \case
      [] -> Text
""
      [Item [Text]
m] -> Item [Text]
Text
m
      Text
h : [Text]
t -> Int -> Text -> Text
Text.take Int
1 Text
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
spin [Text]
t

-- |Format a call stack's top element as @"F.B.Baz#32"@ with the line number.
formatCaller :: CallStack -> Text
formatCaller :: CallStack -> Text
formatCaller =
  Text
-> ((String, SrcLoc) -> Text) -> Maybe (String, SrcLoc) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<unknown loc>" (String, SrcLoc) -> Text
forall dst a.
(Interpolatable (IsCustomSink dst) Text dst,
 Interpolatable (IsCustomSink dst) Int dst) =>
(a, SrcLoc) -> dst
format (Maybe (String, SrcLoc) -> Text)
-> (CallStack -> Maybe (String, SrcLoc)) -> CallStack -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe ([(String, SrcLoc)] -> Maybe (String, SrcLoc))
-> (CallStack -> [(String, SrcLoc)])
-> CallStack
-> Maybe (String, SrcLoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [(String, SrcLoc)]
getCallStack
  where
    format :: (a, SrcLoc) -> dst
format (a
_, SrcLoc {Int
String
srcLocPackage :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocFile :: SrcLoc -> String
srcLocStartLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocEndCol :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocModule :: String
srcLocPackage :: String
..}) =
      [qt|#{shortModule (toText srcLocModule)}##{srcLocStartLine}|]

-- |Default formatter for the default message type.
formatLogEntry :: LogEntry LogMessage -> Text
formatLogEntry :: LogEntry LogMessage -> Text
formatLogEntry (LogEntry LogMessage {Text
Severity
$sel:message:LogMessage :: LogMessage -> Text
$sel:severity:LogMessage :: LogMessage -> Severity
message :: Text
severity :: Severity
..} UTCTime
_ CallStack
source) =
  [qt|#{formatSeverity severity} [#{formatCaller source}] #{message}|]