unclogging-0.1.0.0: src/Unclog/Frontend.hs
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module Unclog.Frontend
( -- * generic logging functions
mkLogEntry
-- * communicating with the backend
, publishLogEntry
-- * helpers
, spliceLoc
)
where
import Chronos.Types (Time)
import Data.ByteString (StrictByteString)
import Data.Text qualified as T
import Language.Haskell.TH.Syntax (Code, Lift (liftTyped), Loc (Loc), Quasi (qLocation), Quote, bindCode)
import Unclog.Common
import UnliftIO
spliceLoc :: (Quote q, Quasi q) => Code q Location
spliceLoc = flip bindCode liftTyped do
Loc _ p m (pl, pr) _ <- qLocation
pure MkLocation {locpkg = T.pack p, locmod = T.pack m, locpos = MkPosition pl pr}
-- | given a 'LogChan', publish a log entry to it
publishLogEntry :: PLogChan -> LogEntry -> STM ()
publishLogEntry = writeTChan . unPLogChan
{-# INLINE publishLogEntry #-}
-- | splice in the location and loglevel
mkLogEntry :: (Quote q, Quasi q) => LogLevel -> Code q (Time -> StrictByteString -> LogEntry)
mkLogEntry lvl =
[||
\ts entry -> do
MkLogEntry
{ level = lvl
, timestamp = ts
, location = $$spliceLoc
, payload = entry
}
||]