Does withLabel need to have the type it does?

[ocharles]

The type of withLabel is:

withLabel :: (Label label, MonadMonitor m) => label -> (Metric metric -> IO ()) -> Metric (Vector label metric) -> m ()

This type implies that once the IO action that uses the labelled metric is terminated, some clean up must happen. Yet if we actually consult the source of withLabel, we have

withLabel label f (Metric {handle = MkVector ioref}) = doIO $ do
    (gen, _) <- IORef.readIORef ioref
    newMetric <- gen
    metric <- Atomics.atomicModifyIORefCAS ioref $ \(_, metricMap) ->
        let maybeMetric = Map.lookup label metricMap
            updatedMap  = Map.insert label newMetric metricMap
        in  case maybeMetric of
                Nothing     -> ((gen, updatedMap), newMetric)
                Just metric -> ((gen, metricMap), metric)
    f metric

Nothing happens after f is called - there is no cleanup that has to happen. Thus it would be simpler to have

withLabel :: (Label label, MonadMonitor m) => label -> Metric (Vector label metric) -> m (Metric metric)

My guess is that we have the type we have because we are forced into it by doIO. I find doIO a tad suspicious anyway, and think that MonadMonitor would likely be better if it actually had specific operations added, rather than a catch all liftIO-like operation.

What do you think?

[fimad]

Yeah, I agree that doIO is a bit of a kludge.

Do you have any suggestions for what specific operations we could replace doIO with?

One thing I can think of (but which would require a decent sized refactor) would be to create an AST for metric mutations and have MonadMonitor accept one of these values:

data MetricOp
    = GaugeAdd Gauge Double
    | GaugeSubtract Gauge Double
    | CounterIncrement Counter
    | WithLabel Label Vector MetricOp
    -- And so on...

class Monad m => MonadMonitor m where
  doOp :: MetricOp -> m ()

We'd then move the logic that is currently in the public API into an interpreter and make the public API map to the corresponding value in the AST.

addGauge :: MonadMonitor m => Gauge -> Double -> m ()
addGauge = doOp GaugeAdd

metricOpInterpreter :: MetricOp -> IO ()
metricOpInterpreter (GaugeAdd gauge value) = -- ...

The IO instance of doOp would pass the value directly to the metricOpInterpreter while the MonitorT instead of collecting a sequence of IO actions could instead store a sequence of MetricOps.

[ocharles]

I don't think MonadMonitor needs to quite have that big an AST, I think you can just have

class MonadMonitor m where 
  modifyIORef :: IORef a -> (a -> a) -> m ()
  modifyTVar :: TVar a -> (a -> a) -> m ()

Fundamentally, everything boils down to mutating mutable references.

I'll have a play with this when the open PR lands. I would like to explore this before a new release.

[danclien]

We're trying to convert from prometheus-effect, and it doesn't look like we're currently able to do a Histogram with labels in prometheus-client via observeDuration.

I think @ocharles's suggested change would also allow us to use observeDuration since we would have a Histogram to work with instead of a Vector label Histogram.

[ocharles]

I see now we do have on problem, which is that withLabel actually needs IO to modify an IORef to allocate the new metric in the vector. I'll have to rethink this.

@danclien do you have any code examples of what you'd like to write, but can't?

[danclien]

Here's an example repo: https://github.com/danclien/prometheus-client-histogram-label

We're trying to use observeDuration with a label. I created a hack to create a data type with both a Vector label metric and a label so I could write an Observer instance for it.

I'm not sure this is the best approach, but it's an example of what we're trying to do at least.

Hack:

data VectorWithLabel l m = VectorWithLabel (P.Vector l m) l

instance (P.Label l, P.Observer m) => P.Observer (VectorWithLabel l m) where
    -- | Add a new observation to a histogram metric using a label.
    observe (VectorWithLabel vector label) value = P.withLabel vector label f
      where f metric = P.observe metric value

Usage:

{-# NOINLINE responseTime #-}
responseTime :: P.Vector P.Label1 P.Histogram
responseTime = P.unsafeRegister
      -- Declare a vector of histogram with a single dimension: "vote".
      $ P.vector "vote"
      $ P.histogram
      (P.Info "response_time" "The time for the server to response for each color.")
      P.defaultBuckets

doRed = P.observeDuration (VectorWithLabel responseTime "red") doStuffThatGetsMeasuredHere