{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Database.InfluxDB.Line
  ( -- $setup

  -- * Types and accessors
    Line(Line)
  , measurement
  , tagSet
  , fieldSet
  , timestamp

  -- * Serializers
  , buildLine
  , buildLines
  , encodeLine
  , encodeLines

  -- * Other types
  , LineField
  , Field(..)
  , Precision(..)
  ) where
import Data.List (intersperse)
import Data.Int (Int64)
import Data.Monoid
import Prelude

import Control.Lens
import Data.Map (Map)
import Data.Text (Text)
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Map.Strict as Map
import qualified Data.Text.Encoding as TE

import Database.InfluxDB.Internal.Text
import Database.InfluxDB.Types

{- $setup
The Line protocol implementation.

>>> :set -XOverloadedStrings
>>> import Data.Time
>>> import Database.InfluxDB.Line
>>> import System.IO (stdout)
>>> import qualified Data.ByteString as B
>>> import qualified Data.ByteString.Builder as B
>>> import qualified Data.ByteString.Lazy.Char8 as BL8
>>> :{
let l1 = Line "cpu_usage"
      (Map.singleton "cpu" "cpu-total")
      (Map.fromList
        [ ("idle",   FieldFloat 10.1)
        , ("system", FieldFloat 53.3)
        , ("user",   FieldFloat 46.6)
        ])
      (Just $ parseTimeOrError False defaultTimeLocale
        "%F %T%Q %Z"
        "2017-06-17 15:41:40.42659044 UTC") :: Line UTCTime
:}
-}

-- | Placeholder for the Line Protocol
--
-- See https://docs.influxdata.com/influxdb/v1.7/write_protocols/line_protocol_tutorial/ for the
-- concrete syntax.
data Line time = Line
  { Line time -> Measurement
_measurement :: !Measurement
  -- ^ Measurement name
  , Line time -> Map Key Key
_tagSet :: !(Map Key Key)
  -- ^ Set of tags (optional)
  , Line time -> Map Key LineField
_fieldSet :: !(Map Key LineField)
  -- ^ Set of fields
  --
  -- It shouldn't be empty.
  , Line time -> Maybe time
_timestamp :: !(Maybe time)
  -- ^ Timestamp (optional)
  }

-- | Serialize a 'Line' to a lazy bytestring
--
-- >>> BL8.putStrLn $ encodeLine (scaleTo Second) l1
-- cpu_usage,cpu=cpu-total idle=10.1,system=53.3,user=46.6 1497714100
encodeLine
  :: (time -> Int64)
  -- ^ Function to convert time to an InfluxDB timestamp
  --
  -- Use 'scaleTo' for HTTP writes and 'roundTo' for UDP writes.
  -> Line time
  -> L.ByteString
encodeLine :: (time -> Int64) -> Line time -> ByteString
encodeLine time -> Int64
toTimestamp = Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (Line time -> Builder) -> Line time -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> Int64) -> Line time -> Builder
forall time. (time -> Int64) -> Line time -> Builder
buildLine time -> Int64
toTimestamp

-- | Serialize 'Line's to a lazy bytestring
--
-- >>> BL8.putStr $ encodeLines (scaleTo Second) [l1, l1]
-- cpu_usage,cpu=cpu-total idle=10.1,system=53.3,user=46.6 1497714100
-- cpu_usage,cpu=cpu-total idle=10.1,system=53.3,user=46.6 1497714100
--
encodeLines
  :: Foldable f
  => (time -> Int64)
  -- ^ Function to convert time to an InfluxDB timestamp
  --
  -- Use 'scaleTo' for HTTP writes and 'roundTo' for UDP writes.
  -> f (Line time)
  -> L.ByteString
encodeLines :: (time -> Int64) -> f (Line time) -> ByteString
encodeLines time -> Int64
toTimestamp = Builder -> ByteString
B.toLazyByteString (Builder -> ByteString)
-> (f (Line time) -> Builder) -> f (Line time) -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> Int64) -> f (Line time) -> Builder
forall (f :: * -> *) time.
Foldable f =>
(time -> Int64) -> f (Line time) -> Builder
buildLines time -> Int64
toTimestamp

-- | Serialize a 'Line' to a bytestring 'B.Buider'
--
-- >>> B.hPutBuilder stdout $ buildLine (scaleTo Second) l1
-- cpu_usage,cpu=cpu-total idle=10.1,system=53.3,user=46.6 1497714100
buildLine
  :: (time -> Int64)
  -> Line time
  -> B.Builder
buildLine :: (time -> Int64) -> Line time -> Builder
buildLine time -> Int64
toTimestamp Line {Maybe time
Map Key LineField
Map Key Key
Measurement
_timestamp :: Maybe time
_fieldSet :: Map Key LineField
_tagSet :: Map Key Key
_measurement :: Measurement
_timestamp :: forall time. Line time -> Maybe time
_fieldSet :: forall time. Line time -> Map Key LineField
_tagSet :: forall time. Line time -> Map Key Key
_measurement :: forall time. Line time -> Measurement
..} =
  Builder
key Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
fields Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Builder -> Builder) -> Maybe Builder -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" (Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) Maybe Builder
timestamp
  where
    measurement :: Builder
measurement = Text -> Builder
TE.encodeUtf8Builder (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Measurement -> Text
escapeMeasurement Measurement
_measurement
    tags :: Builder
tags = (Key -> Builder) -> Map Key Key -> Builder
forall t. (t -> Builder) -> Map Key t -> Builder
buildMap (Text -> Builder
TE.encodeUtf8Builder (Text -> Builder) -> (Key -> Text) -> Key -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
escapeKey) Map Key Key
_tagSet
    key :: Builder
key = if Map Key Key -> Bool
forall k a. Map k a -> Bool
Map.null Map Key Key
_tagSet
      then Builder
measurement
      else Builder
measurement Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"," Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
tags
    fields :: Builder
fields = (LineField -> Builder) -> Map Key LineField -> Builder
forall t. (t -> Builder) -> Map Key t -> Builder
buildMap LineField -> Builder
buildFieldValue Map Key LineField
_fieldSet
    timestamp :: Maybe Builder
timestamp = Int64 -> Builder
B.int64Dec (Int64 -> Builder) -> (time -> Int64) -> time -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. time -> Int64
toTimestamp (time -> Builder) -> Maybe time -> Maybe Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe time
_timestamp
    buildMap :: (t -> Builder) -> Map Key t -> Builder
buildMap t -> Builder
encodeVal =
      [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Map Key t -> [Builder]) -> Map Key t -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"," ([Builder] -> [Builder])
-> (Map Key t -> [Builder]) -> Map Key t -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, t) -> Builder) -> [(Key, t)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Key, t) -> Builder
encodeKeyVal ([(Key, t)] -> [Builder])
-> (Map Key t -> [(Key, t)]) -> Map Key t -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Key t -> [(Key, t)]
forall k a. Map k a -> [(k, a)]
Map.toList
      where
        encodeKeyVal :: (Key, t) -> Builder
encodeKeyVal (Key
name, t
val) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
          [ Text -> Builder
TE.encodeUtf8Builder (Text -> Builder) -> Text -> Builder
forall a b. (a -> b) -> a -> b
$ Key -> Text
escapeKey Key
name
          , Builder
"="
          , t -> Builder
encodeVal t
val
          ]

escapeKey :: Key -> Text
escapeKey :: Key -> Text
escapeKey (Key Text
text) = Text -> Text
escapeCommas (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeEqualSigns (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeSpaces Text
text

escapeMeasurement :: Measurement -> Text
escapeMeasurement :: Measurement -> Text
escapeMeasurement (Measurement Text
text) = Text -> Text
escapeCommas (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeSpaces Text
text

escapeStringField :: Text -> Text
escapeStringField :: Text -> Text
escapeStringField = Text -> Text
escapeDoubleQuotes (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
escapeBackslashes

buildFieldValue :: LineField -> B.Builder
buildFieldValue :: LineField -> Builder
buildFieldValue = \case
  FieldInt Int64
i -> Int64 -> Builder
B.int64Dec Int64
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"i"
  FieldFloat Double
d -> Double -> Builder
B.doubleDec Double
d
  FieldString Text
t -> Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TE.encodeUtf8Builder (Text -> Text
escapeStringField Text
t) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""
  FieldBool Bool
b -> if Bool
b then Builder
"true" else Builder
"false"

-- | Serialize 'Line's to a bytestring 'B.Builder'
--
-- >>> B.hPutBuilder stdout $ buildLines (scaleTo Second) [l1, l1]
-- cpu_usage,cpu=cpu-total idle=10.1,system=53.3,user=46.6 1497714100
-- cpu_usage,cpu=cpu-total idle=10.1,system=53.3,user=46.6 1497714100
--
buildLines
  :: Foldable f
  => (time -> Int64)
  -> f (Line time)
  -> B.Builder
buildLines :: (time -> Int64) -> f (Line time) -> Builder
buildLines time -> Int64
toTimestamp = (Line time -> Builder) -> f (Line time) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n") (Builder -> Builder)
-> (Line time -> Builder) -> Line time -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (time -> Int64) -> Line time -> Builder
forall time. (time -> Int64) -> Line time -> Builder
buildLine time -> Int64
toTimestamp)

makeLensesWith (lensRules & generateSignatures .~ False) ''Line

-- | Name of the measurement that you want to write your data to.
measurement :: Lens' (Line time) Measurement

-- | Tag(s) that you want to include with your data point. Tags are optional in
-- the Line Protocol, so you can set it 'Control.Applicative.empty'.
tagSet :: Lens' (Line time) (Map Key Key)

-- | Field(s) for your data point. Every data point requires at least one field
-- in the Line Protocol, so it shouldn't be 'Control.Applicative.empty'.
fieldSet :: Lens' (Line time) (Map Key LineField)

-- | Timestamp for your data point. You can put whatever type of timestamp that
-- is an instance of the 'Timestamp' class.
timestamp :: Lens' (Line time) (Maybe time)