{-# LANGUAGE ExistentialQuantification #-}
module Prometheus.Registry (
register
, registerIO
, unsafeRegister
, unsafeRegisterIO
, collectMetrics
, unregisterAll
) where
import Prometheus.Metric
import Control.Applicative ((<$>))
import Control.Monad.IO.Class
import System.IO.Unsafe (unsafePerformIO)
import qualified Control.Concurrent.STM as STM
type Registry = [IO [SampleGroup]]
{-# NOINLINE globalRegistry #-}
globalRegistry :: STM.TVar Registry
globalRegistry = unsafePerformIO $ STM.newTVarIO []
register :: MonadIO m => Metric s -> m s
register (Metric mk) = liftIO $ do
(metric, sampleGroups) <- mk
let addToRegistry = (sampleGroups :)
liftIO $ STM.atomically $ STM.modifyTVar' globalRegistry addToRegistry
return metric
registerIO :: MonadIO m => m (Metric s) -> m s
registerIO metricGen = metricGen >>= register
unsafeRegister :: Metric s -> s
unsafeRegister = unsafePerformIO . register
unsafeRegisterIO :: IO (Metric s) -> s
unsafeRegisterIO = unsafePerformIO . registerIO
unregisterAll :: MonadIO m => m ()
unregisterAll = liftIO $ STM.atomically $ STM.writeTVar globalRegistry []
collectMetrics :: MonadIO m => m [SampleGroup]
collectMetrics = liftIO $ do
registry <- STM.atomically $ STM.readTVar globalRegistry
concat <$> sequence registry