-- | Stateful gauges for Datadog
module Freckle.App.Datadog.Gauge
  ( Gauge
  , new
  , increment
  , decrement
  , add
  , subtract
  ) where

import Freckle.App.Prelude hiding (subtract)

import Freckle.App.Datadog (HasDogStatsClient, HasDogStatsTags, gauge)
import qualified System.Metrics.Gauge as EKG

-- | A data type containing all reporting values for a gauge
data Gauge = Gauge
  { Gauge -> Text
name :: Text
  , Gauge -> [(Text, Text)]
tags :: [(Text, Text)]
  , Gauge -> Gauge
ekgGauge :: EKG.Gauge
  }

-- | Create a gauge holding in memory state
new :: MonadIO m => Text -> [(Text, Text)] -> m Gauge
new :: Text -> [(Text, Text)] -> m Gauge
new Text
name [(Text, Text)]
tags = Text -> [(Text, Text)] -> Gauge -> Gauge
Gauge Text
name [(Text, Text)]
tags (Gauge -> Gauge) -> m Gauge -> m Gauge
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Gauge -> m Gauge
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Gauge
EKG.new

-- | Increment gauge state and report its current value
increment
  :: ( MonadUnliftIO m
     , MonadReader env m
     , HasDogStatsClient env
     , HasDogStatsTags env
     )
  => Gauge
  -> m ()
increment :: Gauge -> m ()
increment = Int64 -> Gauge -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Int64 -> Gauge -> m ()
add Int64
1

-- | Add to gauge state and report its current value
add
  :: ( MonadUnliftIO m
     , MonadReader env m
     , HasDogStatsClient env
     , HasDogStatsTags env
     )
  => Int64
  -> Gauge
  -> m ()
add :: Int64 -> Gauge -> m ()
add Int64
i = (Gauge -> IO ()) -> Gauge -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
(Gauge -> IO ()) -> Gauge -> m ()
withEKGGauge (Gauge -> Int64 -> IO ()
`EKG.add` Int64
i)

-- | Decrement gauge state and report its current value
decrement
  :: ( MonadUnliftIO m
     , MonadReader env m
     , HasDogStatsClient env
     , HasDogStatsTags env
     )
  => Gauge
  -> m ()
decrement :: Gauge -> m ()
decrement = Int64 -> Gauge -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Int64 -> Gauge -> m ()
subtract Int64
1

-- | Subtract from gauge state and report its current value
subtract
  :: ( MonadUnliftIO m
     , MonadReader env m
     , HasDogStatsClient env
     , HasDogStatsTags env
     )
  => Int64
  -> Gauge
  -> m ()
subtract :: Int64 -> Gauge -> m ()
subtract Int64
i = (Gauge -> IO ()) -> Gauge -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
(Gauge -> IO ()) -> Gauge -> m ()
withEKGGauge (Gauge -> Int64 -> IO ()
`EKG.subtract` Int64
i)

withEKGGauge
  :: ( MonadUnliftIO m
     , MonadReader env m
     , HasDogStatsClient env
     , HasDogStatsTags env
     )
  => (EKG.Gauge -> IO ())
  -> Gauge
  -> m ()
withEKGGauge :: (Gauge -> IO ()) -> Gauge -> m ()
withEKGGauge Gauge -> IO ()
f Gauge {[(Text, Text)]
Text
Gauge
ekgGauge :: Gauge
tags :: [(Text, Text)]
name :: Text
ekgGauge :: Gauge -> Gauge
tags :: Gauge -> [(Text, Text)]
name :: Gauge -> Text
..} = do
  Int64
current <- IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Gauge -> IO ()
f Gauge
ekgGauge
    Gauge -> IO Int64
EKG.read Gauge
ekgGauge
  Text -> [(Text, Text)] -> Double -> m ()
forall (m :: * -> *) env.
(MonadUnliftIO m, MonadReader env m, HasDogStatsClient env,
 HasDogStatsTags env) =>
Text -> [(Text, Text)] -> Double -> m ()
gauge Text
name [(Text, Text)]
tags (Double -> m ()) -> Double -> m ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
current