{-# 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)