diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs
--- a/benchmarks/Main.hs
+++ b/benchmarks/Main.hs
@@ -1,44 +1,149 @@
+{-# language FlexibleContexts #-}
+{-# language OverloadedStrings #-}
+
+module Main (main) where
+
 import Prometheus
 
 import Control.Monad
+import Criterion
 import Criterion.Main
+import Data.Foldable (for_)
+import qualified Data.Text as T
 import System.Random
 
+withMetric m =
+  envWithCleanup
+    (register m)
+    (const unregisterAll)
 
+withCounter =
+  withMetric (counter (Info "a" "b"))
+
+withGauge =
+  withMetric (gauge (Info "a" "b"))
+
+withSummary quantiles =
+  withMetric (summary (Info "a" "b") quantiles)
+
+withHistogram buckets =
+  withMetric (histogram (Info "a" "b") buckets)
+
 main :: IO ()
-main = defaultMain [
-        bgroup "incCounter" $ expandBenches incCounterThenCollect
-    ,   bgroup "withLabelIncCounter" $ expandBenches withLabelIncCounter
-    ,   bgroup "addGauge" $ expandBenches $ withGaugeThenCollect (addGauge 47.0)
-    ,   bgroup "subGauge" $ expandBenches $ withGaugeThenCollect (subGauge 47.0)
-    ,   bgroup "setGauge" $ expandBenches $ withGaugeThenCollect (setGauge 47.0)
-    ,   bgroup "observe" $ expandBenches observeThenCollect
+main =
+  defaultMain
+    [ benchCounter
+    , benchGauge
+    , benchSummary
+    , benchHistogram
+    , benchExport
     ]
 
-expandBenches :: (Int -> IO a) -> [Benchmark]
-expandBenches = flip expand [1, 10, 100, 1000, 10000]
-    where expand b = map (\i -> bench (show i) (whnfIO (b i)))
 
-incCounterThenCollect :: Int -> IO [SampleGroup]
-incCounterThenCollect i = do
-    c <- counter (Info "name" "help")
-    replicateM_ i (incCounter c)
-    collect c
+-- Counter benchmarks
 
-withLabelIncCounter :: Int -> IO [SampleGroup]
-withLabelIncCounter i = do
-    v <- vector ("a", "b")  $ counter (Info "name" "help")
-    replicateM_ i (withLabel ("c", "d") incCounter v)
-    collect v
 
-withGaugeThenCollect :: (Metric Gauge -> IO ()) -> Int -> IO [SampleGroup]
-withGaugeThenCollect a i = do
-    g <- gauge (Info "name" "help")
-    replicateM_ i (a g)
-    collect g
+benchCounter =
+  withCounter $ \counter ->
+    bgroup "Counter"
+      [ benchIncCounter counter
+      , benchAddCounter counter
+      , benchAddDurationToCounter counter
+      ]
 
-observeThenCollect :: Int -> IO [SampleGroup]
-observeThenCollect i = do
-    s <- summary (Info "name" "help") defaultQuantiles
-    replicateM_ i (randomIO >>= flip observe s)
-    collect s
+benchIncCounter testCounter =
+  bench "incCounter" $ whnfIO (incCounter testCounter)
+
+benchAddCounter testCounter =
+  bench "addCounter" $ whnfIO (addCounter testCounter 50)
+
+benchAddDurationToCounter testCounter =
+  bench "addDurationToCounter" $ whnfIO (addDurationToCounter testCounter $ return ())
+
+
+
+-- Gauge benchmarks
+
+
+benchGauge =
+  withGauge $ \gauge ->
+    bgroup "Gauge"
+      [ benchIncGauge gauge
+      , benchAddGauge gauge
+      , benchSubGauge gauge
+      , benchSetGaugeToDuration gauge
+      ]
+
+benchIncGauge testGauge =
+  bench "incGauge" $ whnfIO (incGauge testGauge)
+
+benchAddGauge testGauge =
+  bench "addGauge" $ whnfIO (addGauge testGauge 50)
+
+benchSubGauge testGauge =
+  bench "subGauge" $ whnfIO (subGauge testGauge 50)
+
+benchSetGaugeToDuration testGauge =
+  bench "setGaugeToDuration" $ whnfIO (setGaugeToDuration testGauge $ return ())
+
+
+
+-- Summary benchmarks
+
+
+benchSummary =
+  bgroup "Summary"
+    (map benchSummaryWithQuantiles [defaultQuantiles])
+
+benchSummaryWithQuantiles q =
+  withSummary q $ \summary ->
+    bgroup ("Quantiles = " ++ show q)
+      [ benchSummaryObserve summary
+      ]
+
+benchSummaryObserve s =
+  bench "observe" $ whnfIO (observe s 42)
+
+
+
+-- Histogram benchmarks
+
+
+benchHistogram =
+  bgroup "Histogram"
+    (map benchHistogramWithQuantiles [defaultBuckets])
+
+benchHistogramWithQuantiles q =
+  withHistogram q $ \histogram ->
+    bgroup ("Buckets = " ++ show q)
+      [ benchHistogramObserve histogram
+      ]
+
+benchHistogramObserve s =
+  bench "observe" $ whnfIO (observe s 42)
+
+
+
+-- Exporter benchmarks
+
+benchExport =
+  bgroup "exportMetricsAsText"
+    [ bgroup "Export counters" (map benchExportCounters [100, 1000, 10000])
+    , bgroup "Export histograms" (map benchExportHistograms [100, 1000, 10000])
+    ]
+
+benchExportCounters nCounters =
+  envWithCleanup setup teardown ( const benchmark )
+  where
+    benchmark = bench (show nCounters ++ " counters") (nfIO exportMetricsAsText)
+    setup = replicateM_ nCounters $ do
+      register $ counter (Info (T.pack $ show nCounters) "")
+    teardown _ = unregisterAll
+
+benchExportHistograms nHistograms =
+  envWithCleanup setup teardown ( const benchmark )
+  where
+    benchmark = bench (show nHistograms ++ " histograms") (nfIO exportMetricsAsText)
+    setup = replicateM_ nHistograms $ do
+      register $ histogram (Info (T.pack $ show nHistograms) "") defaultBuckets
+    teardown _ = unregisterAll
diff --git a/prometheus-client.cabal b/prometheus-client.cabal
--- a/prometheus-client.cabal
+++ b/prometheus-client.cabal
@@ -1,5 +1,5 @@
 name:                prometheus-client
-version:             0.3.0
+version:             1.0.0
 synopsis:            Haskell client library for http://prometheus.io.
 description:         Haskell client library for http://prometheus.io.
 homepage:            https://github.com/fimad/prometheus-haskell
@@ -40,10 +40,14 @@
     , bytestring         >=0.9
     , clock
     , containers
+    , deepseq
     , mtl                >=2
     , stm                >=2.3
     , transformers
+    , transformers-compat
     , utf8-string
+    , exceptions
+    , text
   ghc-options: -Wall
 
 test-suite doctest
@@ -74,7 +78,11 @@
     , random-shuffle
     , stm
     , transformers
+    , transformers-compat
     , utf8-string
+    , deepseq
+    , exceptions
+    , text
   ghc-options: -Wall
 
 benchmark bench
@@ -85,8 +93,9 @@
   build-depends:
       base               >=4.7 && <5
     , bytestring
-    , criterion          >=1.1
+    , criterion          >=1.2
     , prometheus-client
     , random
     , utf8-string
+    , text
   ghc-options: -Wall
diff --git a/src/Prometheus.hs b/src/Prometheus.hs
--- a/src/Prometheus.hs
+++ b/src/Prometheus.hs
@@ -34,11 +34,11 @@
 -- A Counter is typically used to count requests served, tasks completed,
 -- errors occurred, etc.
 --
--- >>> myCounter <- counter (Info "my_counter" "An example counter")
+-- >>> myCounter <- register $ counter (Info "my_counter" "An example counter")
 -- >>> replicateM_ 47 (incCounter myCounter)
 -- >>> getCounter myCounter
 -- 47.0
--- >>> void $ addCounter 10 myCounter
+-- >>> void $ addCounter myCounter 10
 -- >>> getCounter myCounter
 -- 57.0
 
@@ -48,6 +48,7 @@
 ,   addCounter
 ,   unsafeAddCounter
 ,   addDurationToCounter
+,   countExceptions
 ,   getCounter
 
 -- ** Gauge
@@ -55,10 +56,10 @@
 -- | A gauge models an arbitrary floating point value. There are operations to
 -- set the value of a gauge as well as add and subtract arbitrary values.
 --
--- >>> myGauge <- gauge (Info "my_gauge" "An example gauge")
--- >>> setGauge 100 myGauge
--- >>> addGauge 50 myGauge
--- >>> subGauge 25 myGauge
+-- >>> myGauge <- register $ gauge (Info "my_gauge" "An example gauge")
+-- >>> setGauge myGauge 100 
+-- >>> addGauge myGauge 50
+-- >>> subGauge myGauge 25
 -- >>> getGauge myGauge
 -- 125.0
 
@@ -93,8 +94,8 @@
 -- sum, and rank estimations. A typical use case for summaries is measuring
 -- HTTP request latency.
 --
--- >>> mySummary <- summary (Info "my_summary" "") defaultQuantiles
--- >>> observe 0 mySummary
+-- >>> mySummary <- register $ summary (Info "my_summary" "") defaultQuantiles
+-- >>> observe mySummary 0
 -- >>> getSummary mySummary
 -- [(1 % 2,0.0),(9 % 10,0.0),(99 % 100,0.0)]
 
@@ -111,8 +112,8 @@
 -- for histograms is measuring HTTP request latency. Histograms are unlike
 -- summaries in that they can be meaningfully aggregated across processes.
 --
--- >>> myHistogram <- histogram (Info "my_histogram" "") defaultBuckets
--- >>> observe 0 myHistogram
+-- >>> myHistogram <- register $ histogram (Info "my_histogram" "") defaultBuckets
+-- >>> observe myHistogram 0 
 -- >>> getHistogram myHistogram
 -- fromList [(5.0e-3,1),(1.0e-2,0),(2.5e-2,0),(5.0e-2,0),(0.1,0),(0.25,0),(0.5,0),(1.0,0),(2.5,0),(5.0,0),(10.0,0)]
 ,   Histogram
@@ -127,15 +128,14 @@
 -- | A vector models a collection of metrics that share the same name but are
 -- partitioned across a set of dimensions.
 --
--- >>> myVector <- vector ("method", "code") $ counter (Info "http_requests" "")
--- >>> register myVector
--- >>> withLabel ("GET", "200") incCounter myVector
--- >>> withLabel ("GET", "200") incCounter myVector
--- >>> withLabel ("GET", "404") incCounter myVector
--- >>> withLabel ("POST", "200") incCounter myVector
--- >>> getVectorWith getCounter myVector
+-- >>> myVector <- register $ vector ("method", "code") $ counter (Info "http_requests" "")
+-- >>> withLabel myVector ("GET", "200") incCounter 
+-- >>> withLabel myVector ("GET", "200") incCounter 
+-- >>> withLabel myVector ("GET", "404") incCounter 
+-- >>> withLabel myVector ("POST", "200") incCounter 
+-- >>> getVectorWith myVector getCounter 
 -- [(("GET","200"),2.0),(("GET","404"),1.0),(("POST","200"),1.0)]
--- >>> exportMetricsAsText >>= Data.ByteString.putStr
+-- >>> exportMetricsAsText >>= Data.ByteString.Lazy.putStr
 -- # HELP http_requests
 -- # TYPE http_requests counter
 -- http_requests{method="GET",code="200"} 2.0
@@ -157,7 +157,7 @@
 -- specifying the types of vectors more concise.
 --
 -- >>> :{
--- >>> let myVector :: IO (Metric (Vector Label3 Counter));
+-- >>> let myVector :: Metric (Vector Label3 Counter);
 -- >>>     myVector = vector ("a", "b", "c") $ counter (Info "some_counter" "")
 -- >>> :}
 
@@ -202,9 +202,9 @@
 -- >>> let toSample = Sample "cpu_time" [] . toValue
 -- >>> let toSampleGroup = (:[]) . SampleGroup info GaugeType . (:[]) . toSample
 -- >>> let collectCPUTime = fmap toSampleGroup getCPUTime
--- >>> let cpuTimeMetric = Metric (MkCPUTime ()) collectCPUTime
+-- >>> let cpuTimeMetric = Metric (return (MkCPUTime (), collectCPUTime))
 -- >>> register cpuTimeMetric
--- >>> exportMetricsAsText >>= Data.ByteString.putStr
+-- >>> exportMetricsAsText >>= Data.ByteString.Lazy.putStr
 -- # HELP cpu_time The current CPU time
 -- # TYPE cpu_time gauge
 -- cpu_time ...
@@ -224,7 +224,7 @@
 -- Note that the changes to numAdds are not reflected until the updateMetrics
 -- value has been evaluated in the IO monad.
 --
--- >>> numAdds <- counter (Info "num_adds" "The number of additions")
+-- >>> numAdds <- register $ counter (Info "num_adds" "The number of additions")
 -- >>> let add x y = incCounter numAdds >> return (x + y)
 -- >>> let (3, updateMetrics) = runMonitor $ (add 1 1) >>= (add 1)
 -- >>> getCounter numAdds
@@ -265,4 +265,5 @@
 -- $setup
 -- >>> :module +Prometheus
 -- >>> :module +Control.Monad
+-- >>> :set -XOverloadedStrings
 -- >>> unregisterAll
diff --git a/src/Prometheus/Export/Text.hs b/src/Prometheus/Export/Text.hs
--- a/src/Prometheus/Export/Text.hs
+++ b/src/Prometheus/Export/Text.hs
@@ -1,19 +1,26 @@
+{-# language OverloadedStrings #-}
+
 module Prometheus.Export.Text (
     exportMetricsAsText
 ) where
 
 import Prometheus.Info
-import Prometheus.Label
 import Prometheus.Metric
 import Prometheus.Registry
 
-import Data.List (intersperse, intercalate)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.UTF8 as BS
+import Control.Monad.IO.Class
+import qualified Data.ByteString.Builder as Build
+import qualified Data.ByteString.Lazy as BS
+import Data.Foldable (foldMap)
+import Data.Monoid ((<>), mempty, mconcat)
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 
 
 -- $setup
 -- >>> :module +Prometheus
+-- >>> :set -XOverloadedStrings
 -- >>> unregisterAll
 
 -- | Export all registered metrics in the Prometheus 0.0.4 text exposition
@@ -23,52 +30,53 @@
 -- <http://prometheus.io/docs/instrumenting/exposition_formats/ documentation>.
 --
 -- >>> :m +Data.ByteString
--- >>> myCounter <- registerIO $ counter (Info "my_counter" "Example counter")
+-- >>> myCounter <- register $ counter (Info "my_counter" "Example counter")
 -- >>> incCounter myCounter
--- >>> exportMetricsAsText >>= Data.ByteString.putStr
+-- >>> exportMetricsAsText >>= Data.ByteString.Lazy.putStr
 -- # HELP my_counter Example counter
 -- # TYPE my_counter counter
 -- my_counter 1.0
-exportMetricsAsText :: IO BS.ByteString
+exportMetricsAsText :: MonadIO m => m BS.ByteString
 exportMetricsAsText = do
     samples <- collectMetrics
-    let exportedSamples = map exportSampleGroup samples ++ [BS.empty]
-    return $ BS.concat $ intersperse (BS.fromString "\n") exportedSamples
+    return $ Build.toLazyByteString $ foldMap exportSampleGroup samples
 
-exportSampleGroup :: SampleGroup -> BS.ByteString
+exportSampleGroup :: SampleGroup -> Build.Builder
 exportSampleGroup (SampleGroup info ty samples) =
-    if BS.null exportedSamples
-        then BS.empty
-        else prefix `BS.append` exportedSamples
+    if null samples
+        then mempty
+        else prefix <> exportedSamples
     where
         exportedSamples = exportSamples samples
         name = metricName info
         help = metricHelp info
-        prefix =  BS.fromString $ unlines [
-                "# HELP " ++ name ++ " " ++ escape help
-            ,   "# TYPE " ++ name ++ " " ++ show ty
+        prefix = Build.byteString $ T.encodeUtf8 $ T.unlines [
+                "# HELP " <> name <> " " <> T.concatMap escape help
+            ,   "# TYPE " <> name <> " " <> T.pack (show ty)
             ]
-        escape []        = []
-        escape ('\n':xs) = '\\' : 'n' : escape xs
-        escape ('\\':xs) = '\\' : '\\' : escape xs
-        escape (x:xs)    = x : escape xs
-
-exportSamples :: [Sample] -> BS.ByteString
-exportSamples = BS.intercalate (BS.fromString "\n") . map exportSample
-
-exportSample :: Sample -> BS.ByteString
-exportSample (Sample name [] value) = BS.concat [
-        BS.fromString name, BS.fromString " ", value
-    ]
-exportSample (Sample name labels value) = BS.concat [
-        BS.fromString name
-    ,   BS.fromString "{", exportLabels labels, BS.fromString "} "
-    ,   value
-    ]
+        escape '\n' = "\\n"
+        escape '\\' = "\\\\"
+        escape other = T.pack [other]
 
-exportLabels :: LabelPairs -> BS.ByteString
-exportLabels labels = BS.fromString $ intercalate "," $ map exportLabel labels
+exportSamples :: [Sample] -> Build.Builder
+exportSamples samples =
+  mconcat [ exportSample s <> Build.charUtf8 '\n' | s <- samples ]
 
-exportLabel :: (String, String) -> String
-exportLabel (key, value) = key ++ "=" ++ show value
+exportSample :: Sample -> Build.Builder
+exportSample (Sample name labels value) =
+  Build.byteString (T.encodeUtf8 name)
+    <> (case labels of
+         [] -> mempty
+         l:ls ->
+           Build.charUtf8 '{'
+             <> exportLabel l
+             <> mconcat [ Build.charUtf8 ',' <> exportLabel l' | l' <- ls ]
+             <> Build.charUtf8 '}')
+    <> Build.charUtf8 ' '
+    <> Build.byteString value
 
+exportLabel :: (Text, Text) -> Build.Builder
+exportLabel (key, value) =
+  Build.byteString (T.encodeUtf8 key)
+    <> Build.charUtf8 '='
+    <> Build.stringUtf8 (show value)
diff --git a/src/Prometheus/Info.hs b/src/Prometheus/Info.hs
--- a/src/Prometheus/Info.hs
+++ b/src/Prometheus/Info.hs
@@ -3,30 +3,32 @@
 ,   checkInfo
 ) where
 
+import Data.Text (Text)
+import qualified Data.Text as T
 
 -- | Meta data about a metric including its name and a help string that
 -- describes the value that the metric is measuring.
 data Info = Info {
-    metricName :: String
-,   metricHelp :: String
+    metricName :: Text
+,   metricHelp :: Text
 } deriving (Read, Show, Eq, Ord)
 
 checkInfo :: Info -> a -> a
 checkInfo info a
-    | (x:_)       <- name, not $ validStart x     = errorInvalid
-    | (_:xs)      <- name, not $ all validRest xs = errorInvalid
-    | ('_':'_':_) <- name                         = errorPrefix
-    | []          <- name                         = errorEmpty
+    | (x:_)       <- T.unpack name, not $ validStart x     = errorInvalid
+    | (_:xs)      <- T.unpack name, not $ all validRest xs = errorInvalid
+    | ('_':'_':_) <- T.unpack name                         = errorPrefix
+    | []          <- T.unpack name                         = errorEmpty
     | otherwise                                   = a
     where
         name = metricName info
 
         errorInvalid = error $ concat [
-                "The metric '", name, "' contains invalid characters."
+                "The metric '", T.unpack name, "' contains invalid characters."
             ]
 
         errorPrefix = error $ concat [
-                "The metric '", name, "' cannot start with '__'."
+                "The metric '", T.unpack name, "' cannot start with '__'."
             ]
 
         errorEmpty = error "Empty metric names are not allowed."
diff --git a/src/Prometheus/Label.hs b/src/Prometheus/Label.hs
--- a/src/Prometheus/Label.hs
+++ b/src/Prometheus/Label.hs
@@ -1,4 +1,6 @@
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+
 module Prometheus.Label (
     Label (..)
 ,   LabelPairs
@@ -14,10 +16,11 @@
 ,   Label9
 ) where
 
+import Data.Text
 
 -- | A list of tuples where the first value is the label and the second is the
 -- value of that label.
-type LabelPairs = [(String, String)]
+type LabelPairs = [(Text, Text)]
 
 -- | Label describes a class of types that can be used to as the label of
 -- a vector.
@@ -29,60 +32,58 @@
 instance Label () where
     labelPairs () () = []
 
-type Label1 = String
+type Label1 = Text
 
-instance Label String where
+instance Label Text where
     labelPairs key value = [(key, value)]
 
-type Label2 = (String, String)
+type Label2 = (Text, Text)
 
-instance Label (String, String)  where
+instance (a ~ Text, b ~ a) => Label (a, b)  where
     labelPairs (k1, k2) (v1, v2) = [(k1, v1), (k2, v2)]
 
-type Label3 = (String, String, String)
+type Label3 = (Text, Text, Text)
 
-instance Label (String, String, String)  where
+instance (a ~ Text, b ~ a, c ~ a) => Label (a, b, c)  where
     labelPairs (k1, k2, k3) (v1, v2, v3) = [(k1, v1), (k2, v2), (k3, v3)]
 
-type Label4 = (String, String, String, String)
+type Label4 = (Text, Text, Text, Text)
 
-instance Label (String, String, String, String)  where
+instance (a ~ Text, b ~ a, c ~ a, d ~ a) => Label (a, b, c, d)  where
     labelPairs (k1, k2, k3, k4) (v1, v2, v3, v4) =
             [(k1, v1), (k2, v2), (k3, v3), (k4, v4)]
 
-type Label5 = (String, String, String, String, String)
+type Label5 = (Text, Text, Text, Text, Text)
 
-instance Label (String, String, String, String, String)  where
+instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a) => Label (a, b, c, d, e)  where
     labelPairs (k1, k2, k3, k4, k5) (v1, v2, v3, v4, v5) =
             [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5)]
 
-type Label6 = (String, String, String, String, String, String)
+type Label6 = (Text, Text, Text, Text, Text, Text)
 
-instance Label (String, String, String, String, String, String)  where
+instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a, f ~ a) => Label (a, b, c, d, e, f)  where
     labelPairs (k1, k2, k3, k4, k5, k6) (v1, v2, v3, v4, v5, v6) =
             [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5), (k6, v6)]
 
-type Label7 = (String, String, String, String, String, String, String)
+type Label7 = (Text, Text, Text, Text, Text, Text, Text)
 
-instance Label (String, String, String, String, String, String, String)  where
+instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a, f ~ a, g ~ a) => Label (a, b, c, d, e, f, g)  where
     labelPairs (k1, k2, k3, k4, k5, k6, k7) (v1, v2, v3, v4, v5, v6, v7) =
             [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5), (k6, v6),
              (k7, v7)]
 
-type Label8 = (String, String, String, String, String, String, String, String)
+type Label8 = (Text, Text, Text, Text, Text, Text, Text, Text)
 
-instance Label (String, String, String, String, String, String, String,
-                String)  where
+instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a, f ~ a, g ~ a, h ~ a) => Label (a, b, c, d, e, f, g, h) where
     labelPairs (k1, k2, k3, k4, k5, k6, k7, k8)
                (v1, v2, v3, v4, v5, v6, v7, v8) =
             [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5), (k6, v6),
              (k7, v7), (k8, v8)]
 
-type Label9 = (String, String, String, String, String, String, String, String,
-               String)
+type Label9 = (Text, Text, Text, Text, Text, Text, Text, Text,
+               Text)
 
-instance Label (String, String, String, String, String, String, String,
-                String, String)  where
+instance (a ~ Text, b ~ a, c ~ a, d ~ a, e ~ a, f ~ a, g ~ a, h ~ a, i ~ a) => Label (a, b, c, d, e, f, g, h, i) where
     labelPairs (k1, k2, k3, k4, k5, k6, k7, k8, k9)
                (v1, v2, v3, v4, v5, v6, v7, v8, v9) =
             [(k1, v1), (k2, v2), (k3, v3), (k4, v4), (k5, v5), (k6, v6),
diff --git a/src/Prometheus/Metric.hs b/src/Prometheus/Metric.hs
--- a/src/Prometheus/Metric.hs
+++ b/src/Prometheus/Metric.hs
@@ -1,3 +1,5 @@
+{-# language GeneralizedNewtypeDeriving #-}
+
 module Prometheus.Metric (
     Metric (..)
 ,   Sample (..)
@@ -8,7 +10,9 @@
 import Prometheus.Info
 import Prometheus.Label
 
+import Control.DeepSeq
 import qualified Data.ByteString as BS
+import Data.Text (Text)
 
 
 -- | The type of a sample. This corresponds to the 5 types of metrics supported
@@ -30,7 +34,7 @@
 -- | A single value recorded at a moment in time. The sample type contains the
 -- name of the sample, a list of labels and their values, and the value encoded
 -- as a ByteString.
-data Sample = Sample String LabelPairs BS.ByteString
+data Sample = Sample Text LabelPairs BS.ByteString
     deriving (Show)
 
 -- | A Sample group is a list of samples that is tagged with meta data
@@ -42,7 +46,21 @@
 -- of a handle value and a collect method. The handle value is typically a new
 -- type wrapped value that provides access to the internal state of the metric.
 -- The collect method samples the current value of the metric.
-data Metric s = Metric {
-        handle  :: s
-    ,   collect :: IO [SampleGroup]
+newtype Metric s =
+  Metric
+    { -- | 'construct' is an 'IO' action that creates a new instance of a metric.
+      -- For example, in a counter, this 'IO' action would create a mutable reference
+      -- to maintain the state of the counter.
+      --
+      -- 'construct' returns two things:
+      --
+      -- 1. The state of the metric itself, which can be used to modify the
+      --    metric. A counter would return state pointing to the mutable
+      --    reference.
+      -- 2. An 'IO' action that samples the metric and returns 'SampleGroup's.
+      --    This is the data that will be stored by Prometheus. 
+      construct :: IO (s, IO [SampleGroup])
     }
+
+instance NFData a => NFData (Metric a) where
+  rnf (Metric a) = a `seq` ()
diff --git a/src/Prometheus/Metric/Counter.hs b/src/Prometheus/Metric/Counter.hs
--- a/src/Prometheus/Metric/Counter.hs
+++ b/src/Prometheus/Metric/Counter.hs
@@ -6,6 +6,7 @@
 ,   unsafeAddCounter
 ,   addDurationToCounter
 ,   getCounter
+,   countExceptions
 ) where
 
 import Prometheus.Info
@@ -13,6 +14,9 @@
 import Prometheus.Metric.Observer (timeAction)
 import Prometheus.MonadMonitor
 
+import Control.DeepSeq
+import Control.Monad.Catch
+import Control.Monad.IO.Class
 import Control.Monad (unless)
 import qualified Data.Atomics as Atomics
 import qualified Data.ByteString.UTF8 as BS
@@ -21,29 +25,29 @@
 
 newtype Counter = MkCounter (IORef.IORef Double)
 
+instance NFData Counter where
+  rnf (MkCounter ioref) = seq ioref ()
+
 -- | Creates a new counter metric with a given name and help string.
-counter :: Info -> IO (Metric Counter)
-counter info = do
+counter :: Info -> Metric Counter
+counter info = Metric $ do
     ioref <- IORef.newIORef 0
-    return Metric {
-            handle = MkCounter ioref
-        ,   collect = collectCounter info ioref
-        }
+    return (MkCounter ioref, collectCounter info ioref)
 
 withCounter :: MonadMonitor m
-          => Metric Counter
+          => Counter
           -> (Double -> Double)
           -> m ()
-withCounter Metric {handle = MkCounter ioref} f =
+withCounter (MkCounter ioref) f =
     doIO $ Atomics.atomicModifyIORefCAS_ ioref f
 
 -- | Increments the value of a counter metric by 1.
-incCounter :: MonadMonitor m => Metric Counter -> m ()
+incCounter :: MonadMonitor m => Counter -> m ()
 incCounter c = withCounter c (+ 1)
 
 -- | Add the given value to the counter, if it is zero or more.
-addCounter :: MonadMonitor m => Double -> Metric Counter -> m Bool
-addCounter x c
+addCounter :: MonadMonitor m => Counter -> Double -> m Bool
+addCounter c x
   | x < 0 = return False
   | otherwise = do
       withCounter c add
@@ -51,25 +55,47 @@
   where add i = i `seq` x `seq` i + x
 
 -- | Add the given value to the counter. Panic if it is less than zero.
-unsafeAddCounter :: MonadMonitor m => Double -> Metric Counter -> m ()
-unsafeAddCounter x c = do
-  added <- addCounter x c
+unsafeAddCounter :: MonadMonitor m => Counter -> Double -> m ()
+unsafeAddCounter c x = do
+  added <- addCounter c x
   unless added $
     error $ "Tried to add negative value to counter: " ++ show x
 
 -- | Add the duration of an IO action (in seconds) to a counter.
-addDurationToCounter :: IO a -> Metric Counter -> IO a
-addDurationToCounter io metric = do
+--
+-- If the IO action throws, no duration is added.
+addDurationToCounter :: (MonadIO m, MonadMonitor m) => Counter -> m a -> m a
+addDurationToCounter metric io = do
     (result, duration) <- timeAction io
-    _ <- addCounter duration metric
+    _ <- addCounter metric duration 
     return result
 
 -- | Retrieves the current value of a counter metric.
-getCounter :: Metric Counter -> IO Double
-getCounter Metric {handle = MkCounter ioref} = IORef.readIORef ioref
+getCounter :: MonadIO m => Counter -> m Double
+getCounter (MkCounter ioref) = liftIO $ IORef.readIORef ioref
 
 collectCounter :: Info -> IORef.IORef Double -> IO [SampleGroup]
 collectCounter info c = do
     value <- IORef.readIORef c
     let sample = Sample (metricName info) [] (BS.fromString $ show value)
     return [SampleGroup info CounterType [sample]]
+
+-- | Count the amount of times an action throws any synchronous exception.
+--
+-- >>> exceptions <- register $ counter (Info "exceptions_total" "Total amount of exceptions thrown")
+-- >>> countExceptions exceptions $ return ()
+-- >>> getCounter exceptions
+-- 0.0
+-- >>> countExceptions exceptions (error "Oh no!") `catch` (\SomeException{} -> return ())
+-- >>> getCounter exceptions
+-- 1.0
+--
+-- It's important to note that this will count *all* synchronous exceptions. If
+-- you want more granular counting of exceptions, you will need to write custom
+-- code using 'incCounter'.
+countExceptions :: (MonadCatch m, MonadMonitor m) => Counter -> m a -> m a
+countExceptions m io = io `onException` incCounter m
+
+-- $setup
+-- >>> :module +Prometheus
+-- >>> :set -XOverloadedStrings
diff --git a/src/Prometheus/Metric/Gauge.hs b/src/Prometheus/Metric/Gauge.hs
--- a/src/Prometheus/Metric/Gauge.hs
+++ b/src/Prometheus/Metric/Gauge.hs
@@ -15,6 +15,8 @@
 import Prometheus.Metric.Observer (timeAction)
 import Prometheus.MonadMonitor
 
+import Control.DeepSeq
+import Control.Monad.IO.Class
 import qualified Data.Atomics as Atomics
 import qualified Data.ByteString.UTF8 as BS
 import qualified Data.IORef as IORef
@@ -22,54 +24,54 @@
 
 newtype Gauge = MkGauge (IORef.IORef Double)
 
+instance NFData Gauge where
+  rnf (MkGauge ioref) = seq ioref ()
+
 -- | Create a new gauge metric with a given name and help string.
-gauge :: Info -> IO (Metric Gauge)
-gauge info = do
+gauge :: Info -> Metric Gauge
+gauge info = Metric $ do
     ioref <- IORef.newIORef 0
-    return Metric {
-            handle = MkGauge ioref
-        ,   collect = collectGauge info ioref
-        }
+    return (MkGauge ioref, collectGauge info ioref)
 
 withGauge :: MonadMonitor m
-          => Metric Gauge
+          => Gauge
           -> (Double -> Double)
           -> m ()
-withGauge (Metric {handle = MkGauge ioref}) f =
+withGauge (MkGauge ioref) f =
     doIO $ Atomics.atomicModifyIORefCAS_ ioref f
 
 -- | Adds a value to a gauge metric.
-addGauge :: MonadMonitor m => Double -> Metric Gauge -> m ()
-addGauge x g = withGauge g add
+addGauge :: MonadMonitor m => Gauge -> Double -> m ()
+addGauge g x = withGauge g add
     where add i = i `seq` x `seq` i + x
 
 -- | Subtracts a value from a gauge metric.
-subGauge :: MonadMonitor m => Double -> Metric Gauge -> m ()
-subGauge x g = withGauge g sub
+subGauge :: MonadMonitor m => Gauge -> Double -> m ()
+subGauge g x = withGauge g sub
     where sub i = i `seq` x `seq` i - x
 
 -- | Increments a gauge metric by 1.
-incGauge :: MonadMonitor m => Metric Gauge -> m ()
+incGauge :: MonadMonitor m => Gauge -> m ()
 incGauge g = withGauge g (+ 1)
 
 -- | Decrements a gauge metric by 1.
-decGauge :: MonadMonitor m => Metric Gauge -> m ()
+decGauge :: MonadMonitor m => Gauge -> m ()
 decGauge g = withGauge g (+ (-1))
 
 -- | Sets a gauge metric to a specific value.
-setGauge :: MonadMonitor m => Double -> Metric Gauge -> m ()
-setGauge r g = withGauge g set
+setGauge :: MonadMonitor m => Gauge -> Double -> m ()
+setGauge g r = withGauge g set
     where set _ = r
 
 -- | Retrieves the current value of a gauge metric.
-getGauge :: Metric Gauge -> IO Double
-getGauge (Metric {handle = MkGauge ioref}) = IORef.readIORef ioref
+getGauge :: MonadIO m => Gauge -> m Double
+getGauge (MkGauge ioref) = liftIO $ IORef.readIORef ioref
 
 -- | Sets a gauge metric to the duration in seconds of an IO action.
-setGaugeToDuration :: IO a -> Metric Gauge -> IO a
-setGaugeToDuration io metric = do
+setGaugeToDuration :: (MonadIO m, MonadMonitor m) => Gauge -> m a -> m a
+setGaugeToDuration metric io = do
     (result, duration) <- timeAction io
-    setGauge duration metric
+    setGauge metric duration 
     return result
 
 collectGauge :: Info -> IORef.IORef Double -> IO [SampleGroup]
diff --git a/src/Prometheus/Metric/Histogram.hs b/src/Prometheus/Metric/Histogram.hs
--- a/src/Prometheus/Metric/Histogram.hs
+++ b/src/Prometheus/Metric/Histogram.hs
@@ -1,3 +1,6 @@
+{-# language BangPatterns #-}
+{-# language OverloadedStrings #-}
+
 module Prometheus.Metric.Histogram (
     Histogram
 ,   histogram
@@ -19,25 +22,30 @@
 
 import Control.Applicative ((<$>))
 import qualified Control.Concurrent.STM as STM
+import Control.DeepSeq
+import Control.Monad.IO.Class
 import qualified Data.ByteString.UTF8 as BS
 import qualified Data.Map.Strict as Map
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import qualified Data.Text as T
 import Numeric (showFFloat)
 
 -- | A histogram. Counts the number of observations that fall within the
 -- specified buckets.
 newtype Histogram = MkHistogram (STM.TVar BucketCounts)
 
+instance NFData Histogram where
+  rnf (MkHistogram a) = seq a ()
+
 -- | Create a new 'Histogram' metric with a given name, help string, and
 -- list of buckets. Panics if the list of buckets is not strictly increasing.
 -- A good default list of buckets is 'defaultBuckets'. You can also create
 -- buckets with 'linearBuckets' or 'exponentialBuckets'.
-histogram :: Info -> [Bucket] -> IO (Metric Histogram)
-histogram info buckets = do
+histogram :: Info -> [Bucket] -> Metric Histogram
+histogram info buckets = Metric $ do
   countsTVar <- STM.newTVarIO  (emptyCounts buckets)
-  return Metric {
-          handle = MkHistogram countsTVar
-      ,   collect = collectHistogram info countsTVar
-      }
+  return (MkHistogram countsTVar, collectHistogram info countsTVar)
 
 -- | Upper-bound for a histogram bucket.
 type Bucket = Double
@@ -63,20 +71,20 @@
 
 instance Observer Histogram where
     -- | Add a new observation to a histogram metric.
-    observe v h = withHistogram h (insert v)
+    observe h v = withHistogram h (insert v)
 
 -- | Transform the contents of a histogram.
 withHistogram :: MonadMonitor m
-              => Metric Histogram -> (BucketCounts -> BucketCounts) -> m ()
-withHistogram Metric {handle = MkHistogram bucketCounts} f =
+              => Histogram -> (BucketCounts -> BucketCounts) -> m ()
+withHistogram (MkHistogram !bucketCounts) f =
   doIO $ STM.atomically $ STM.modifyTVar' bucketCounts f
 
 -- | Retries a map of upper bounds to counts of values observed that are
 -- less-than-or-equal-to that upper bound, but greater than any other upper
 -- bound in the map.
-getHistogram :: Metric Histogram -> IO (Map.Map Bucket Int)
-getHistogram Metric {handle = MkHistogram bucketsTVar} =
-    histCountsPerBucket <$> STM.atomically (STM.readTVar bucketsTVar)
+getHistogram :: MonadIO m => Histogram -> m (Map.Map Bucket Int)
+getHistogram (MkHistogram bucketsTVar) =
+    liftIO $ histCountsPerBucket <$> STM.atomically (STM.readTVar bucketsTVar)
 
 -- | Record an observation.
 insert :: Double -> BucketCounts -> BucketCounts
@@ -92,19 +100,19 @@
 collectHistogram :: Info -> STM.TVar BucketCounts -> IO [SampleGroup]
 collectHistogram info bucketCounts = STM.atomically $ do
     BucketCounts total count counts <- STM.readTVar bucketCounts
-    let sumSample = Sample (name ++ "_sum") [] (bsShow total)
-    let countSample = Sample (name ++ "_count") [] (bsShow count)
-    let infSample = Sample (name ++ "_bucket") [(bucketLabel, "+Inf")] (bsShow count)
+    let sumSample = Sample (name <> "_sum") [] (bsShow total)
+    let countSample = Sample (name <> "_count") [] (bsShow count)
+    let infSample = Sample (name <> "_bucket") [(bucketLabel, "+Inf")] (bsShow count)
     let samples = map toSample (cumulativeSum (Map.toAscList counts))
     return [SampleGroup info HistogramType $ samples ++ [infSample, sumSample, countSample]]
     where
         toSample (upperBound, count') =
-            Sample (name ++ "_bucket") [(bucketLabel, formatFloat upperBound)] $ bsShow count'
+            Sample (name <> "_bucket") [(bucketLabel, formatFloat upperBound)] $ bsShow count'
         name = metricName info
 
         -- We don't particularly want scientific notation, so force regular
         -- numeric representation instead.
-        formatFloat x = showFFloat Nothing x ""
+        formatFloat x = T.pack (showFFloat Nothing x "")
 
         cumulativeSum xs = zip (map fst xs) (scanl1 (+) (map snd xs))
 
@@ -113,7 +121,7 @@
 
 -- | The label that defines the upper bound of a bucket of a histogram. @"le"@
 -- is short for "less than or equal to".
-bucketLabel :: String
+bucketLabel :: Text
 bucketLabel = "le"
 
 -- | The default Histogram buckets. These are tailored to measure the response
diff --git a/src/Prometheus/Metric/Observer.hs b/src/Prometheus/Metric/Observer.hs
--- a/src/Prometheus/Metric/Observer.hs
+++ b/src/Prometheus/Metric/Observer.hs
@@ -5,32 +5,34 @@
 ) where
 
 import Data.Ratio ((%))
-import Prometheus.Metric
 import Prometheus.MonadMonitor
 
+import Control.Monad.IO.Class
 import System.Clock (Clock(..), diffTimeSpec, getTime, toNanoSecs)
 
 -- | Interface shared by 'Summary' and 'Histogram'.
 class Observer metric where
     -- | Observe that a particular floating point value has occurred.
     -- For example, observe that this request took 0.23s.
-    observe :: MonadMonitor m => Double -> Metric metric -> m ()
+    observe :: MonadMonitor m => metric -> Double -> m ()
 
 -- | Adds the duration in seconds of an IO action as an observation to an
 -- observer metric.
-observeDuration :: Observer metric => IO a -> Metric metric -> IO a
-observeDuration io metric = do
+--
+-- If the IO action throws an exception no duration will be observed.
+observeDuration :: (Observer metric, MonadIO m, MonadMonitor m) => metric -> m a -> m a
+observeDuration metric io = do
     (result, duration) <- timeAction io
-    observe duration metric
+    observe metric duration 
     return result
 
 
 -- | Evaluate @io@ and return its result as well as how long it took to evaluate,
 -- in seconds.
-timeAction :: IO a -> IO (a, Double)
+timeAction :: MonadIO m => m a -> m (a, Double)
 timeAction io = do
-    start  <- getTime Monotonic
+    start  <- liftIO $ getTime Monotonic
     result <- io
-    end    <- getTime Monotonic
+    end    <- liftIO $ getTime Monotonic
     let duration = toNanoSecs (end `diffTimeSpec` start) % 1000000000
     return (result, fromRational duration)
diff --git a/src/Prometheus/Metric/Summary.hs b/src/Prometheus/Metric/Summary.hs
--- a/src/Prometheus/Metric/Summary.hs
+++ b/src/Prometheus/Metric/Summary.hs
@@ -1,3 +1,6 @@
+{-# language BangPatterns #-}
+{-# language OverloadedStrings #-}
+
 module Prometheus.Metric.Summary (
     Summary
 ,   Quantile
@@ -22,39 +25,43 @@
 import Prometheus.Metric.Observer
 import Prometheus.MonadMonitor
 
-import Data.Int (Int64)
-import Data.Foldable (foldr')
 import qualified Control.Concurrent.STM as STM
+import Control.DeepSeq
+import Control.Monad.IO.Class
 import qualified Data.ByteString.UTF8 as BS
+import Data.Foldable (foldr')
+import Data.Int (Int64)
+import Data.Monoid ((<>))
+import qualified Data.Text as T
 
 
 newtype Summary = MkSummary (STM.TVar Estimator)
 
+instance NFData Summary where
+  rnf (MkSummary a) = a `seq` ()
+
 -- | Creates a new summary metric with a given name, help string, and a list of
 -- quantiles. A reasonable set set of quantiles is provided by
 -- 'defaultQuantiles'.
-summary :: Info -> [Quantile] -> IO (Metric Summary)
-summary info quantiles = do
+summary :: Info -> [Quantile] -> Metric Summary
+summary info quantiles = Metric $ do
     valueTVar <- STM.newTVarIO (emptyEstimator quantiles)
-    return Metric {
-            handle = MkSummary valueTVar
-        ,   collect = collectSummary info valueTVar
-        }
+    return (MkSummary valueTVar, collectSummary info valueTVar)
 
 withSummary :: MonadMonitor m
-            => Metric Summary -> (Estimator -> Estimator) -> m ()
-withSummary (Metric {handle = MkSummary valueTVar}) f =
+            => Summary -> (Estimator -> Estimator) -> m ()
+withSummary (MkSummary !valueTVar) f =
     doIO $ STM.atomically $ do
         STM.modifyTVar' valueTVar compress
         STM.modifyTVar' valueTVar f
 
 instance Observer Summary where
     -- | Adds a new observation to a summary metric.
-    observe v s = withSummary s (insert v)
+    observe s v = withSummary s (insert v)
 
 -- | Retrieves a list of tuples containing a quantile and its associated value.
-getSummary :: Metric Summary -> IO [(Rational, Double)]
-getSummary (Metric {handle = MkSummary valueTVar}) = do
+getSummary :: MonadIO m => Summary -> m [(Rational, Double)]
+getSummary (MkSummary valueTVar) = liftIO $ do
     estimator <- STM.atomically $ do
         STM.modifyTVar' valueTVar compress
         STM.readTVar valueTVar
@@ -68,22 +75,22 @@
     estimator@(Estimator count itemSum _ _) <- STM.readTVar valueTVar
     let quantiles = map fst $ estQuantiles estimator
     let samples =  map (toSample estimator) quantiles
-    let sumSample = Sample (metricName info ++ "_sum") [] (bsShow itemSum)
-    let countSample = Sample (metricName info ++ "_count") [] (bsShow count)
+    let sumSample = Sample (metricName info <> "_sum") [] (bsShow itemSum)
+    let countSample = Sample (metricName info <> "_count") [] (bsShow count)
     return [SampleGroup info SummaryType $ samples ++ [sumSample, countSample]]
     where
         bsShow :: Show s => s -> BS.ByteString
         bsShow = BS.fromString . show
 
         toSample estimator q =
-            Sample (metricName info) [("quantile", show $ toDouble q)] $
+            Sample (metricName info) [("quantile", T.pack . show $ toDouble q)] $
                 bsShow $ query estimator q
 
         toDouble :: Rational -> Double
         toDouble = fromRational
 
-dumpEstimator :: Metric Summary -> IO Estimator
-dumpEstimator (Metric {handle = MkSummary valueTVar}) =
+dumpEstimator :: Summary -> IO Estimator
+dumpEstimator (MkSummary valueTVar) =
     STM.atomically $ STM.readTVar valueTVar
 
 -- | A quantile is a pair of a quantile value and an associated acceptable error
diff --git a/src/Prometheus/Metric/Vector.hs b/src/Prometheus/Metric/Vector.hs
--- a/src/Prometheus/Metric/Vector.hs
+++ b/src/Prometheus/Metric/Vector.hs
@@ -12,27 +12,29 @@
 import Prometheus.MonadMonitor
 
 import Control.Applicative ((<$>))
-import Data.Traversable (forM)
+import Control.DeepSeq
 import qualified Data.Atomics as Atomics
 import qualified Data.IORef as IORef
 import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import Data.Traversable (forM)
 
 
-type VectorState l m = (IO (Metric m), Map.Map l (Metric m))
+type VectorState l m = (Metric m, Map.Map l (m, IO [SampleGroup]))
 
 data Vector l m = MkVector (IORef.IORef (VectorState l m))
 
+instance NFData (Vector l m) where
+  rnf (MkVector ioref) = seq ioref ()
+
 -- | Creates a new vector of metrics given a label.
-vector :: Label l => l -> IO (Metric m) -> IO (Metric (Vector l m))
-vector labels gen = do
+vector :: Label l => l -> Metric m -> Metric (Vector l m)
+vector labels gen = Metric $ do
     ioref <- checkLabelKeys labels $ IORef.newIORef (gen, Map.empty)
-    return Metric {
-            handle  = MkVector ioref
-        ,   collect = collectVector labels ioref
-        }
+    return (MkVector ioref, collectVector labels ioref)
 
 checkLabelKeys :: Label l => l -> a -> a
-checkLabelKeys keys r = foldl check r $ map fst $ labelPairs keys keys
+checkLabelKeys keys r = foldl check r $ map (T.unpack . fst) $ labelPairs keys keys
     where
         check _ "instance" = error "The label 'instance' is reserved."
         check _ "job"      = error "The label 'job' is reserved."
@@ -59,8 +61,8 @@
     (_, metricMap) <- IORef.readIORef ioref
     joinSamples <$> concat <$> mapM collectInner (Map.assocs metricMap)
     where
-        collectInner (labels, metric) =
-            map (adjustSamples labels) <$> collect metric
+        collectInner (labels, (_metric, sampleGroups)) =
+            map (adjustSamples labels) <$> sampleGroups
 
         adjustSamples labels (SampleGroup info ty samples) =
             SampleGroup info ty (map (prependLabels labels) samples)
@@ -74,41 +76,41 @@
         extract [] = []
         extract (SampleGroup _ _ s:xs) = s ++ extract xs
 
-getVectorWith :: (Metric metric -> IO a)
-              -> Metric (Vector label metric)
+getVectorWith :: Vector label metric
+              -> (metric -> IO a)
               -> IO [(label, a)]
-getVectorWith f (Metric {handle = MkVector valueTVar}) = do
+getVectorWith (MkVector valueTVar) f = do
     (_, metricMap) <- IORef.readIORef valueTVar
-    Map.assocs <$> forM metricMap f
+    Map.assocs <$> forM metricMap (f . fst)
 
 -- | Given a label, applies an operation to the corresponding metric in the
 -- vector.
 withLabel :: (Label label, MonadMonitor m)
-          => label
-          -> (Metric metric -> IO ())
-          -> Metric (Vector label metric)
+          => Vector label metric
+          -> label
+          -> (metric -> IO ())
           -> m ()
-withLabel label f (Metric {handle = MkVector ioref}) = doIO $ do
-    (gen, _) <- IORef.readIORef ioref
+withLabel (MkVector ioref) label f = doIO $ do
+    (Metric 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     -> ((Metric gen, updatedMap), newMetric)
+                Just metric -> ((Metric gen, metricMap), metric)
+    f (fst metric)
 
 -- | Removes a label from a vector.
 removeLabel :: (Label label, MonadMonitor m)
-            => Metric (Vector label metric) -> label -> m ()
-removeLabel (Metric {handle = MkVector valueTVar}) label =
+            => Vector label metric -> label -> m ()
+removeLabel (MkVector valueTVar) label =
     doIO $ Atomics.atomicModifyIORefCAS_ valueTVar f
     where f (desc, metricMap) = (desc, Map.delete label metricMap)
 
 -- | Removes all labels from a vector.
 clearLabels :: (Label label, MonadMonitor m)
-            => Metric (Vector label metric) -> m ()
-clearLabels (Metric {handle = MkVector valueTVar}) =
+            => Vector label metric -> m ()
+clearLabels (MkVector valueTVar) =
     doIO $ Atomics.atomicModifyIORefCAS_ valueTVar f
     where f (desc, _) = (desc, Map.empty)
diff --git a/src/Prometheus/MonadMonitor.hs b/src/Prometheus/MonadMonitor.hs
--- a/src/Prometheus/MonadMonitor.hs
+++ b/src/Prometheus/MonadMonitor.hs
@@ -1,4 +1,7 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Prometheus.MonadMonitor (
     MonadMonitor (..)
 ,   Monitor
@@ -9,17 +12,44 @@
 
 import Control.Applicative (Applicative)
 import Control.Monad.Identity (Identity, runIdentity)
+import Control.Monad.Trans.Class
 import Control.Monad.Trans.Class (MonadTrans)
+import Control.Monad.Trans.Error (ErrorT, Error)
+import Control.Monad.Trans.Except (ExceptT)
+import Control.Monad.Trans.Identity (IdentityT)
+import Control.Monad.Trans.Maybe (MaybeT)
+import qualified Control.Monad.Trans.RWS.Lazy as L
+import qualified Control.Monad.Trans.RWS.Strict as S
+import Control.Monad.Trans.Reader (ReaderT)
+import qualified Control.Monad.Trans.State.Lazy as L
+import qualified Control.Monad.Trans.State.Strict as S
+import qualified Control.Monad.Trans.Writer.Lazy as L
+import qualified Control.Monad.Trans.Writer.Strict as S
 import Control.Monad.Writer.Strict (WriterT, runWriterT, tell)
+import Data.Monoid (Monoid)
 
 
 -- | MonadMonitor describes a class of Monads that are capable of performing
 -- asynchronous IO operations.
 class Monad m => MonadMonitor m where
     doIO :: IO () -> m ()
+    default doIO :: (MonadTrans t, MonadMonitor n, m ~ t n) => IO () -> m ()
+    doIO = lift . doIO
 
 instance MonadMonitor IO where
     doIO = id
+
+instance (Error e, MonadMonitor m) => MonadMonitor (ErrorT e m)
+instance (MonadMonitor m) => MonadMonitor (ExceptT e m)
+instance (MonadMonitor m) => MonadMonitor (IdentityT m)
+instance (MonadMonitor m) => MonadMonitor (MaybeT m)
+instance (MonadMonitor m, Monoid w) => MonadMonitor (L.RWST r w s m)
+instance (MonadMonitor m, Monoid w) => MonadMonitor (S.RWST r w s m) 
+instance (MonadMonitor m) => MonadMonitor (ReaderT r m)
+instance (MonadMonitor m) => MonadMonitor (L.StateT s m)
+instance (MonadMonitor m) => MonadMonitor (S.StateT s m) 
+instance (MonadMonitor m, Monoid w) => MonadMonitor (L.WriterT w m)
+instance (MonadMonitor m, Monoid w) => MonadMonitor (S.WriterT w m) 
 
 -- | Monitor allows the use of Prometheus metrics in pure code. When using
 -- Monitor, all of the metric operations will be collected and queued into
diff --git a/src/Prometheus/Registry.hs b/src/Prometheus/Registry.hs
--- a/src/Prometheus/Registry.hs
+++ b/src/Prometheus/Registry.hs
@@ -11,6 +11,7 @@
 import Prometheus.Metric
 
 import Control.Applicative ((<$>))
+import Control.Monad.IO.Class
 import System.IO.Unsafe (unsafePerformIO)
 import qualified Control.Concurrent.STM as STM
 
@@ -19,30 +20,31 @@
 -- >>> :module +Prometheus
 -- >>> unregisterAll
 
-data RegisteredMetric = forall s. MkRegisteredMetric (Metric s)
-
-type Registry = [RegisteredMetric]
+-- | A 'Registry' is a list of all registered metrics, currently represented by
+-- their sampling functions.
+type Registry = [IO [SampleGroup]]
 
 {-# NOINLINE globalRegistry #-}
 globalRegistry :: STM.TVar Registry
 globalRegistry = unsafePerformIO $ STM.newTVarIO []
 
 -- | Registers a metric with the global metric registry.
-register :: Metric s -> IO (Metric s)
-register metric = do
-    let addToRegistry = (MkRegisteredMetric metric :)
-    STM.atomically $ STM.modifyTVar' globalRegistry addToRegistry
+register :: MonadIO m => Metric s -> m s
+register (Metric mk) = liftIO $ do
+    (metric, sampleGroups) <- mk
+    let addToRegistry = (sampleGroups :)
+    liftIO $ STM.atomically $ STM.modifyTVar' globalRegistry addToRegistry
     return metric
 
 -- | Registers a metric with the global metric registry.
-registerIO :: IO (Metric s) -> IO (Metric s)
+registerIO :: MonadIO m => m (Metric s) -> m s
 registerIO metricGen = metricGen >>= register
 
 -- | Registers a metric with the global metric registry.
 --
 -- __IMPORTANT__: This method should only be used to register metrics as top
 -- level symbols, it should not be run from other pure code.
-unsafeRegister :: Metric s -> Metric s
+unsafeRegister :: Metric s -> s
 unsafeRegister = unsafePerformIO . register
 
 -- | Registers a metric with the global metric registry.
@@ -57,12 +59,12 @@
 --  let c = unsafeRegisterIO $ counter (Info "my_counter" "An example metric")
 -- :}
 -- ...
-unsafeRegisterIO :: IO (Metric s) -> Metric s
+unsafeRegisterIO :: IO (Metric s) -> s
 unsafeRegisterIO = unsafePerformIO . registerIO
 
 -- | Removes all currently registered metrics from the registry.
-unregisterAll :: IO ()
-unregisterAll = STM.atomically $ STM.writeTVar globalRegistry []
+unregisterAll :: MonadIO m => m ()
+unregisterAll = liftIO $ STM.atomically $ STM.writeTVar globalRegistry []
 
 -- | Collect samples from all currently registered metrics. In typical use cases
 -- there is no reason to use this function, instead you should use
@@ -70,10 +72,7 @@
 --
 -- This function is likely only of interest if you wish to export metrics in
 -- a non-supported format for use with another monitoring service.
-collectMetrics :: IO [SampleGroup]
-collectMetrics = do
+collectMetrics :: MonadIO m => m [SampleGroup]
+collectMetrics = liftIO $ do
     registry <- STM.atomically $ STM.readTVar globalRegistry
-    concat <$> mapM collectRegistered registry
-
-collectRegistered :: RegisteredMetric -> IO [SampleGroup]
-collectRegistered (MkRegisteredMetric metric) = collect metric
+    concat <$> sequence registry