module Prometheus.Metric.Gauge (
    Gauge
,   gauge
,   incGauge
,   decGauge
,   addGauge
,   subGauge
,   setGauge
,   setGaugeToDuration
,   getGauge
) where

import Prometheus.Info
import Prometheus.Metric
import Prometheus.Metric.Observer (timeAction)
import Prometheus.MonadMonitor

import Control.DeepSeq
import Control.Monad.IO.Class
import qualified Data.Atomics as Atomics
import qualified Data.ByteString.UTF8 as BS
import qualified Data.IORef as IORef


newtype Gauge = MkGauge (IORef.IORef Double)

instance NFData Gauge where
  rnf :: Gauge -> ()
rnf (MkGauge IORef Double
ioref) = IORef Double -> () -> ()
forall a b. a -> b -> b
seq IORef Double
ioref ()

-- | Create a new gauge metric with a given name and help string.
gauge :: Info -> Metric Gauge
gauge :: Info -> Metric Gauge
gauge Info
info = IO (Gauge, IO [SampleGroup]) -> Metric Gauge
forall s. IO (s, IO [SampleGroup]) -> Metric s
Metric (IO (Gauge, IO [SampleGroup]) -> Metric Gauge)
-> IO (Gauge, IO [SampleGroup]) -> Metric Gauge
forall a b. (a -> b) -> a -> b
$ do
    ioref <- Double -> IO (IORef Double)
forall a. a -> IO (IORef a)
IORef.newIORef Double
0
    return (MkGauge ioref, collectGauge info ioref)

withGauge :: MonadMonitor m
          => Gauge
          -> (Double -> Double)
          -> m ()
withGauge :: forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge (MkGauge IORef Double
ioref) Double -> Double
f =
    IO () -> m ()
forall (m :: * -> *). MonadMonitor m => IO () -> m ()
doIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef Double -> (Double -> Double) -> IO ()
forall t. IORef t -> (t -> t) -> IO ()
Atomics.atomicModifyIORefCAS_ IORef Double
ioref Double -> Double
f

-- | Adds a value to a gauge metric.
addGauge :: MonadMonitor m => Gauge -> Double -> m ()
addGauge :: forall (m :: * -> *). MonadMonitor m => Gauge -> Double -> m ()
addGauge Gauge
g Double
x = Gauge -> (Double -> Double) -> m ()
forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g Double -> Double
add
    where add :: Double -> Double
add Double
i = Double
i Double -> Double -> Double
forall a b. a -> b -> b
`seq` Double
x Double -> Double -> Double
forall a b. a -> b -> b
`seq` Double
i Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x

-- | Subtracts a value from a gauge metric.
subGauge :: MonadMonitor m => Gauge -> Double -> m ()
subGauge :: forall (m :: * -> *). MonadMonitor m => Gauge -> Double -> m ()
subGauge Gauge
g Double
x = Gauge -> (Double -> Double) -> m ()
forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g Double -> Double
sub
    where sub :: Double -> Double
sub Double
i = Double
i Double -> Double -> Double
forall a b. a -> b -> b
`seq` Double
x Double -> Double -> Double
forall a b. a -> b -> b
`seq` Double
i Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x

-- | Increments a gauge metric by 1.
incGauge :: MonadMonitor m => Gauge -> m ()
incGauge :: forall (m :: * -> *). MonadMonitor m => Gauge -> m ()
incGauge Gauge
g = Gauge -> (Double -> Double) -> m ()
forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1)

-- | Decrements a gauge metric by 1.
decGauge :: MonadMonitor m => Gauge -> m ()
decGauge :: forall (m :: * -> *). MonadMonitor m => Gauge -> m ()
decGauge Gauge
g = Gauge -> (Double -> Double) -> m ()
forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (-Double
1))

-- | Sets a gauge metric to a specific value.
setGauge :: MonadMonitor m => Gauge -> Double -> m ()
setGauge :: forall (m :: * -> *). MonadMonitor m => Gauge -> Double -> m ()
setGauge Gauge
g Double
r = Gauge -> (Double -> Double) -> m ()
forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g Double -> Double
forall {p}. p -> Double
set
    where set :: p -> Double
set p
_ = Double
r

-- | Retrieves the current value of a gauge metric.
getGauge :: MonadIO m => Gauge -> m Double
getGauge :: forall (m :: * -> *). MonadIO m => Gauge -> m Double
getGauge (MkGauge IORef Double
ioref) = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ IORef Double -> IO Double
forall a. IORef a -> IO a
IORef.readIORef IORef Double
ioref

-- | Sets a gauge metric to the duration in seconds of an IO action.
setGaugeToDuration :: (MonadIO m, MonadMonitor m) => Gauge -> m a -> m a
setGaugeToDuration :: forall (m :: * -> *) a.
(MonadIO m, MonadMonitor m) =>
Gauge -> m a -> m a
setGaugeToDuration Gauge
metric m a
io = do
    (result, duration) <- m a -> m (a, Double)
forall (m :: * -> *) a. MonadIO m => m a -> m (a, Double)
timeAction m a
io
    setGauge metric duration 
    return result

collectGauge :: Info -> IORef.IORef Double -> IO [SampleGroup]
collectGauge :: Info -> IORef Double -> IO [SampleGroup]
collectGauge Info
info IORef Double
c = do
    value <- IORef Double -> IO Double
forall a. IORef a -> IO a
IORef.readIORef IORef Double
c
    let sample = Text -> LabelPairs -> ByteString -> Sample
Sample (Info -> Text
metricName Info
info) [] (String -> ByteString
BS.fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
value)
    return [SampleGroup info GaugeType [sample]]