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 (MVar Registry -> Registry) -> IO (MVar Registry) -> IO Registry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Registry -> IO (MVar Registry)
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 = (MVar Registry
 -> (Registry -> IO (Registry, Counter)) -> IO Counter)
-> (Registry -> IO (Registry, Counter))
-> MVar Registry
-> IO Counter
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar Registry -> (Registry -> IO (Registry, Counter)) -> IO Counter
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked Registry -> IO (Registry, Counter)
register (MVar Registry -> IO Counter)
-> (Registry -> MVar Registry) -> Registry -> IO Counter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry
  where
    register :: Registry -> IO (Registry, Counter)
register = ((Counter, Registry) -> (Registry, Counter))
-> IO (Counter, Registry) -> IO (Registry, Counter)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Counter, Registry) -> (Registry, Counter)
forall a b. (a, b) -> (b, a)
swap (IO (Counter, Registry) -> IO (Registry, Counter))
-> (Registry -> IO (Counter, Registry))
-> Registry
-> IO (Registry, Counter)
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 = (MVar Registry -> (Registry -> IO (Registry, Gauge)) -> IO Gauge)
-> (Registry -> IO (Registry, Gauge)) -> MVar Registry -> IO Gauge
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar Registry -> (Registry -> IO (Registry, Gauge)) -> IO Gauge
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked Registry -> IO (Registry, Gauge)
register (MVar Registry -> IO Gauge)
-> (Registry -> MVar Registry) -> Registry -> IO Gauge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry
  where
    register :: Registry -> IO (Registry, Gauge)
register = ((Gauge, Registry) -> (Registry, Gauge))
-> IO (Gauge, Registry) -> IO (Registry, Gauge)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Gauge, Registry) -> (Registry, Gauge)
forall a b. (a, b) -> (b, a)
swap (IO (Gauge, Registry) -> IO (Registry, Gauge))
-> (Registry -> IO (Gauge, Registry))
-> Registry
-> IO (Registry, Gauge)
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 = (MVar Registry
 -> (Registry -> IO (Registry, Histogram)) -> IO Histogram)
-> (Registry -> IO (Registry, Histogram))
-> MVar Registry
-> IO Histogram
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar Registry
-> (Registry -> IO (Registry, Histogram)) -> IO Histogram
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked Registry -> IO (Registry, Histogram)
register (MVar Registry -> IO Histogram)
-> (Registry -> MVar Registry) -> Registry -> IO Histogram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry
  where
    register :: Registry -> IO (Registry, Histogram)
register = ((Histogram, Registry) -> (Registry, Histogram))
-> IO (Histogram, Registry) -> IO (Registry, Histogram)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Histogram, Registry) -> (Registry, Histogram)
forall a b. (a, b) -> (b, a)
swap (IO (Histogram, Registry) -> IO (Registry, Histogram))
-> (Registry -> IO (Histogram, Registry))
-> Registry
-> IO (Registry, Histogram)
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 = (MVar Registry -> (Registry -> IO (Registry, ())) -> IO ())
-> (Registry -> IO (Registry, ())) -> MVar Registry -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip MVar Registry -> (Registry -> IO (Registry, ())) -> IO ()
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMasked Registry -> IO (Registry, ())
forall {f :: * -> *}. Applicative f => Registry -> f (Registry, ())
remove (MVar Registry -> IO ())
-> (Registry -> MVar Registry) -> Registry -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry
  where
    remove :: Registry -> f (Registry, ())
remove Registry
reg = (Registry, ()) -> f (Registry, ())
forall a. a -> f a
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 = (Registry -> [MetricId]) -> IO Registry -> IO [MetricId]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Registry -> [MetricId]
R.listMetricIds (IO Registry -> IO [MetricId])
-> (Registry -> IO Registry) -> Registry -> IO [MetricId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar Registry -> IO Registry
forall a. MVar a -> IO a
readMVar (MVar Registry -> IO Registry)
-> (Registry -> MVar Registry) -> Registry -> IO Registry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Registry -> MVar Registry
unRegistry


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