Json.hs

{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | The 'IO' + @Json@ frontend. Using 'MonadUnliftIO' to abstract over things in 'IO'
module Unclog.IO.Json
  ( -- * logging functions for different log levels
    debug
  , info
  , warn
  , fatal

    -- * run the frontend
  , withLoggingWithSubscribers

    -- * helpers
  , logJson
  )
where

import Chronos (now)
import Data.Aeson (Value (Object), encode)
import Data.ByteString qualified as BS
import Language.Haskell.TH.Syntax (Exp, Q, unTypeCode)
import Unclog.Common (LogLevel (..))
import Unclog.Frontend (mkLogEntry, publishLogEntry)
import Unclog.Subscriber (withLoggingWithSubscribers)
import UnliftIO (atomically, liftIO)

logJson :: LogLevel -> Q Exp
logJson lvl =
  [|
    \chan obj -> liftIO do
      ts <- now -- TODO(mangoiv): should be cached
      let entry = $(unTypeCode $ mkLogEntry lvl) ts (BS.toStrict . encode $ Object obj)
      atomically $ publishLogEntry chan entry
    |]

debug :: Q Exp
debug = logJson Debug

info :: Q Exp
info = logJson Info

warn :: Q Exp
warn = logJson Warn

fatal :: Q Exp
fatal = logJson Fatal