prometheus-client (empty) → 0.1.0.0
raw patch · 17 files changed
+1391/−0 lines, 17 filesdep +QuickCheckdep +atomic-primopsdep +basesetup-changed
Dependencies added: QuickCheck, atomic-primops, base, bytestring, containers, criterion, doctest, hspec, mtl, prometheus-client, random, random-shuffle, stm, time, transformers, utf8-string
Files
- LICENSE +202/−0
- Setup.hs +2/−0
- benchmarks/Main.hs +44/−0
- prometheus-client.cabal +90/−0
- src/Prometheus.hs +226/−0
- src/Prometheus/Export/Text.hs +74/−0
- src/Prometheus/Info.hs +43/−0
- src/Prometheus/Label.hs +89/−0
- src/Prometheus/Metric.hs +48/−0
- src/Prometheus/Metric/Counter.hs +40/−0
- src/Prometheus/Metric/Gauge.hs +81/−0
- src/Prometheus/Metric/Summary.hs +198/−0
- src/Prometheus/Metric/Vector.hs +114/−0
- src/Prometheus/MonadMonitor.hs +51/−0
- src/Prometheus/Registry.hs +79/−0
- tests/Spec.hs +1/−0
- tests/doctest.hs +9/−0
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/Main.hs view
@@ -0,0 +1,44 @@+import Prometheus++import Control.Monad+import Criterion.Main+import System.Random+++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+ ]++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++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++observeThenCollect :: Int -> IO [SampleGroup]+observeThenCollect i = do+ s <- summary (Info "name" "help") defaultQuantiles+ replicateM_ i (randomIO >>= flip observe s)+ collect s
+ prometheus-client.cabal view
@@ -0,0 +1,90 @@+name: prometheus-client+version: 0.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+license: Apache-2.0+license-file: LICENSE+author: Will Coster+maintainer: willcoster@gmail.com+copyright: 2015 Will Coster+category: Network+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: https://github.com/fimad/prometheus-haskell++library+ hs-source-dirs: src/+ default-language: Haskell2010+ exposed-modules:+ Prometheus+ other-modules:+ Prometheus.Info+ , Prometheus.Label+ , Prometheus.Export.Text+ , Prometheus.Metric+ , Prometheus.Metric.Counter+ , Prometheus.Metric.Gauge+ , Prometheus.Metric.Summary+ , Prometheus.Metric.Vector+ , Prometheus.MonadMonitor+ , Prometheus.Registry+ build-depends:+ atomic-primops >=0.4+ , base >=4.6 && <4.8+ , bytestring >=0.9+ , containers+ , mtl >=2+ , stm >=2.3+ , transformers+ , time+ , utf8-string+ ghc-options: -Wall++test-suite doctest+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: tests+ ghc-options: -Wall+ main-is: doctest.hs+ build-depends:+ base+ , doctest+ , prometheus-client++test-suite spec+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: src, tests+ main-is: Spec.hs+ build-depends:+ QuickCheck+ , atomic-primops+ , base >=4.6 && <4.8+ , bytestring+ , containers+ , hspec+ , mtl+ , random-shuffle+ , stm+ , time+ , transformers+ , utf8-string+ ghc-options: -Wall++benchmark bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: benchmarks+ main-is: Main.hs+ build-depends:+ base >=4.6 && <4.8+ , bytestring+ , criterion >=1.1+ , prometheus-client+ , random+ , utf8-string+ ghc-options: -Wall
+ src/Prometheus.hs view
@@ -0,0 +1,226 @@+-- | This module provides the basics for instrumenting Haskell executables for+-- use with the <http://prometheus.io/ Prometheus> monitoring system.+module Prometheus (++-- * Registry++ registerIO+, register+, unsafeRegisterIO+, unsafeRegister+, unregisterAll+, collectMetrics++-- * Exporting++, exportMetricsAsText++-- * Metrics+--+-- | A metric represents a single value that is being monitored. For example+-- a metric could be the number of open files, the current CPU temperature, the+-- elapsed time of execution, and the latency of HTTP requests.+--+-- This module provides 4 built-in metric types: counters, gauges, summaries,+-- and metric vectors. These types of metrics should cover most typical use+-- cases. However, for more specialized use cases it is also possible to write+-- custom metrics.++-- ** Counter+--+-- | A counter models a monotonically increasing integer value. It is the+-- simplest type of metric provided by this library.+--+-- >>> myCounter <- counter (Info "my_counter" "An example counter")+-- >>> replicateM_ 47 (incCounter myCounter)+-- >>> getCounter myCounter+-- 47++, Counter+, counter+, incCounter+, getCounter++-- ** Gauge+--+-- | 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+-- >>> getGauge myGauge+-- 125.0++, Gauge+, gauge+, incGauge+, decGauge+, addGauge+, subGauge+, setGauge+, setGaugeToDuration+, getGauge++-- ** Summary+--+-- | A summary captures observations of a floating point value over time and+-- summarizes the observations as a count, sum, and rank estimations. A typical+-- use case for summaries is measuring HTTP request latency.+--+-- >>> mySummary <- summary (Info "my_summary" "") defaultQuantiles+-- >>> observe 0 mySummary+-- >>> getSummary mySummary+-- [(1 % 2,0.0),(9 % 10,0.0),(99 % 100,0.0)]++, Summary+, Quantile+, summary+, defaultQuantiles+, observe+, observeDuration+, getSummary++-- ** Vector+--+-- | 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+-- [(("GET","200"),2),(("GET","404"),1),(("POST","200"),1)]+-- >>> exportMetricsAsText >>= Data.ByteString.putStr+-- # HELP http_requests+-- # TYPE http_requests counter+-- http_requests{method="GET",code="200"} 2+-- http_requests{method="GET",code="404"} 1+-- http_requests{method="POST",code="200"} 1++, Vector+, vector+, withLabel+, removeLabel+, clearLabels+, getVectorWith++-- *** Labels+--+-- | The labels of a vector metric are types of the class Label. This module+-- defines all n-tupes of Strings for n <= 9 to be Labels. Additionally, the+-- type aliases LabelN is defined for each of these tuple types to make+-- specifying the types of vectors more concise.+--+-- >>> :{+-- >>> let myVector :: IO (Metric (Vector Label3 Counter));+-- >>> myVector = vector ("a", "b", "c") $ counter (Info "some_counter" "")+-- >>> :}++, Label (..)+, LabelPairs+, Label0+, Label1+, Label2+, Label3+, Label4+, Label5+, Label6+, Label7+, Label8+, Label9++-- ** Custom metrics+--+-- | Custom metrics can be created by directly creating a new 'Metric' type. There+-- are two parts of any metric, the handle and the collect method.+--+-- The handle is a value embedded in the metric that is intended to allow for+-- communication with the metric from instrumented code. For example, all of the+-- metrics provided by this library use a newtype wrapped TVar of some+-- underlying data type as their handle. When defining a new metric, it is+-- recommended that you use a newtype wrapper around your handle type as it will+-- allow users of your metric to succinctly identify your metric in type+-- signatures.+--+-- The collect method is responsible for serializing the current value of+-- a metric into a list of 'SampleGroup's.+--+-- The following is an example of a custom metric that models the current CPU+-- time. It uses a newtype wrapped unit as the handler type since it doesn't+-- need to maintain any state.+--+-- >>> :m +System.CPUTime+-- >>> :m +Data.ByteString.UTF8+-- >>> newtype CPUTime = MkCPUTime ()+-- >>> let info = Info "cpu_time" "The current CPU time"+-- >>> let toValue = Data.ByteString.UTF8.fromString . show+-- >>> let toSample = Sample "cpu_time" [] . toValue+-- >>> let toSampleGroup = (:[]) . SampleGroup info GaugeType . (:[]) . toSample+-- >>> let collectCPUTime = fmap toSampleGroup getCPUTime+-- >>> let cpuTimeMetric = Metric (MkCPUTime ()) collectCPUTime+-- >>> register cpuTimeMetric+-- >>> exportMetricsAsText >>= Data.ByteString.putStr+-- # HELP cpu_time The current CPU time+-- # TYPE cpu_time gauge+-- cpu_time ...++-- * Instrumenting pure code+--+-- | Pure code can be instrumented through the use of the 'Monitor' monad and+-- 'MonitorT' monad transformer. These constructs work by queueing all+-- operations on metrics. In order for the operations to actually be performed,+-- the queue must be evaluated within the IO monad.+--+-- The following is a contrived example that defines an add function that+-- records the number of times it was invoked.+--+-- > add :: Int -> Int -> Monitor Int+--+-- 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")+-- >>> let add x y = incCounter numAdds >> return (x + y)+-- >>> let (3, updateMetrics) = runMonitor $ (add 1 1) >>= (add 1)+-- >>> getCounter numAdds+-- 0+-- >>> updateMetrics+-- >>> getCounter numAdds+-- 2++, MonadMonitor (..)+, Monitor+, runMonitor+, MonitorT+, runMonitorT++-- * Base data types++, Info (..)+, Metric (..)+, Sample (..)+, SampleGroup (..)+, SampleType (..)+) where++import Prometheus.Export.Text+import Prometheus.Info+import Prometheus.Label+import Prometheus.Metric+import Prometheus.Metric.Counter+import Prometheus.Metric.Gauge+import Prometheus.Metric.Summary+import Prometheus.Metric.Vector+import Prometheus.MonadMonitor+import Prometheus.Registry+++-- $setup+-- >>> :module +Prometheus+-- >>> :module +Control.Monad+-- >>> unregisterAll
+ src/Prometheus/Export/Text.hs view
@@ -0,0 +1,74 @@+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+++-- $setup+-- >>> :module +Prometheus+-- >>> unregisterAll++-- | Export all registered metrics in the Prometheus 0.0.4 text exposition+-- format.+--+-- For the full specification of the format, see the official Prometheus+-- <http://prometheus.io/docs/instrumenting/exposition_formats/ documentation>.+--+-- >>> :m +Data.ByteString+-- >>> myCounter <- registerIO $ counter (Info "my_counter" "Example counter")+-- >>> incCounter myCounter+-- >>> exportMetricsAsText >>= Data.ByteString.putStr+-- # HELP my_counter Example counter+-- # TYPE my_counter counter+-- my_counter 1+exportMetricsAsText :: IO BS.ByteString+exportMetricsAsText = do+ samples <- collectMetrics+ let exportedSamples = map exportSampleGroup samples ++ [BS.empty]+ return $ BS.concat $ intersperse (BS.fromString "\n") exportedSamples++exportSampleGroup :: SampleGroup -> BS.ByteString+exportSampleGroup (SampleGroup info ty samples) =+ if BS.null exportedSamples+ then BS.empty+ else prefix `BS.append` exportedSamples+ where+ exportedSamples = exportSamples samples+ name = metricName info+ help = metricHelp info+ prefix = BS.fromString $ unlines [+ "# HELP " ++ name ++ " " ++ escape help+ , "# TYPE " ++ name ++ " " ++ 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+ ]++exportLabels :: LabelPairs -> BS.ByteString+exportLabels labels = BS.fromString $ intercalate "," $ map exportLabel labels++exportLabel :: (String, String) -> String+exportLabel (key, value) = key ++ "=" ++ show value+
+ src/Prometheus/Info.hs view
@@ -0,0 +1,43 @@+module Prometheus.Info (+ Info (..)+, checkInfo+) where+++-- | 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+} 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+ | otherwise = a+ where+ name = metricName info++ errorInvalid = error $ concat [+ "The metric '", name, "' contains invalid characters."+ ]++ errorPrefix = error $ concat [+ "The metric '", name, "' cannot start with '__'."+ ]++ errorEmpty = error "Empty metric names are not allowed."++ validStart c = ('a' <= c && c <= 'z')+ || ('A' <= c && c <= 'Z')+ || c == '_'+ || c == ':'++ validRest c = ('a' <= c && c <= 'z')+ || ('A' <= c && c <= 'Z')+ || ('0' <= c && c <= '9')+ || c == '_'+ || c == ':'
+ src/Prometheus/Label.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE FlexibleInstances #-}+module Prometheus.Label (+ Label (..)+, LabelPairs+, Label0+, Label1+, Label2+, Label3+, Label4+, Label5+, Label6+, Label7+, Label8+, Label9+) where+++-- | A list of tuples where the first value is the label and the second is the+-- value of that label.+type LabelPairs = [(String, String)]++-- | Label describes a class of types that can be used to as the label of+-- a vector.+class Ord l => Label l where+ labelPairs :: l -> l -> LabelPairs++type Label0 = ()++instance Label () where+ labelPairs () () = []++type Label1 = String++instance Label String where+ labelPairs key value = [(key, value)]++type Label2 = (String, String)++instance Label (String, String) where+ labelPairs (k1, k2) (v1, v2) = [(k1, v1), (k2, v2)]++type Label3 = (String, String, String)++instance Label (String, String, String) where+ labelPairs (k1, k2, k3) (v1, v2, v3) = [(k1, v1), (k2, v2), (k3, v3)]++type Label4 = (String, String, String, String)++instance Label (String, String, String, String) 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)++instance Label (String, String, String, String, String) 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)++instance Label (String, String, String, String, String, String) 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)++instance Label (String, String, String, String, String, String, String) 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)++instance Label (String, String, String, String, String, String, String,+ String) 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)++instance Label (String, String, String, String, String, String, String,+ String, String) 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),+ (k7, v7), (k8, v8), (k9, v9)]
+ src/Prometheus/Metric.hs view
@@ -0,0 +1,48 @@+module Prometheus.Metric (+ Metric (..)+, Sample (..)+, SampleGroup (..)+, SampleType (..)+) where++import Prometheus.Info+import Prometheus.Label++import qualified Data.ByteString as BS+++-- | The type of a sample. This corresponds to the 5 types of metrics supported+-- by Prometheus.+data SampleType+ = CounterType+ | GaugeType+ | SummaryType+ | HistogramType+ | UntypedType++instance Show SampleType where+ show CounterType = "counter"+ show GaugeType = "gauge"+ show SummaryType = "summary"+ show HistogramType = "histogram"+ show UntypedType = "untyped"++-- | 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+ deriving (Show)++-- | A Sample group is a list of samples that is tagged with meta data+-- including the name, help string, and type of the sample.+data SampleGroup = SampleGroup Info SampleType [Sample]+ deriving (Show)++-- | A metric represents a single value that is being monitored. It is comprised+-- 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]+ }
+ src/Prometheus/Metric/Counter.hs view
@@ -0,0 +1,40 @@+module Prometheus.Metric.Counter (+ Counter+, counter+, incCounter+, getCounter+) where++import Prometheus.Info+import Prometheus.Metric+import Prometheus.MonadMonitor++import qualified Data.Atomics.Counter as Atomics+import qualified Data.ByteString.UTF8 as BS+++newtype Counter = MkCounter Atomics.AtomicCounter++-- | Creates a new counter metric with a given name and help string.+counter :: Info -> IO (Metric Counter)+counter info = do+ atomicCounter <- Atomics.newCounter 0+ return Metric {+ handle = MkCounter atomicCounter+ , collect = collectCounter info atomicCounter+ }++-- | Increments the value of a counter metric by 1.+incCounter :: MonadMonitor m => Metric Counter -> m ()+incCounter (Metric {handle = MkCounter c}) =+ doIO $ Atomics.incrCounter_ 1 c++-- | Retrieves the current value of a counter metric.+getCounter :: Metric Counter -> IO Int+getCounter (Metric {handle = MkCounter c}) = Atomics.readCounter c++collectCounter :: Info -> Atomics.AtomicCounter -> IO [SampleGroup]+collectCounter info c = do+ value <- Atomics.readCounter c+ let sample = Sample (metricName info) [] (BS.fromString $ show value)+ return [SampleGroup info CounterType [sample]]
+ src/Prometheus/Metric/Gauge.hs view
@@ -0,0 +1,81 @@+module Prometheus.Metric.Gauge (+ Gauge+, gauge+, incGauge+, decGauge+, addGauge+, subGauge+, setGauge+, setGaugeToDuration+, getGauge+) where++import Prometheus.Info+import Prometheus.Metric+import Prometheus.MonadMonitor++import Data.Time.Clock (diffUTCTime, getCurrentTime)+import qualified Data.Atomics as Atomics+import qualified Data.ByteString.UTF8 as BS+import qualified Data.IORef as IORef+++newtype Gauge = MkGauge (IORef.IORef Double)++-- | Create a new gauge metric with a given name and help string.+gauge :: Info -> IO (Metric Gauge)+gauge info = do+ ioref <- IORef.newIORef 0+ return Metric {+ handle = MkGauge ioref+ , collect = collectGauge info ioref+ }++withGauge :: MonadMonitor m+ => Metric Gauge+ -> (Double -> Double)+ -> m ()+withGauge (Metric {handle = 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+ 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+ where sub i = i `seq` x `seq` i - x++-- | Increments a gauge metric by 1.+incGauge :: MonadMonitor m => Metric Gauge -> m ()+incGauge g = withGauge g (+ 1)++-- | Decrements a gauge metric by 1.+decGauge :: MonadMonitor m => Metric 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+ where set _ = r++-- | Retrieves the current value of a gauge metric.+getGauge :: Metric Gauge -> IO Double+getGauge (Metric {handle = MkGauge ioref}) = 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+ start <- getCurrentTime+ result <- io+ end <- getCurrentTime+ setGauge (fromRational $ toRational $ end `diffUTCTime` start) metric+ return result++collectGauge :: Info -> IORef.IORef Double -> IO [SampleGroup]+collectGauge info c = do+ value <- IORef.readIORef c+ let sample = Sample (metricName info) [] (BS.fromString $ show value)+ return [SampleGroup info GaugeType [sample]]
+ src/Prometheus/Metric/Summary.hs view
@@ -0,0 +1,198 @@+module Prometheus.Metric.Summary (+ Summary+, Quantile+, summary+, defaultQuantiles+, observe+, observeDuration+, getSummary++, dumpEstimator+, emptyEstimator+, Estimator (..)+, Item (..)+, insert+, compress+, query+, invariant+) where++import Prometheus.Info+import Prometheus.Metric+import Prometheus.MonadMonitor++import Data.Int (Int64)+import Data.Time.Clock (diffUTCTime, getCurrentTime)+import Data.Foldable (foldr')+import qualified Control.Concurrent.STM as STM+import qualified Data.ByteString.UTF8 as BS+++newtype Summary = MkSummary (STM.TVar Estimator)++-- | 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+ valueTVar <- STM.newTVarIO (emptyEstimator quantiles)+ return Metric {+ handle = MkSummary valueTVar+ , collect = collectSummary info valueTVar+ }++withSummary :: MonadMonitor m+ => Metric Summary -> (Estimator -> Estimator) -> m ()+withSummary (Metric {handle = MkSummary valueTVar}) f =+ doIO $ STM.atomically $ do+ STM.modifyTVar' valueTVar compress+ STM.modifyTVar' valueTVar f++-- | Adds a new observation to a summary metric.+observe :: MonadMonitor m => Double -> Metric Summary -> m ()+observe v s = withSummary s (insert v)++-- | Adds the duration in seconds of an IO action as an observation to a summary+-- metric.+observeDuration :: IO a -> Metric Summary -> IO a+observeDuration io metric = do+ start <- getCurrentTime+ result <- io+ end <- getCurrentTime+ observe (fromRational $ toRational $ end `diffUTCTime` start) metric+ return result++-- | Retrieves a list of tuples containing a quantile and its associated value.+getSummary :: Metric Summary -> IO [(Rational, Double)]+getSummary (Metric {handle = MkSummary valueTVar}) = do+ estimator <- STM.atomically $ do+ STM.modifyTVar' valueTVar compress+ STM.readTVar valueTVar+ let quantiles = map fst $ estQuantiles estimator+ let values = map (query estimator) quantiles+ return $ zip quantiles values++collectSummary :: Info -> STM.TVar Estimator -> IO [SampleGroup]+collectSummary info valueTVar = STM.atomically $ do+ STM.modifyTVar' valueTVar compress+ 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)+ 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)] $+ bsShow $ query estimator q++ toDouble :: Rational -> Double+ toDouble = fromRational++dumpEstimator :: Metric Summary -> IO Estimator+dumpEstimator (Metric {handle = MkSummary valueTVar}) =+ STM.atomically $ STM.readTVar valueTVar++-- | A quantile is a pair of a quantile value and an associated acceptable error+-- value.+type Quantile = (Rational, Rational)++data Item = Item {+ itemValue :: Double+, itemG :: !Int64+, itemD :: !Int64+} deriving (Eq, Show)++instance Ord Item where+ compare a b = itemValue a `compare` itemValue b++data Estimator = Estimator {+ estCount :: !Int64+, estSum :: !Double+, estQuantiles :: [Quantile]+, estItems :: [Item]+} deriving (Show)++defaultQuantiles :: [Quantile]+defaultQuantiles = [(0.5, 0.05), (0.9, 0.01), (0.99, 0.001)]++emptyEstimator :: [Quantile] -> Estimator+emptyEstimator quantiles = Estimator 0 0 quantiles []++insert :: Double -> Estimator -> Estimator+insert value estimator@(Estimator oldCount oldSum quantiles items) =+ newEstimator $ insertItem 0 items+ where+ newEstimator = Estimator (oldCount + 1) (oldSum + value) quantiles++ insertItem _ [] = [Item value 1 0]+ insertItem r [x]+ -- The first two cases cover the scenario where the initial size of+ -- the list is one.+ | r == 0 && value < itemValue x = Item value 1 0 : [x]+ | r == 0 = x : [Item value 1 0]+ -- The last case covers the scenario where the we have walked off+ -- the end of a list with more than 1 element in the final case of+ -- insertItem in which case we already know that x < value.+ | otherwise = x : [Item value 1 0]+ insertItem r (x:y:xs)+ -- This first case only covers the scenario where value is less than+ -- the first item in a multi-item list. For subsequent steps of+ -- a multi valued list, this case cannot happen as it would have+ -- fallen through to the case below in the previous step.+ | value <= itemValue x = Item value 1 0 : x : y : xs+ | value <= itemValue y = x : Item value 1 (calcD $ r + itemG x)+ : y : xs+ | otherwise = x : insertItem (itemG x + r) (y : xs)++ calcD r = max 0+ $ floor (invariant estimator (fromIntegral r)) - 1+++compress :: Estimator -> Estimator+compress est@(Estimator _ _ _ []) = est+compress est@(Estimator _ _ _ items) = est {+ estItems = (minItem :)+ $ foldr' compressPair []+ $ drop 1 -- The exact minimum item must be kept exactly.+ $ zip items+ $ scanl (+) 0 (map itemG items)+ }+ where+ minItem = head items+ compressPair (a, _) [] = [a]+ compressPair (a@(Item _ aG _), r) (b@(Item bVal bG bD):bs)+ | bD == 0 = a : b : bs+ | aG + bG + bD <= inv = Item bVal (aG + bG) bD : bs+ | otherwise = a : b : bs+ where+ inv = floor $ invariant est (fromIntegral r)++query :: Estimator -> Rational -> Double+query est@(Estimator count _ _ items) q = findQuantile allRs items+ where+ allRs = scanl (+) 0 $ map itemG items++ n = fromIntegral count+ f = invariant est++ rank = q * n+ bound = rank + (f rank / 2)++ findQuantile _ [] = 0 / 0 -- NaN+ findQuantile _ [a] = itemValue a+ findQuantile (_:bR:rs) (a@(Item{}):b@(Item _ bG bD):xs)+ | fromIntegral (bR + bG + bD) > bound = itemValue a+ | otherwise = findQuantile (bR:rs) (b:xs)+ findQuantile _ _ = error "Query impossibility"++invariant :: Estimator -> Rational -> Rational+invariant (Estimator count _ quantiles _) r = max 1+ $ minimum $ map fj quantiles+ where+ n = fromIntegral count+ fj (q, e) | q * n <= r = 2 * e * r / q+ | otherwise = 2 * e * (n - r) / (1 - q)
+ src/Prometheus/Metric/Vector.hs view
@@ -0,0 +1,114 @@+module Prometheus.Metric.Vector (+ Vector (..)+, vector+, withLabel+, removeLabel+, clearLabels+, getVectorWith+) where++import Prometheus.Label+import Prometheus.Metric+import Prometheus.MonadMonitor++import Control.Applicative ((<$>))+import Data.Traversable (forM)+import qualified Data.Atomics as Atomics+import qualified Data.IORef as IORef+import qualified Data.Map.Strict as Map+++type VectorState l m = (IO (Metric m), Map.Map l (Metric m))++data Vector l m = MkVector (IORef.IORef (VectorState l m))++-- | 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+ ioref <- checkLabelKeys labels $ IORef.newIORef (gen, Map.empty)+ return Metric {+ handle = MkVector ioref+ , collect = collectVector labels ioref+ }++checkLabelKeys :: Label l => l -> a -> a+checkLabelKeys keys r = foldl check r $ map fst $ labelPairs keys keys+ where+ check _ "instance" = error "The label 'instance' is reserved."+ check _ "job" = error "The label 'job' is reserved."+ check _ "quantile" = error "The label 'quantile' is reserved."+ check a (k:ey)+ | validStart k && all validRest ey = a+ | otherwise = error $ "The label '" ++ (k:ey) ++ "' is not valid."+ check _ [] = error "Empty labels are not allowed."++ validStart c = ('a' <= c && c <= 'z')+ || ('A' <= c && c <= 'Z')+ || c == '_'++ validRest c = ('a' <= c && c <= 'z')+ || ('A' <= c && c <= 'Z')+ || ('0' <= c && c <= '9')+ || c == '_'++-- TODO(will): This currently makes the assumption that all the types and info+-- for all sample groups returned by a metric's collect method will be the same.+-- 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+ joinSamples <$> concat <$> mapM collectInner (Map.assocs metricMap)+ where+ collectInner (labels, metric) =+ map (adjustSamples labels) <$> collect metric++ adjustSamples labels (SampleGroup info ty samples) =+ SampleGroup info ty (map (prependLabels labels) samples)++ prependLabels l (Sample name labels value) =+ Sample name (labelPairs keys l ++ labels) value++ joinSamples [] = []+ joinSamples s@(SampleGroup i t _:_) = [SampleGroup i t (extract s)]++ extract [] = []+ extract (SampleGroup _ _ s:xs) = s ++ extract xs++getVectorWith :: (Metric metric -> IO a)+ -> Metric (Vector label metric)+ -> IO [(label, a)]+getVectorWith f (Metric {handle = MkVector valueTVar}) = do+ (_, metricMap) <- IORef.readIORef valueTVar+ Map.assocs <$> forM metricMap f++-- | 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)+ -> m ()+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++-- | Removes a label from a vector.+removeLabel :: (Label label, MonadMonitor m)+ => Metric (Vector label metric) -> label -> m ()+removeLabel (Metric {handle = 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}) =+ doIO $ Atomics.atomicModifyIORefCAS_ valueTVar f+ where f (desc, _) = (desc, Map.empty)
+ src/Prometheus/MonadMonitor.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Prometheus.MonadMonitor (+ MonadMonitor (..)+, Monitor+, runMonitor+, MonitorT+, runMonitorT+) where++import Control.Applicative (Applicative)+import Control.Monad.Identity (Identity, runIdentity)+import Control.Monad.Trans.Class (MonadTrans)+import Control.Monad.Writer.Strict (WriterT, runWriterT, tell)+++-- | MonadMonitor describes a class of Monads that are capable of performing+-- asynchronous IO operations.+class Monad m => MonadMonitor m where+ doIO :: IO () -> m ()++instance MonadMonitor IO where+ doIO = id++-- | Monitor allows the use of Prometheus metrics in pure code. When using+-- Monitor, all of the metric operations will be collected and queued into+-- a single IO () value that can be run from impure code.+--+-- Because all of the operations are performed asynchronously use of this class+-- is not recommended for use with metrics that are time sensitive (e.g. for+-- measuring latency).+type Monitor a = MonitorT Identity a++-- | MonitorT is the monad transformer analog of Monitor and allows for+-- monitoring pure monad transformer stacks.+newtype MonitorT m a = MkMonitorT (WriterT [IO ()] m a)+ deriving (Applicative, Functor, Monad, MonadTrans)++instance Monad m => MonadMonitor (MonitorT m) where+ doIO f = MkMonitorT $ tell [f]++-- | Extract a value and the corresponding monitor update value from the Monitor+-- monad. For an example use see 'Monitor'.+runMonitor :: Monitor a -> (a, IO ())+runMonitor a = runIdentity $ runMonitorT a++-- | Extract a value and the corresponding monitor update value from the+-- MonitorT monad transformer.+runMonitorT :: Monad m => MonitorT m a -> m (a, IO ())+runMonitorT (MkMonitorT writerT) = do+ (v, operations) <- runWriterT writerT+ return (v, sequence_ operations)
+ src/Prometheus/Registry.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE ExistentialQuantification #-}+module Prometheus.Registry (+ register+, registerIO+, unsafeRegister+, unsafeRegisterIO+, collectMetrics+, unregisterAll+) where++import Prometheus.Metric++import Control.Applicative ((<$>))+import System.IO.Unsafe (unsafePerformIO)+import qualified Control.Concurrent.STM as STM+++-- $setup+-- >>> :module +Prometheus+-- >>> unregisterAll++data RegisteredMetric = forall s. MkRegisteredMetric (Metric s)++type Registry = [RegisteredMetric]++{-# 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+ return metric++-- | Registers a metric with the global metric registry.+registerIO :: IO (Metric s) -> IO (Metric 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 = unsafePerformIO . 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.+--+-- For example,+--+-- >>> :{+-- {-# NOINLINE c #-}+-- let c = unsafeRegisterIO $ counter (Info "my_counter" "An example metric")+-- :}+-- ...+unsafeRegisterIO :: IO (Metric s) -> Metric s+unsafeRegisterIO = unsafePerformIO . registerIO++-- | Removes all currently registered metrics from the registry.+unregisterAll :: IO ()+unregisterAll = 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+-- `exportMetricsAsText` or a convenience library.+--+-- 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+ registry <- STM.atomically $ STM.readTVar globalRegistry+ concat <$> mapM collectRegistered registry++collectRegistered :: RegisteredMetric -> IO [SampleGroup]+collectRegistered (MkRegisteredMetric metric) = collect metric
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/doctest.hs view
@@ -0,0 +1,9 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest [+ "-isrc"+ , "Prometheus"+ ]