add documentation and cosmetic changes

Author: Matthieu Morel

System/Metrics.hs

@@ -209,8 +209,8 @@ registerDimensional
     -> Store                  -- ^ Metric store
     -> IO ()
 registerDimensional d f store =
-    let x = readIORef (Dimensional._points d) >>= traverse f in
-    register (Dimensional._name d) (DimensionalS (Dimensional._dimensions d) x) store
+    let x = readIORef (Dimensional.dimensionalPoints d) >>= traverse f in
+    register (Dimensional.dimensionalName d) (DimensionalS (Dimensional.dimensionalDimensions d) x) store
 
 register :: T.Text
          -> MetricSampler

System/Metrics/Dimensional.hs

@@ -1,88 +1,104 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+
+-- | This module defines a type for mutable dimensional string-valued label.
+-- Dimensional label are variable values and can be used to track e.g. the
+-- current number of call to an api endpoint by its http return code.
+-- All operations on Dimensional label are thread-safe.
 module System.Metrics.Dimensional where
 
 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
 
-import Prelude hiding (lookup)
-import GHC.Exception (Exception)
+import Control.Applicative ((<$>), pure)
 import Control.Exception (throwIO)
-import Data.Text (Text)
-import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
 import Data.HashMap.Strict (HashMap, empty)
 import qualified Data.HashMap.Strict as HashMap
+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
+import Data.Text (Text)
+import GHC.Exception (Exception)
+import Prelude hiding (lookup)
 
 type Name = Text
+
 type Explanation = Text
+
 type Dimensions = [Text]
+
 type Point = [Text]
 
-data Dimensional a = Dimensional {
-    _create      :: !(IO a)
-  , _name        :: !Name
-  , _explanation :: !Explanation
-  , _dimensions  :: !Dimensions
-  , _points      :: !(IORef (HashMap Point a))
+-- | Dimensional metrics storage
+data Dimensional a = Dimensional
+  { dimensionalCreate :: !(IO a)
+  , dimensionalName :: !Name
+  , dimensionalExplanation :: !Explanation
+  , dimensionalDimensions :: !Dimensions
+  , dimensionalPoints :: !(IORef (HashMap Point a))
   }
 
-newDimensional :: IO a -> Name -> Explanation -> Dimensions -> IO (Dimensional a)
+-- | Create a new empty dimensional metrics
+newDimensional ::
+     IO a -> Name -> Explanation -> Dimensions -> IO (Dimensional a)
 newDimensional new name explanation dimensions =
-    Dimensional new name explanation dimensions <$> newIORef empty
+  Dimensional new name explanation dimensions <$> newIORef empty
 
-data DimensionError
-  = DimensionError !Name !Dimensions !Point
+data DimensionError =
+  DimensionError !Name
+                 !Dimensions
+                 !Point
   deriving (Show, Ord, Eq)
+
 instance Exception DimensionError
 
 data LookupFailure
   = UnmatchedDimensions DimensionError
   | NotFound
   deriving (Show, Ord, Eq)
 
+-- | Returns dimensional metric with specified labels
 lookup :: Dimensional a -> Point -> IO (Either LookupFailure a)
 lookup d pt
-  | not $ matchDimensions (_dimensions d) pt = pure $ Left (UnmatchedDimensions err)
+  | not $ matchDimensions (dimensionalDimensions d) pt =
+    pure $ Left (UnmatchedDimensions err)
   | otherwise = do
-        toLookupResult . HashMap.lookup pt <$> readIORef (_points d)
+    toLookupResult . HashMap.lookup pt <$> readIORef (dimensionalPoints d)
   where
     err :: DimensionError
-    err = DimensionError (_name d) (_dimensions d) pt
-
+    err = DimensionError (dimensionalName d) (dimensionalDimensions d) pt
     toLookupResult Nothing = Left NotFound
     toLookupResult (Just x) = Right x
 
 matchDimensions :: Dimensions -> Point -> Bool
 matchDimensions ds ps = length ds == length ps
 
+-- | Initialize a new empty dimensional metric with specified labels
 create :: Dimensional a -> Point -> IO a
 create d pt
-  | not $ matchDimensions (_dimensions d) pt = throwIO err
+  | not $ matchDimensions (dimensionalDimensions d) pt = throwIO err
   | otherwise = do
-      v <- _create d
-      atomicModifyIORef' (_points d) (\store -> (HashMap.insert pt v store, ()))
-      return v
+    v <- dimensionalCreate d
+    atomicModifyIORef'
+      (dimensionalPoints d)
+      (\store -> (HashMap.insert pt v store, ()))
+    return v
   where
     err :: DimensionError
-    err = DimensionError (_name d) (_dimensions d) pt
+    err = DimensionError (dimensionalName d) (dimensionalDimensions d) pt
 
+-- | Returns dimensional metric with specified labels, creating it if not exists
 lookupOrCreate :: Dimensional a -> Point -> IO a
-lookupOrCreate d pt = lookup d pt >>= \case
+lookupOrCreate d pt =
+  lookup d pt >>= \case
     Left NotFound -> create d pt
     Left (UnmatchedDimensions err) -> throwIO err
     Right x -> return x
 
 type Counter = Dimensional Counter.Counter
+
 type Gauge = Dimensional Gauge.Gauge
+
 type Label = Dimensional Label.Label
-type Distribution = Dimensional Distribution.Distribution
 
-example :: IO ()
-example = do
-  c <- newDimensional Counter.new "foo" "a foo" ["url", "status"]
-  let url = "/hello"
-  let status = "200"
-  x <- lookupOrCreate c [url, status]
-  Counter.inc x
+type Distribution = Dimensional Distribution.Distribution

examples/Dimensional.hs

@@ -0,0 +1,15 @@
+import qualified System.Metrics.Counter as Counter
+import System.Metrics.Dimensional
+
+main :: IO ()
+main = do
+  c <-
+    newDimensional
+      Counter.new
+      "wai.response"
+      "endpoints status response"
+      ["url", "status"]
+  let url = "/hello"
+  let status = "200"
+  x <- lookupOrCreate c [url, status]
+  Counter.inc x