{-# language GeneralizedNewtypeDeriving #-}

module Prometheus.Metric (
    Metric (..)
,   Sample (..)
,   SampleGroup (..)
,   SampleType (..)
) where

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
-- by Prometheus.
data SampleType
    = CounterType
    | GaugeType
    | SummaryType
    | HistogramType
    | UntypedType

instance Show SampleType where
    show :: SampleType -> String
show SampleType
CounterType   = String
"counter"
    show SampleType
GaugeType     = String
"gauge"
    show SampleType
SummaryType   = String
"summary"
    show SampleType
HistogramType = String
"histogram"
    show SampleType
UntypedType   = String
"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 Text LabelPairs BS.ByteString
    deriving (Int -> Sample -> ShowS
[Sample] -> ShowS
Sample -> String
(Int -> Sample -> ShowS)
-> (Sample -> String) -> ([Sample] -> ShowS) -> Show Sample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sample] -> ShowS
$cshowList :: [Sample] -> ShowS
show :: Sample -> String
$cshow :: Sample -> String
showsPrec :: Int -> Sample -> ShowS
$cshowsPrec :: Int -> Sample -> ShowS
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 (Int -> SampleGroup -> ShowS
[SampleGroup] -> ShowS
SampleGroup -> String
(Int -> SampleGroup -> ShowS)
-> (SampleGroup -> String)
-> ([SampleGroup] -> ShowS)
-> Show SampleGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SampleGroup] -> ShowS
$cshowList :: [SampleGroup] -> ShowS
show :: SampleGroup -> String
$cshow :: SampleGroup -> String
showsPrec :: Int -> SampleGroup -> ShowS
$cshowsPrec :: Int -> SampleGroup -> ShowS
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.
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. 
      Metric s -> IO (s, IO [SampleGroup])
construct :: IO (s, IO [SampleGroup])
    }

instance NFData a => NFData (Metric a) where
  rnf :: Metric a -> ()
rnf (Metric IO (a, IO [SampleGroup])
a) = IO (a, IO [SampleGroup])
a IO (a, IO [SampleGroup]) -> () -> ()
`seq` ()