{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
A simple exporter backend that prints your metrics to the terminal as they are
submitted.

Taking the example from 'Core.Telemetry.Observability.telemetry', the output
would be:

@
09:58:54Z (03.755) Process order:
  calories = 667.0
  flavour = true
  meal_name = "hamburger"
  precise = 45.0
@
-}
module Core.Telemetry.Console
    ( consoleExporter
    ) where

import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TQueue (TQueue, writeTQueue)
import Core.Data.Clock
import Core.Data.Structures (fromMap)
import Core.Encoding.Json
import Core.Program.Arguments
import Core.Program.Context
import Core.Program.Logging
import Core.Text.Colour
import Core.Text.Rope
import Core.Text.Utilities
import Data.List qualified as List

{- |
Output metrics to the terminal. This is mostly useful for debugging, but it
can also be used as general output mechanism if your program is mostly
concerned with gathering metrics and displaying them.
-}
consoleExporter :: Exporter
consoleExporter :: Exporter
consoleExporter =
    Exporter
        { $sel:codenameFrom:Exporter :: Rope
codenameFrom = Rope
"console"
        , $sel:setupConfigFrom:Exporter :: Config -> Config
setupConfigFrom = Config -> Config
setupConsoleConfig
        , $sel:setupActionFrom:Exporter :: forall τ. Context τ -> IO Forwarder
setupActionFrom = forall τ. Context τ -> IO Forwarder
setupConsoleAction
        }

setupConsoleConfig :: Config -> Config
setupConsoleConfig :: Config -> Config
setupConsoleConfig = forall a. a -> a
id

setupConsoleAction :: Context τ -> IO Forwarder
setupConsoleAction :: forall τ. Context τ -> IO Forwarder
setupConsoleAction Context τ
context = do
    let out :: TQueue (Maybe Rope)
out = forall τ. Context τ -> TQueue (Maybe Rope)
outputChannelFrom Context τ
context
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Forwarder
            { $sel:telemetryHandlerFrom:Forwarder :: [Datum] -> IO ()
telemetryHandlerFrom = TQueue (Maybe Rope) -> [Datum] -> IO ()
processConsoleOutput TQueue (Maybe Rope)
out
            }
        )

processConsoleOutput :: TQueue (Maybe Rope) -> [Datum] -> IO ()
processConsoleOutput :: TQueue (Maybe Rope) -> [Datum] -> IO ()
processConsoleOutput TQueue (Maybe Rope)
out [Datum]
datums = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Datum -> IO ()
processOne [Datum]
datums
  where
    processOne :: Datum -> IO ()
    processOne :: Datum -> IO ()
processOne Datum
datum = do
        let start :: Time
start = Datum -> Time
spanTimeFrom Datum
datum
        let text :: Rope
text =
                Char -> Rope
singletonRope Char
'\n'
                    forall a. Semigroup a => a -> a -> a
<> AnsiColour -> Rope
intoEscapes AnsiColour
pureGrey
                    forall a. Semigroup a => a -> a -> a
<> Datum -> Rope
spanNameFrom Datum
datum
                    forall a. Semigroup a => a -> a -> a
<> Char -> Rope
singletonRope Char
':'
                    forall a. Semigroup a => a -> a -> a
<> let pairs :: [(JsonKey, JsonValue)]
                           pairs :: [(JsonKey, JsonValue)]
pairs = forall α. Dictionary α => Map (K α) (V α) -> α
fromMap (Datum -> Map JsonKey JsonValue
attachedMetadataFrom Datum
datum)
                       in  forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Rope -> (JsonKey, JsonValue) -> Rope
f Rope
emptyRope [(JsonKey, JsonValue)]
pairs
                            forall a. Semigroup a => a -> a -> a
<> AnsiColour -> Rope
intoEscapes AnsiColour
resetColour

        Time
now <- IO Time
getCurrentTimeNanoseconds
        let result :: Rope
result =
                Time -> Time -> Bool -> Severity -> Rope -> Rope
formatLogMessage
                    Time
start
                    Time
now
                    Bool
True
                    Severity
SeverityInternal
                    Rope
text
        forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
            forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Maybe Rope)
out (forall a. a -> Maybe a
Just Rope
result)

f :: Rope -> (JsonKey, JsonValue) -> Rope
f :: Rope -> (JsonKey, JsonValue) -> Rope
f Rope
acc (JsonKey
k, JsonValue
v) =
    Rope
acc
        forall a. Semigroup a => a -> a -> a
<> Rope
"\n  "
        forall a. Semigroup a => a -> a -> a
<> AnsiColour -> Rope
intoEscapes AnsiColour
pureGrey
        forall a. Semigroup a => a -> a -> a
<> forall α. Textual α => α -> Rope
intoRope JsonKey
k
        forall a. Semigroup a => a -> a -> a
<> Rope
" = "
        forall a. Semigroup a => a -> a -> a
<> forall α. Render α => Int -> α -> Rope
render Int
80 JsonValue
v