{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans #-} module System.Metrics.TrackerInstances where import qualified Data.Text as T import Control.Monad.IO.Class import GHC.Int import System.Metrics import System.Metrics.Counter as TC import System.Metrics.Distribution as TD import System.Metrics.Gauge as TG import System.Metrics.Label as TL import System.Metrics.Monad.Class instance TrackerLike Counter where type TrackAction Counter m = m () track :: metric Counter name -> TrackAction Counter m track metric Counter name metric = metric Counter name -> m Counter forall (m :: * -> *) tracker (name :: Symbol) (metric :: * -> Symbol -> *). (MonadMetrics m, TrackerLike tracker, KnownSymbol name, Typeable metric, Ord (metric tracker name)) => metric tracker name -> m tracker getTracker metric Counter name metric m Counter -> (Counter -> m ()) -> m () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> (Counter -> IO ()) -> Counter -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . Counter -> IO () TC.inc createTracker :: Text -> Store -> IO Counter createTracker = Text -> Store -> IO Counter createCounter instance TrackerLike Distribution where type TrackAction Distribution m = Double -> m () track :: metric Distribution name -> TrackAction Distribution m track metric Distribution name metric Double val = metric Distribution name -> m Distribution forall (m :: * -> *) tracker (name :: Symbol) (metric :: * -> Symbol -> *). (MonadMetrics m, TrackerLike tracker, KnownSymbol name, Typeable metric, Ord (metric tracker name)) => metric tracker name -> m tracker getTracker metric Distribution name metric m Distribution -> (Distribution -> m ()) -> m () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Distribution distr -> IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ Distribution -> Double -> IO () TD.add Distribution distr Double val createTracker :: Text -> Store -> IO Distribution createTracker = Text -> Store -> IO Distribution createDistribution instance TrackerLike Gauge where type TrackAction Gauge m = Int64 -> m () track :: metric Gauge name -> TrackAction Gauge m track metric Gauge name metric Int64 val = metric Gauge name -> m Gauge forall (m :: * -> *) tracker (name :: Symbol) (metric :: * -> Symbol -> *). (MonadMetrics m, TrackerLike tracker, KnownSymbol name, Typeable metric, Ord (metric tracker name)) => metric tracker name -> m tracker getTracker metric Gauge name metric m Gauge -> (Gauge -> m ()) -> m () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Gauge gauge -> IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ Gauge -> Int64 -> IO () TG.set Gauge gauge Int64 val createTracker :: Text -> Store -> IO Gauge createTracker = Text -> Store -> IO Gauge createGauge instance TrackerLike Label where type TrackAction Label m = T.Text -> m () track :: metric Label name -> TrackAction Label m track metric Label name metric Text val = metric Label name -> m Label forall (m :: * -> *) tracker (name :: Symbol) (metric :: * -> Symbol -> *). (MonadMetrics m, TrackerLike tracker, KnownSymbol name, Typeable metric, Ord (metric tracker name)) => metric tracker name -> m tracker getTracker metric Label name metric m Label -> (Label -> m ()) -> m () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Label label -> IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ Label -> Text -> IO () TL.set Label label Text val createTracker :: Text -> Store -> IO Label createTracker = Text -> Store -> IO Label createLabel newtype DistrGauge = DistrGauge (Distribution, Gauge) instance TrackerLike DistrGauge where type TrackAction DistrGauge m = Int64 -> m () track :: metric DistrGauge name -> TrackAction DistrGauge m track metric DistrGauge name metric Int64 val = do DistrGauge (Distribution distr, Gauge gauge) <- metric DistrGauge name -> m DistrGauge forall (m :: * -> *) tracker (name :: Symbol) (metric :: * -> Symbol -> *). (MonadMetrics m, TrackerLike tracker, KnownSymbol name, Typeable metric, Ord (metric tracker name)) => metric tracker name -> m tracker getTracker metric DistrGauge name metric IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ do Gauge -> Int64 -> IO () TG.add Gauge gauge Int64 val Distribution -> Double -> IO () TD.add Distribution distr (Double -> IO ()) -> Double -> IO () forall a b. (a -> b) -> a -> b $ Int64 -> Double forall a b. (Integral a, Num b) => a -> b fromIntegral Int64 val createTracker :: Text -> Store -> IO DistrGauge createTracker Text name Store store = do Distribution d <- Text -> Store -> IO Distribution createDistribution (Text name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "_distr") Store store Gauge g <- Text -> Store -> IO Gauge createGauge (Text name Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "_total") Store store DistrGauge -> IO DistrGauge forall (f :: * -> *) a. Applicative f => a -> f a pure (DistrGauge -> IO DistrGauge) -> DistrGauge -> IO DistrGauge forall a b. (a -> b) -> a -> b $ (Distribution, Gauge) -> DistrGauge DistrGauge (Distribution d, Gauge g)