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


import           Control.Applicative                        ((<$>))
import           Control.Concurrent.MVar                    (MVar,
                                                             modifyMVarMasked,
                                                             newMVar, 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, 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 (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 (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 (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


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