{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} module Preamble.Ctx ( runTransT , runCtx , preCtx , runStatsCtx , preStatsCtx , labStatsCtx ) where import Control.Monad.Logger import Control.Monad.Reader import Network.Socket hiding (sendTo) import Network.Socket.ByteString import Preamble.Prelude import Preamble.Trace import Preamble.Types import System.Environment -- | Run monad transformer, picking up logger from context. -- runTransT :: HasCtx c => c -> TransT c m a -> m a runTransT c m = runReaderT (runLoggingT (unTransT m) (c ^. cLogger)) c -- | Run base context. -- runCtx :: MonadIO m => TransT Ctx m a -> m a runCtx action = do t <- liftIO $ newStderrLogger LevelInfo runTransT (Ctx mempty t) action -- | Update base context's preamble. -- preCtx :: MonadCtx c m => Pairs -> TransT Ctx m a -> m a preCtx preamble action = do c <- view ctx <&> cPreamble <>~ preamble runTransT c action -- | Run stats context. -- runStatsCtx :: MonadCtx c m => TransT StatsCtx m a -> m a runStatsCtx action = do c <- view ctx s <- liftIO $ socket AF_INET Datagram defaultProtocol h <- liftIO $ fromMaybe "127.0.0.1" <$> lookupEnv "STATS_HOST" a <- liftIO $ inet_addr h let stat m = void $ sendTo s m $ SockAddrInet 8125 a runTransT (StatsCtx c mempty stat mempty) action -- | Update stats context's preamble. -- preStatsCtx :: MonadStatsCtx c m => Pairs -> TransT StatsCtx m a -> m a preStatsCtx preamble action = do c <- view statsCtx <&> cPreamble <>~ preamble runTransT c action -- | Update stats context's labels. -- labStatsCtx :: MonadStatsCtx c m => Tags -> TransT StatsCtx m a -> m a labStatsCtx labels action = do c <- view statsCtx <&> scLabels <>~ labels runTransT c action