Stricter VectorState

.gitignore

@@ -1,7 +1,8 @@
 dist/
+dist-newstyle/
 .cabal-sandbox/
 cabal.sandbox.config
 cabal.config
 .stack-work
 */*.yaml.lock
-.devcontainer
+.devcontainer

prometheus-client/src/Prometheus/Metric/Vector.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE BangPatterns #-}
+
 module Prometheus.Metric.Vector (
     Vector (..)
 ,   vector
@@ -20,7 +22,10 @@ import qualified Data.Text as T
 import Data.Traversable (forM)
 
 
-type VectorState l m = (Metric m, Map.Map l (m, IO [SampleGroup]))
+data VectorState l m = VectorState
+    { vectorStateMetric :: !(Metric m)
+    , vectorStateMetricMap :: !(Map.Map l (m, IO [SampleGroup]))
+    }
 
 data Vector l m = MkVector (IORef.IORef (VectorState l m))
 
@@ -30,7 +35,7 @@ instance NFData (Vector l m) where
 -- | Creates a new vector of metrics given a label.
 vector :: Label l => l -> Metric m -> Metric (Vector l m)
 vector labels gen = Metric $ do
-    ioref <- checkLabelKeys labels $ IORef.newIORef (gen, Map.empty)
+    ioref <- checkLabelKeys labels $ IORef.newIORef $ VectorState gen Map.empty
     return (MkVector ioref, collectVector labels ioref)
 
 checkLabelKeys :: Label l => l -> a -> a
@@ -58,7 +63,7 @@ checkLabelKeys keys r = foldl check r $ map (T.unpack . fst) $ labelPairs keys k
 -- It is not clear that this will always be a valid assumption.
 collectVector :: Label l => l -> IORef.IORef (VectorState l m) -> IO [SampleGroup]
 collectVector keys ioref = do
-    (_, metricMap) <- IORef.readIORef ioref
+    VectorState _ metricMap <- IORef.readIORef ioref
     joinSamples <$> concat <$> mapM collectInner (Map.assocs metricMap)
     where
         collectInner (labels, (_metric, sampleGroups)) =
@@ -80,7 +85,7 @@ getVectorWith :: Vector label metric
               -> (metric -> IO a)
               -> IO [(label, a)]
 getVectorWith (MkVector valueTVar) f = do
-    (_, metricMap) <- IORef.readIORef valueTVar
+    VectorState _ metricMap <- IORef.readIORef valueTVar
     Map.assocs <$> forM metricMap (f . fst)
 
 -- | Given a label, applies an operation to the corresponding metric in the
@@ -91,26 +96,26 @@ withLabel :: (Label label, MonadMonitor m)
           -> (metric -> IO ())
           -> m ()
 withLabel (MkVector ioref) label f = doIO $ do
-    (Metric gen, _) <- IORef.readIORef ioref
+    VectorState (Metric gen) _ <- IORef.readIORef ioref
     newMetric <- gen
-    metric <- Atomics.atomicModifyIORefCAS ioref $ \(_, metricMap) ->
+    (metric, !newVectorState) <- Atomics.atomicModifyIORefCAS ioref $ \(VectorState _ metricMap) ->
         let maybeMetric = Map.lookup label metricMap
             updatedMap  = Map.insert label newMetric metricMap
         in  case maybeMetric of
-                Nothing     -> ((Metric gen, updatedMap), newMetric)
-                Just metric -> ((Metric gen, metricMap), metric)
-    f (fst metric)
+                Nothing     -> (VectorState (Metric gen) updatedMap, newMetric)
+                Just metric -> (VectorState (Metric gen) metricMap, metric)
+    f metric
 
 -- | Removes a label from a vector.
 removeLabel :: (Label label, MonadMonitor m)
             => Vector label metric -> label -> m ()
 removeLabel (MkVector valueTVar) label =
     doIO $ Atomics.atomicModifyIORefCAS_ valueTVar f
-    where f (desc, metricMap) = (desc, Map.delete label metricMap)
+    where f (VectorState desc metricMap) = VectorState desc (Map.delete label metricMap)
 
 -- | Removes all labels from a vector.
 clearLabels :: (Label label, MonadMonitor m)
             => Vector label metric -> m ()
 clearLabels (MkVector valueTVar) =
     doIO $ Atomics.atomicModifyIORefCAS_ valueTVar f
-    where f (desc, _) = (desc, Map.empty)
+    where f (VectorState desc _) = VectorState desc Map.empty