Console.hs

module Effectful.OpenTelemetry.Exporter.Console where

import Effectful.OpenTelemetry.Exporter.Type (Exporter)
import Effectful.OpenTelemetry.Exporter.Type qualified as Exporter
import Prettyprinter (unAnnotate)
import Prettyprinter.Extra (PrettyAnn (..))
import Prettyprinter.Render.Terminal (AnsiStyle, hPutDoc)
import System.Console.ANSI (hSupportsANSI)
import System.Environment (lookupEnv)
import System.IO (Handle)
import System.IO qualified as Handle
import Prelude

-- | Print telemetry to the given 'Handle', one payload per line.
--
-- The output is styled using ANSI escape sequences if supported (see 'hSupportsANSI').
-- Styling can be disabled by setting the @NO_COLOR@ environment variable.
console :: (PrettyAnn AnsiStyle a) => Handle -> Exporter es a
console handle = Exporter.fromIO \a -> do
    colour <-
        lookupEnv "NO_COLOR" >>= \case
            Just _ -> pure False
            Nothing -> hSupportsANSI handle
    if colour
        then ansiIO handle a
        else plainIO handle a

-- | Print telemetry to the given 'Handle', one payload per line.
-- The output is styled using ANSI escape sequences.
ansi :: (PrettyAnn AnsiStyle a) => Handle -> Exporter es a
ansi = Exporter.fromIO . ansiIO

ansiIO :: (PrettyAnn AnsiStyle a) => Handle -> a -> IO ()
ansiIO handle a = hPutDoc handle $ prettyAnn a <> "\n"

-- | Print telemetry to the given 'Handle', one payload per line.
plain :: (PrettyAnn AnsiStyle a) => Handle -> Exporter es a
plain = Exporter.fromIO . plainIO

plainIO :: (PrettyAnn AnsiStyle a) => Handle -> a -> IO ()
plainIO handle a = hPutDoc handle $ unAnnotate @AnsiStyle (prettyAnn a) <> "\n"

-- | Print telemetry to standard output via 'console'.
stdout :: (PrettyAnn AnsiStyle a) => Exporter es a
stdout = console Handle.stdout

-- | Print telemetry to standard error via 'console'.
stderr :: (PrettyAnn AnsiStyle a) => Exporter es a
stderr = console Handle.stderr