preamble 0.0.23 → 0.0.24

raw patch · 7 files changed

+106/−5 lines, 7 filesdep +network

Dependencies added: network

Files

• preamble.cabal +3/−1
• src/Preamble/Ctx.hs +22/−3
• src/Preamble/Prelude.hs +6/−0
• src/Preamble/Stats.hs +44/−0
• src/Preamble/Trace.hs +2/−1
• src/Preamble/Types/Alias.hs +4/−0
• src/Preamble/Types/Ctx.hs +25/−0

@@ -1,5 +1,5 @@ name:                  preamble-version:               0.0.23+version:               0.0.24 synopsis:              Yet another prelude. description:           A prelude built on basic-prelude. homepage:              https://github.com/swift-nav/preamble@@ -19,6 +19,7 @@                      , Preamble.Ctx                      , Preamble.Lens                      , Preamble.Prelude+                     , Preamble.Stats                      , Preamble.Trace                      , Preamble.Types                      , Preamble.Types.Alias@@ -36,6 +37,7 @@                      , monad-control                      , monad-logger                      , mtl+                     , network                      , resourcet                      , safe                      , template-haskell

@@ -5,10 +5,13 @@   ( runTransT   , runCtx   , preCtx+  , runStatsCtx+  , preStatsCtx   ) where  import Control.Monad.Logger import Control.Monad.Reader+import Network.Socket import Preamble.Prelude import Preamble.Trace import Preamble.Types@@ -21,9 +24,9 @@  -- | Run base context. ---runCtx :: MonadIO m => TransT Ctx m a -> m a-runCtx action = do-  t <- liftIO $ newStderrTrace LevelInfo+runCtx :: MonadIO m => LogLevel -> TransT Ctx m a -> m a+runCtx level action = do+  t <- liftIO $ newStderrTrace level   runTransT (Ctx mempty t) action  -- | Update base context's preamble.@@ -33,3 +36,19 @@   c <- view ctx <&> cPreamble <>~ preamble   runTransT c action +-- | Run stats context.+--+runStatsCtx :: MonadCtx c m => String -> TransT StatsCtx m a -> m a+runStatsCtx host action = do+  c <- view ctx+  s <- liftIO $ socket AF_INET Datagram defaultProtocol+  a <- liftIO $ inet_addr host+  let sa = SockAddrInet 8125 a+  runTransT (StatsCtx c s sa) 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

@@ -15,6 +15,7 @@   , boolThrowIO   , textFromString   , (-/-)+  , (-|-)   , (-.-)   , (-:-)   ) where@@ -74,6 +75,11 @@ -- (-/-) :: (IsString s, Monoid s) => s -> s -> s (-/-) = (<>) . (<> "/")++-- | <|> for IsString.+--+(-|-) :: (IsString s, Monoid s) => s -> s -> s+(-|-) = (<>) . (<> "|")  -- | <.> for IsString. --

@@ -0,0 +1,44 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++-- | StatsD functionality.+--+module Preamble.Stats+  ( statsCount+  , statsGauge+  , statsHistogram+  , statsTimer+  , statsSet+  ) where++import Network.Socket.ByteString+import Preamble.Prelude+import Preamble.Types++sendto :: MonadStatsCtx c m => ByteString -> m ()+sendto metric = do+  s <- view scSocket+  a <- view scSockAddr+  liftIO $ void $ sendTo s metric a++stats :: (MonadStatsCtx c m, Num a, Show a) => Text -> Text -> a -> Tags -> m ()+stats stat name value tags = do+  let metric = name -:- show value -|- stat+      tagged = intercalate "," $ flip map tags $ uncurry (-:-)+  sendto $ encodeUtf8 $ bool (metric -|- "#" <> tagged) metric $ null tags++statsCount :: (MonadStatsCtx c m, Num a, Show a) => Text -> a -> Tags -> m ()+statsCount = stats "c"++statsGauge :: (MonadStatsCtx c m, Num a, Show a) => Text -> a -> Tags -> m ()+statsGauge = stats "g"++statsHistogram :: (MonadStatsCtx c m, Num a, Show a) => Text -> a -> Tags -> m ()+statsHistogram = stats "h"++statsTimer :: (MonadStatsCtx c m, Num a, Show a) => Text -> a -> Tags -> m ()+statsTimer = stats "ms"++statsSet :: (MonadStatsCtx c m, Num a, Show a) => Text -> a -> Tags -> m ()+statsSet = stats "s"

@@ -5,7 +5,8 @@ -- | Tracing functionality around MonadLogger. -- module Preamble.Trace-  ( newStderrTrace+  ( LogLevel (..)+  , newStderrTrace   , newStdoutTrace   , nullTrace   , traceDebug

@@ -19,6 +19,10 @@ -- type Pairs = [(Text, Value)] +-- | Tags+--+type Tags = [(Text, Text)]+ -- | Trace -- type Trace = Loc -> LogSource -> LogLevel -> LogStr -> IO ()

@@ -12,6 +12,8 @@ import Control.Monad.Catch import Control.Monad.Logger import Control.Monad.Reader+import Network.Socket+import Preamble.Lens import Preamble.Prelude import Preamble.Types.Alias @@ -35,4 +37,27 @@   , MonadCatch m   , MonadThrow m   , HasCtx c+  )++-- | StatsCtx+--+-- Stats context.+--+data StatsCtx = StatsCtx+  { _scCtx      :: Ctx+    -- ^ Parent environment.+  , _scSocket   :: Socket+    -- ^ UDP Socket for statsd.+  , _scSockAddr :: SockAddr+    -- ^ UDP SockAddr for statsd.+  }++$(makeClassyConstraints ''StatsCtx [''HasCtx])++instance HasCtx StatsCtx where+  ctx = scCtx++type MonadStatsCtx c m =+  ( MonadCtx c m+  , HasStatsCtx c   )