module Prometheus.Metric.Observer (
    Observer(..)
,   observeDuration
,   timeAction
) where

import Data.Ratio ((%))
import Prometheus.MonadMonitor

import Control.Monad.IO.Class
import System.Clock (Clock(..), diffTimeSpec, getTime, toNanoSecs)

-- | Interface shared by 'Summary' and 'Histogram'.
class Observer metric where
    -- | Observe that a particular floating point value has occurred.
    -- For example, observe that this request took 0.23s.
    observe :: MonadMonitor m => metric -> Double -> m ()

-- | Adds the duration in seconds of an IO action as an observation to an
-- observer metric.
--
-- If the IO action throws an exception no duration will be observed.
observeDuration :: (Observer metric, MonadIO m, MonadMonitor m) => metric -> m a -> m a
observeDuration :: forall metric (m :: * -> *) a.
(Observer metric, MonadIO m, MonadMonitor m) =>
metric -> m a -> m a
observeDuration metric
metric m a
io = do
    (a
result, Double
duration) <- forall (m :: * -> *) a. MonadIO m => m a -> m (a, Double)
timeAction m a
io
    forall metric (m :: * -> *).
(Observer metric, MonadMonitor m) =>
metric -> Double -> m ()
observe metric
metric Double
duration 
    forall (m :: * -> *) a. Monad m => a -> m a
return a
result


-- | Evaluate @io@ and return its result as well as how long it took to evaluate,
-- in seconds.
timeAction :: MonadIO m => m a -> m (a, Double)
timeAction :: forall (m :: * -> *) a. MonadIO m => m a -> m (a, Double)
timeAction m a
io = do
    TimeSpec
start  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
    a
result <- m a
io
    TimeSpec
end    <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
    let duration :: Ratio Integer
duration = TimeSpec -> Integer
toNanoSecs (TimeSpec
end TimeSpec -> TimeSpec -> TimeSpec
`diffTimeSpec` TimeSpec
start) forall a. Integral a => a -> a -> Ratio a
% Integer
1000000000
    forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, forall a. Fractional a => Ratio Integer -> a
fromRational Ratio Integer
duration)