{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE UndecidableInstances #-}

{-|
Module      : Control.Monad.Metrics
Description : An easy interface to recording metrics.
Copyright   : (c) Matt Parsons, 2017
                  Taylor Fausak, 2016
License     : MIT
Maintainer  : parsonsmatt@gmail.com
Stability   : experimental
Portability : POSIX

This module presents an easy interface that you can use to collect metrics
about your application.  It uses EKG from "System.Metrics" under the hood
and is inspired by Taylor Fausak's <https://github.com/tfausak/blunt blunt>
application.

This module is designed to be imported qualified.
-}
module Control.Monad.Metrics
    ( -- * The Type Class
      MonadMetrics(..)
      -- * Initializing
      -- $initializing
    , initialize
    , initializeWith
    , run
    , run'
      -- * Collecting Metrics
      -- $collecting
    , increment
    , counter
    , counter'
    , gauge
    , gauge'
    , gaugeIncrement
    , gaugeDecrement
    , distribution
    , timed
    , timed'
    , timedList
    , label
    , label'
    , Resolution(..)
    -- * The Metrics Type
    -- $metrictype
    , Metrics
    , metricsCounters
    , metricsGauges
    , metricsLabels
    , metricsStore
    ) where

import           Control.Monad                  (liftM, forM_)
import           Control.Monad.Catch            (MonadMask, bracket)
import           Control.Monad.IO.Class         (MonadIO (..))
import           Control.Monad.Reader           (MonadReader (..), ReaderT (..))
import           Control.Monad.Trans            (MonadTrans (..))
import           Data.Hashable                  (Hashable)
import           Data.HashMap.Strict            (HashMap)
import qualified Data.HashMap.Strict            as HashMap
import           Data.IORef                     (IORef, atomicModifyIORef',
                                                 newIORef)
import           Data.Monoid                    (mempty)
import           Data.Text                      (Text)
import qualified Data.Text                      as Text
import           System.Clock                   (Clock (..), getTime)
import           System.IO.Unsafe               (unsafeInterleaveIO)
import qualified System.Metrics                 as EKG
import           System.Metrics.Counter         as Counter
import           System.Metrics.Distribution    as Distribution
import           System.Metrics.Gauge           as Gauge
import           System.Metrics.Label           as Label

import           Prelude

import           Control.Monad.Metrics.Internal

-- | A type can be an instance of 'MonadMetrics' if it can provide a 'Metrics'
-- somehow. Commonly, this will be implemented as a 'ReaderT' where some
-- field in the environment is the 'Metrics' data.
--
-- * /Since v0.1.0.0/
class Monad m => MonadMetrics m where
    getMetrics :: m Metrics

instance {-# OVERLAPPABLE #-} (MonadMetrics m, MonadTrans t, Monad (t m)) => MonadMetrics (t m) where
    getMetrics :: t m Metrics
getMetrics = m Metrics -> t m Metrics
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Metrics
forall (m :: * -> *). MonadMetrics m => m Metrics
getMetrics

instance Monad m => MonadMetrics (ReaderT Metrics m) where
    getMetrics :: ReaderT Metrics m Metrics
getMetrics = ReaderT Metrics m Metrics
forall r (m :: * -> *). MonadReader r m => m r
ask

-- $initializing
-- This library tends to provide simple functions with plain names and
-- generalized functions with apostrophes. When initializing the metrics,
-- you can use 'initialize' if you don't need fine control over the store,
-- or you can use 'initializeWith' if your application already has a store
-- that it uses.
--
-- Likewise, we provide 'run' for the simplest case, and 'run'' for the
-- more complex case where you have some larger type.
--
-- The most flexible way to use the library is to implement the
-- 'MonadMetrics' class.

-- | Enhances the base monad with metrics. This works for very simple
-- cases, where you don't have a 'Reader' involved yet. If your stack
-- already has a 'Reader', then you'll get some annoying type problems with
-- this. Switch over to 'run'', or alternatively, define your own
-- 'MonadMetrics' instance.
--
-- */Since v0.1.0.0/
run :: MonadIO m => ReaderT Metrics m a -> m a
run :: ReaderT Metrics m a -> m a
run = (Metrics -> Metrics) -> ReaderT Metrics m a -> m a
forall (m :: * -> *) r a.
MonadIO m =>
(Metrics -> r) -> ReaderT r m a -> m a
run' Metrics -> Metrics
forall a. a -> a
id

-- | Adds metric recording capabilities to the given action. The first
-- parameter is a function which accepts a 'Metrics' value and creates the
-- final @r@ value to be used in the action. This is useful when you have
-- a preexisting 'ReaderT' in your stack, and you want to enhance it with
-- metrics.
--
-- @
-- data Config = Config { size :: Int, metrics' :: Metrics }
--
-- main = 'runWithMetrics' (Config 10) $ do
--     num <- asks size
--     forM_ [1 .. size] \_ -> Metrics.increment "foo"
-- @
--
-- */Since v0.1.0.0/
run' :: MonadIO m => (Metrics -> r) -> ReaderT r m a -> m a
run' :: (Metrics -> r) -> ReaderT r m a -> m a
run' Metrics -> r
k ReaderT r m a
action = do
    Metrics
m <- IO Metrics -> m Metrics
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Metrics
initialize
    ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
action (Metrics -> r
k Metrics
m)

-- | Initializes a 'Metrics' value with the given 'System.Metrics.Store'.
--
-- */Since v0.1.0.0/
initializeWith :: EKG.Store -> IO Metrics
initializeWith :: Store -> IO Metrics
initializeWith Store
_metricsStore = do
    IORef (HashMap Text Counter)
_metricsCounters <- HashMap Text Counter -> IO (IORef (HashMap Text Counter))
forall a. a -> IO (IORef a)
newIORef HashMap Text Counter
forall a. Monoid a => a
mempty
    IORef (HashMap Text Distribution)
_metricsDistributions <- HashMap Text Distribution -> IO (IORef (HashMap Text Distribution))
forall a. a -> IO (IORef a)
newIORef HashMap Text Distribution
forall a. Monoid a => a
mempty
    IORef (HashMap Text Gauge)
_metricsGauges <- HashMap Text Gauge -> IO (IORef (HashMap Text Gauge))
forall a. a -> IO (IORef a)
newIORef HashMap Text Gauge
forall a. Monoid a => a
mempty
    IORef (HashMap Text Label)
_metricsLabels <- HashMap Text Label -> IO (IORef (HashMap Text Label))
forall a. a -> IO (IORef a)
newIORef HashMap Text Label
forall a. Monoid a => a
mempty
    Metrics -> IO Metrics
forall (m :: * -> *) a. Monad m => a -> m a
return Metrics :: IORef (HashMap Text Counter)
-> IORef (HashMap Text Gauge)
-> IORef (HashMap Text Distribution)
-> IORef (HashMap Text Label)
-> Store
-> Metrics
Metrics{IORef (HashMap Text Distribution)
IORef (HashMap Text Label)
IORef (HashMap Text Gauge)
IORef (HashMap Text Counter)
Store
_metricsStore :: Store
_metricsLabels :: IORef (HashMap Text Label)
_metricsDistributions :: IORef (HashMap Text Distribution)
_metricsGauges :: IORef (HashMap Text Gauge)
_metricsCounters :: IORef (HashMap Text Counter)
_metricsLabels :: IORef (HashMap Text Label)
_metricsGauges :: IORef (HashMap Text Gauge)
_metricsDistributions :: IORef (HashMap Text Distribution)
_metricsCounters :: IORef (HashMap Text Counter)
_metricsStore :: Store
..}

-- | Initializes a 'Metrics' value, creating a new 'System.Metrics.Store'
-- for it.
--
-- * /Since v0.1.0.0/
initialize :: IO Metrics
initialize :: IO Metrics
initialize = IO Store
EKG.newStore IO Store -> (Store -> IO Metrics) -> IO Metrics
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Store -> IO Metrics
initializeWith

-- $collecting
-- As with initialization, the library provides "common case" functions
-- with a plain name and generalized functions with an apostrophe.
--
-- * 'increment', 'counter', 'counter''
-- * 'gauge', 'gauge''
-- * 'timed', 'timed''
-- * 'label', 'label''
--
-- Only 'distribution' isn't generalized.

-- | Increment the named counter by 1.
--
-- * /Since v0.1.0.0/
increment :: (MonadIO m, MonadMetrics m) => Text -> m ()
increment :: Text -> m ()
increment Text
name = Text -> Int -> m ()
forall (m :: * -> *).
(MonadIO m, MonadMetrics m) =>
Text -> Int -> m ()
counter Text
name Int
1

-- | Adds the value to the named 'System.Metrics.Counter.Counter'.
--
-- * /Since v0.1.0.0/
counter' :: (MonadIO m, MonadMetrics m, Integral int) => Text -> int -> m ()
counter' :: Text -> int -> m ()
counter' =
    (Counter -> Int64 -> IO ())
-> (int -> Int64)
-> (Text -> Store -> IO Counter)
-> (Metrics -> IORef (HashMap Text Counter))
-> Text
-> int
-> m ()
forall (m :: * -> *) t t1 b t2.
(MonadMetrics m, MonadIO m) =>
(t -> t1 -> IO b)
-> (t2 -> t1)
-> (Text -> Store -> IO t)
-> (Metrics -> IORef (HashMap Text t))
-> Text
-> t2
-> m b
modifyMetric Counter -> Int64 -> IO ()
Counter.add int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Text -> Store -> IO Counter
EKG.createCounter Metrics -> IORef (HashMap Text Counter)
_metricsCounters

-- | A type specialized version of 'counter'' to avoid ambiguous type
-- errors.
--
-- * /Since v0.1.0.0/
counter :: (MonadIO m, MonadMetrics m) => Text -> Int -> m ()
counter :: Text -> Int -> m ()
counter = Text -> Int -> m ()
forall (m :: * -> *) int.
(MonadIO m, MonadMetrics m, Integral int) =>
Text -> int -> m ()
counter'

-- | Add the value to the named 'System.Metrics.Distribution.Distribution'.
--
-- * /Since v0.1.0.0/
distribution :: (MonadIO m, MonadMetrics m) => Text -> Double -> m ()
distribution :: Text -> Double -> m ()
distribution =
    (Distribution -> Double -> IO ())
-> (Double -> Double)
-> (Text -> Store -> IO Distribution)
-> (Metrics -> IORef (HashMap Text Distribution))
-> Text
-> Double
-> m ()
forall (m :: * -> *) t t1 b t2.
(MonadMetrics m, MonadIO m) =>
(t -> t1 -> IO b)
-> (t2 -> t1)
-> (Text -> Store -> IO t)
-> (Metrics -> IORef (HashMap Text t))
-> Text
-> t2
-> m b
modifyMetric Distribution -> Double -> IO ()
Distribution.add Double -> Double
forall a. a -> a
id Text -> Store -> IO Distribution
EKG.createDistribution Metrics -> IORef (HashMap Text Distribution)
_metricsDistributions

-- | Set the value of the named 'System.Metrics.Distribution.Gauge'.
--
-- * /Since v0.1.0.0/
gauge' :: (MonadIO m, MonadMetrics m, Integral int) => Text -> int -> m ()
gauge' :: Text -> int -> m ()
gauge' =
    (Gauge -> Int64 -> IO ())
-> (int -> Int64)
-> (Text -> Store -> IO Gauge)
-> (Metrics -> IORef (HashMap Text Gauge))
-> Text
-> int
-> m ()
forall (m :: * -> *) t t1 b t2.
(MonadMetrics m, MonadIO m) =>
(t -> t1 -> IO b)
-> (t2 -> t1)
-> (Text -> Store -> IO t)
-> (Metrics -> IORef (HashMap Text t))
-> Text
-> t2
-> m b
modifyMetric Gauge -> Int64 -> IO ()
Gauge.set int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Text -> Store -> IO Gauge
EKG.createGauge Metrics -> IORef (HashMap Text Gauge)
_metricsGauges

-- | A type specialized version of 'gauge'' to avoid ambiguous types.
--
-- * /Since v0.1.0.0/
gauge :: (MonadIO m, MonadMetrics m) => Text -> Int -> m ()
gauge :: Text -> Int -> m ()
gauge = Text -> Int -> m ()
forall (m :: * -> *) int.
(MonadIO m, MonadMetrics m, Integral int) =>
Text -> int -> m ()
gauge'

-- | See 'System.Metrics.Distribution.Gauge.dec'.
--
-- @since 0.2.2.0
gaugeDecrement :: (MonadIO m, MonadMetrics m) => Text -> m ()
gaugeDecrement :: Text -> m ()
gaugeDecrement Text
name =
    (Gauge -> () -> IO ())
-> (() -> ())
-> (Text -> Store -> IO Gauge)
-> (Metrics -> IORef (HashMap Text Gauge))
-> Text
-> ()
-> m ()
forall (m :: * -> *) t t1 b t2.
(MonadMetrics m, MonadIO m) =>
(t -> t1 -> IO b)
-> (t2 -> t1)
-> (Text -> Store -> IO t)
-> (Metrics -> IORef (HashMap Text t))
-> Text
-> t2
-> m b
modifyMetric (\Gauge
g -> IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
Gauge.dec Gauge
g) () -> ()
forall a. a -> a
id Text -> Store -> IO Gauge
EKG.createGauge Metrics -> IORef (HashMap Text Gauge)
_metricsGauges Text
name ()

-- | See 'System.Metrics.Distribution.Gauge.inc'.
--
-- @since 0.2.2.0
gaugeIncrement :: (MonadIO m, MonadMetrics m) => Text -> m ()
gaugeIncrement :: Text -> m ()
gaugeIncrement Text
name =
    (Gauge -> () -> IO ())
-> (() -> ())
-> (Text -> Store -> IO Gauge)
-> (Metrics -> IORef (HashMap Text Gauge))
-> Text
-> ()
-> m ()
forall (m :: * -> *) t t1 b t2.
(MonadMetrics m, MonadIO m) =>
(t -> t1 -> IO b)
-> (t2 -> t1)
-> (Text -> Store -> IO t)
-> (Metrics -> IORef (HashMap Text t))
-> Text
-> t2
-> m b
modifyMetric (\Gauge
g -> IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ Gauge -> IO ()
Gauge.inc Gauge
g) () -> ()
forall a. a -> a
id Text -> Store -> IO Gauge
EKG.createGauge Metrics -> IORef (HashMap Text Gauge)
_metricsGauges Text
name ()

-- | Record the time taken to perform the named action. The number is
-- stored in a 'System.Metrics.Distribution.Distribution' and is converted
-- to the specified 'Resolution'.
--
-- * /Since v0.1.0.0/
timed' :: (MonadIO m, MonadMetrics m, MonadMask m) => Resolution -> Text -> m a -> m a
timed' :: Resolution -> Text -> m a -> m a
timed' Resolution
resolution Text
name m a
action = Resolution -> [Text] -> m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMetrics m, MonadMask m) =>
Resolution -> [Text] -> m a -> m a
timedList Resolution
resolution [Text
name] m a
action

-- | Record the time taken to perform the action, under several names at once.
-- The number is stored in a 'System.Metrics.Distribution.Distribution' and is
-- converted to the specified 'Resolution'.
--
-- This is useful to store the same durations data sectioned by different criteria, e.g.:
--
-- @
-- timedList Seconds ["request.byUser." <> userName, "request.byType." <> requestType] $ do
--     ...
-- @
--
-- So you will have @"request.byUser.someuser"@ storing duration distribution for requests
-- of user @"someuser"@ of any type; and @"request.byType.sometype"@ storing
-- duration distribution for requests of type @"sometype"@ from any user.
--
timedList :: (MonadIO m, MonadMetrics m, MonadMask m) => Resolution -> [Text] -> m a -> m a
timedList :: Resolution -> [Text] -> m a -> m a
timedList Resolution
resolution [Text]
names m a
action = 
    m TimeSpec -> (TimeSpec -> m ()) -> (TimeSpec -> m a) -> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO TimeSpec -> m TimeSpec
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)) TimeSpec -> m ()
forall (m :: * -> *).
(MonadIO m, MonadMetrics m) =>
TimeSpec -> m ()
finish (m a -> TimeSpec -> m a
forall a b. a -> b -> a
const m a
action)
  where
    finish :: TimeSpec -> m ()
finish TimeSpec
start = do
        TimeSpec
end <- IO TimeSpec -> m TimeSpec
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Clock -> IO TimeSpec
getTime Clock
Monotonic)
        [Text] -> (Text -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
names ((Text -> m ()) -> m ()) -> (Text -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Text
name ->
            Text -> Double -> m ()
forall (m :: * -> *).
(MonadIO m, MonadMetrics m) =>
Text -> Double -> m ()
distribution Text
name (Resolution -> TimeSpec -> TimeSpec -> Double
diffTime Resolution
resolution TimeSpec
end TimeSpec
start)

-- | Record the time of executing the given action in seconds. Defers to
-- 'timed''.
--
-- * /Since v0.1.0.0/
timed :: (MonadIO m, MonadMetrics m, MonadMask m) => Text -> m a -> m a
timed :: Text -> m a -> m a
timed = Resolution -> Text -> m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMetrics m, MonadMask m) =>
Resolution -> Text -> m a -> m a
timed' Resolution
Seconds

-- | Set the 'Label' to the given 'Text' value.
--
-- * /Since v0.1.0.0/
label :: (MonadIO m, MonadMetrics m) => Text -> Text -> m ()
label :: Text -> Text -> m ()
label = (Label -> Text -> IO ())
-> (Text -> Text)
-> (Text -> Store -> IO Label)
-> (Metrics -> IORef (HashMap Text Label))
-> Text
-> Text
-> m ()
forall (m :: * -> *) t t1 b t2.
(MonadMetrics m, MonadIO m) =>
(t -> t1 -> IO b)
-> (t2 -> t1)
-> (Text -> Store -> IO t)
-> (Metrics -> IORef (HashMap Text t))
-> Text
-> t2
-> m b
modifyMetric Label -> Text -> IO ()
Label.set Text -> Text
forall a. a -> a
id Text -> Store -> IO Label
EKG.createLabel Metrics -> IORef (HashMap Text Label)
_metricsLabels

-- | Set the 'Label' to the 'Show'n value of whatever you pass in.
--
-- * /Since v0.1.0.0/
label' :: (MonadIO m, MonadMetrics m, Show a) => Text -> a -> m ()
label' :: Text -> a -> m ()
label' Text
l = Text -> Text -> m ()
forall (m :: * -> *).
(MonadIO m, MonadMetrics m) =>
Text -> Text -> m ()
label Text
l (Text -> m ()) -> (a -> Text) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- $metrictype
-- The 'Metric' type contains an 'IORef' to a 'HashMap' from 'Text' labels to
-- the various counters, and a 'EKG.Store' to register them with. If you
-- must use the 'Metric' value directly, then you are recommended to use
-- the lenses provided for compatibility.

-------------------------------------------------------------------------------

modifyMetric
    :: (MonadMetrics m, MonadIO m)
    => (t -> t1 -> IO b) -- ^ The action to add a value to a metric.
    -> (t2 -> t1) -- ^ A conversion function from input to metric value.
    -> (Text -> EKG.Store -> IO t) -- ^ The function for creating a new metric.
    -> (Metrics -> IORef (HashMap Text t)) -- ^ A way of getting the current metrics.
    -> Text -- ^ The name of the metric to use.
    -> t2 -- ^ The value the end user can provide.
    -> m b
modifyMetric :: (t -> t1 -> IO b)
-> (t2 -> t1)
-> (Text -> Store -> IO t)
-> (Metrics -> IORef (HashMap Text t))
-> Text
-> t2
-> m b
modifyMetric t -> t1 -> IO b
adder t2 -> t1
converter Text -> Store -> IO t
creator Metrics -> IORef (HashMap Text t)
getter Text
name t2
value = do
    t
bar <- (Metrics -> IORef (HashMap Text t))
-> (Text -> Store -> IO t) -> Text -> m t
forall (m :: * -> *) k a.
(MonadMetrics m, MonadIO m, Eq k, Hashable k) =>
(Metrics -> IORef (HashMap k a))
-> (k -> Store -> IO a) -> k -> m a
lookupOrCreate Metrics -> IORef (HashMap Text t)
getter Text -> Store -> IO t
creator Text
name
    IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ t -> t1 -> IO b
adder t
bar (t2 -> t1
converter t2
value)

lookupOrCreate
    :: (MonadMetrics m, MonadIO m, Eq k, Hashable k)
    => (Metrics -> IORef (HashMap k a)) -> (k -> EKG.Store -> IO a) -> k -> m a
lookupOrCreate :: (Metrics -> IORef (HashMap k a))
-> (k -> Store -> IO a) -> k -> m a
lookupOrCreate Metrics -> IORef (HashMap k a)
getter k -> Store -> IO a
creator k
name = do
    IORef (HashMap k a)
ref <- (Metrics -> IORef (HashMap k a))
-> m Metrics -> m (IORef (HashMap k a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Metrics -> IORef (HashMap k a)
getter m Metrics
forall (m :: * -> *). MonadMetrics m => m Metrics
getMetrics
    -- unsafeInterleaveIO is used here to defer creating the metric into
    -- the 'atomicModifyIORef'' function. We lazily create the value here,
    -- and the resulting IO action only gets run to create the metric when
    -- the named metric is not present in the map.
    a
newMetric <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (Store -> IO a) -> Store -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO a
forall a. IO a -> IO a
unsafeInterleaveIO (IO a -> IO a) -> (Store -> IO a) -> Store -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Store -> IO a
creator k
name (Store -> m a) -> m Store -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Metrics -> Store) -> m Metrics -> m Store
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Metrics -> Store
_metricsStore m Metrics
forall (m :: * -> *). MonadMetrics m => m Metrics
getMetrics
    IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ IORef (HashMap k a) -> (HashMap k a -> (HashMap k a, a)) -> IO a
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (HashMap k a)
ref (\HashMap k a
container ->
        case k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup k
name HashMap k a
container of
            Maybe a
Nothing ->
                (k -> a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HashMap.insert k
name a
newMetric HashMap k a
container, a
newMetric)
            Just a
metric ->
                (HashMap k a
container, a
metric))