packages feed

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
      }
  ||]