module System.Metrics.Prometheus.Concurrent.Registry (
    Registry,
    new,
    registerCounter,
    registerGauge,
    registerHistogram,
    listMetricIds,
    removeMetric,
    sample,
) where

import Control.Applicative ((<$>))
import Control.Concurrent.MVar (
    MVar,
    modifyMVarMasked,
    newMVar,
    readMVar,
    withMVar,
 )
import Data.Tuple (swap)

import System.Metrics.Prometheus.Metric.Counter (Counter)
import System.Metrics.Prometheus.Metric.Gauge (Gauge)
import System.Metrics.Prometheus.Metric.Histogram (
    Histogram,
    UpperBound,
 )
import System.Metrics.Prometheus.MetricId (
    Labels,
    MetricId,
    Name,
 )
import qualified System.Metrics.Prometheus.Registry as R


newtype Registry = Registry {Registry -> MVar Registry
unRegistry :: MVar R.Registry}


new :: IO Registry
new :: IO Registry
new = MVar Registry -> Registry
Registry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
newMVar Registry
R.new


registerCounter :: Name -> Labels -> Registry -> IO Counter
registerCounter :: Name -> Labels -> Registry -> IO Counter
registerCounter Name
name Labels
labels = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked Registry -> IO (Registry, Counter)
register forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry
  where
    register :: Registry -> IO (Registry, Counter)
register = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Labels -> Registry -> IO (Counter, Registry)
R.registerCounter Name
name Labels
labels


registerGauge :: Name -> Labels -> Registry -> IO Gauge
registerGauge :: Name -> Labels -> Registry -> IO Gauge
registerGauge Name
name Labels
labels = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked Registry -> IO (Registry, Gauge)
register forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry
  where
    register :: Registry -> IO (Registry, Gauge)
register = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Labels -> Registry -> IO (Gauge, Registry)
R.registerGauge Name
name Labels
labels


registerHistogram :: Name -> Labels -> [UpperBound] -> Registry -> IO Histogram
registerHistogram :: Name -> Labels -> [UpperBound] -> Registry -> IO Histogram
registerHistogram Name
name Labels
labels [UpperBound]
buckets = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked Registry -> IO (Registry, Histogram)
register forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry
  where
    register :: Registry -> IO (Registry, Histogram)
register = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name
-> Labels -> [UpperBound] -> Registry -> IO (Histogram, Registry)
R.registerHistogram Name
name Labels
labels [UpperBound]
buckets


removeMetric :: MetricId -> Registry -> IO ()
removeMetric :: MetricId -> Registry -> IO ()
removeMetric MetricId
i = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked forall {f :: * -> *}. Applicative f => Registry -> f (Registry, ())
remove forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry
  where
    remove :: Registry -> f (Registry, ())
remove Registry
reg = forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetricId -> Registry -> Registry
R.removeMetric MetricId
i Registry
reg, ())


listMetricIds :: Registry -> IO [MetricId]
listMetricIds :: Registry -> IO [MetricId]
listMetricIds = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Registry -> [MetricId]
R.listMetricIds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO a
readMVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry


sample :: Registry -> IO R.RegistrySample
sample :: Registry -> IO RegistrySample
sample = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. MVar a -> (a -> IO b) -> IO b
withMVar Registry -> IO RegistrySample
R.sample forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry