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) = seq :: 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 = forall s. IO (s, IO [SampleGroup]) -> Metric s
Metric forall a b. (a -> b) -> a -> b
$ do
    IORef Double
ioref <- forall a. a -> IO (IORef a)
IORef.newIORef Double
0
    forall (m :: * -> *) a. Monad m => a -> m a
return (IORef Double -> Gauge
MkGauge IORef Double
ioref, Info -> IORef Double -> IO [SampleGroup]
collectGauge Info
info IORef Double
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 =
    forall (m :: * -> *). MonadMonitor m => IO () -> m ()
doIO forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g Double -> Double
add
    where add :: Double -> Double
add Double
i = Double
i seq :: forall a b. a -> b -> b
`seq` Double
x seq :: forall a b. a -> b -> b
`seq` Double
i 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 = forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g Double -> Double
sub
    where sub :: Double -> Double
sub Double
i = Double
i seq :: forall a b. a -> b -> b
`seq` Double
x seq :: forall a b. a -> b -> b
`seq` Double
i 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 = forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g (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 = forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g (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 = forall (m :: * -> *).
MonadMonitor m =>
Gauge -> (Double -> Double) -> m ()
withGauge Gauge
g 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) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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
    (a
result, Double
duration) <- forall (m :: * -> *) a. MonadIO m => m a -> m (a, Double)
timeAction m a
io
    forall (m :: * -> *). MonadMonitor m => Gauge -> Double -> m ()
setGauge Gauge
metric Double
duration 
    forall (m :: * -> *) a. Monad m => a -> m a
return a
result

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