module Network.StatsD.Metric
    ( -- * Metric constructors

      -- ** Gauge
      gauge, gaugeInc, gaugeDec

      -- ** Counter
    , counter, counter_

      -- ** Histogram
    , histogram, timer

      -- ** Set
    , set

      -- * Metric container
    , Metric(..), metric
      
    ) where

import Network.StatsD.Datagram
import Network.StatsD.Tags

import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Lazy.Builder as TB
import Text.Printf (printf)

-- | Generic StatsD metric.
data Metric = Metric
    { mName       :: Text
    , mValue      :: Text
    , mType       :: Text
    , mSampleRate :: Maybe Double
    , mTags       :: Tags
    } deriving (Show)

-- | Create a basic Metric for custom type.
metric :: Text -> Text -> Text -> Metric
metric n v t = Metric
    { mName       = n
    , mValue      = v
    , mType       = t
    , mSampleRate = Nothing
    , mTags       = []
    }

instance ToDatagram Metric where
    toDatagram (Metric{..}) =
        let base = [ TB.fromText mName
                   , TB.singleton ':'
                   , TB.fromText mValue
                   , TB.singleton '|'
                   , TB.fromText mType
                   ]

            sr = case mSampleRate of
                     Nothing -> mempty
                     Just rate -> TB.fromText "|@" <>
                                  TB.fromString (printf "%f" rate)

        in Datagram $ mconcat base <> sr <> tags mTags

instance Tagged Metric where
    getTags = mTags
    setTags m ts = m { mTags = ts }

gauge :: Text -> Double -> Metric
gauge name value = metric name (fromDouble value) "g"

gaugeInc :: Text -> Double -> Metric
gaugeInc name value = metric name ("+" <> fromDouble value) "g"

gaugeDec :: Text -> Double -> Metric
gaugeDec name value = metric name ("-" <> fromDouble value) "g"

counter :: Text -> Integer -> Metric
counter name value = metric name (T.pack $ show value) "c"

counter_ :: Text -> Metric
counter_ name = counter name 1

histogram :: Text -> Double -> Metric
histogram name value = metric name (fromDouble value) "h"

timer :: Text -> Double -> Metric
timer name value = metric name (fromDouble value) "ms"

set :: Text -> Text -> Metric
set name item = metric name item "s"