https://github.com/tibbe/ekg-core/issues/12

ekg-dynamic.hs

module System.Metrics.Dynamic
    ( findOrCreateCounter
    , findOrCreateDistribution
    , findOrCreateGauge
    , findOrCreateLabel
    ) where

import qualified Data.IORef as IORef
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text
import qualified System.IO.Unsafe as Unsafe
import qualified System.Metrics as Metrics
import qualified System.Metrics.Counter as Counter
import qualified System.Metrics.Distribution as Distribution
import qualified System.Metrics.Gauge as Gauge
import qualified System.Metrics.Label as Label

findOrCreateCounter :: Text.Text -> Metrics.Store -> IO Counter.Counter
findOrCreateCounter =
    findOrCreateMetric countersRef Metrics.createCounter

findOrCreateDistribution :: Text.Text -> Metrics.Store -> IO Distribution.Distribution
findOrCreateDistribution =
    findOrCreateMetric distributionsRef Metrics.createDistribution

findOrCreateGauge :: Text.Text -> Metrics.Store -> IO Gauge.Gauge
findOrCreateGauge =
    findOrCreateMetric gaugesRef Metrics.createGauge

findOrCreateLabel :: Text.Text -> Metrics.Store -> IO Label.Label
findOrCreateLabel =
    findOrCreateMetric labelsRef Metrics.createLabel

--

type Ref a = IORef.IORef (Map.Map Text.Text a)

findOrCreateMetric :: Ref a -> (Text.Text -> Metrics.Store -> IO a) -> Text.Text -> Metrics.Store -> IO a
findOrCreateMetric ref create name store = do
    metrics <- IORef.readIORef ref
    case Map.lookup name metrics of
        Just metric -> pure metric
        Nothing -> createMetric ref create name store

createMetric :: Ref a -> (Text.Text -> Metrics.Store -> IO a) -> Text.Text -> Metrics.Store -> IO a
createMetric ref create name store = do
    metric <- create name store
    modifyIORef ref (Map.insert name metric)
    pure metric

modifyIORef :: IORef.IORef a -> (a -> a) -> IO ()
modifyIORef ref modify =
    IORef.atomicModifyIORef' ref (\ value -> (modify value, ()))

--

countersRef :: Ref Counter.Counter
countersRef = unsafeNewIORef Map.empty

distributionsRef :: Ref Distribution.Distribution
distributionsRef = unsafeNewIORef Map.empty

gaugesRef :: Ref Gauge.Gauge
gaugesRef = unsafeNewIORef Map.empty

labelsRef :: Ref Label.Label
labelsRef = unsafeNewIORef Map.empty

-- Here be dragons!

unsafeNewIORef :: a -> IORef.IORef a
unsafeNewIORef value = Unsafe.unsafePerformIO (IORef.newIORef value)
{-# NOINLINE unsafeNewIORef #-}