module Network.StatsD.Datagram
    ( -- * Extensible serialization class.
      ToDatagram(..), Datagram(..)
    , renderDatagram
      -- * Some helpers.
    , fromDouble
    , prefixed, mprefixed
    , tags
    ) where

import           Data.List (intersperse)
import           Data.Monoid
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB                                             
import           Text.Printf (printf)

newtype Datagram = Datagram TB.Builder

class ToDatagram a where
    toDatagram :: a -> Datagram

instance ToDatagram Datagram where
    toDatagram = id

-- | Collect builder data and prepare it to be sent on a wire.
renderDatagram :: ToDatagram a => a -> BS.ByteString
renderDatagram x =
    let (Datagram lb) = toDatagram x
    in T.encodeUtf8 . TL.toStrict $ TB.toLazyText lb

-- | For debug purposes only.
instance Show Datagram where
    show (Datagram lb) = TL.unpack $ TB.toLazyText lb

-- * Helpers

fromDouble :: Double -> T.Text
fromDouble = T.pack . printf "%f"

prefixed :: Char -> T.Text -> TB.Builder
prefixed p value = mconcat
    [ TB.singleton '|'
    , TB.singleton p
    , TB.singleton ':'
    , TB.fromText value
    ]

mprefixed :: Char -> Maybe T.Text -> TB.Builder
mprefixed p = maybe mempty (prefixed p)

tags :: [(T.Text, T.Text)] -> TB.Builder
tags ts =
    let tag (k, v)
            | v == T.empty = TB.fromText k
            | otherwise =
                  TB.fromText k <>
                  TB.singleton ':' <>
                  TB.fromText v

    in mconcat $ case ts of
           [] -> mempty
           _  -> TB.fromText "|#" :
                 ( intersperse (TB.singleton ',')
                 $ map tag ts
                 )