{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.InfluxDB.Format
  ( -- $setup

  -- * The 'Format' type and associated functions
    Format
  , makeFormat
  , (%)

  -- * Formatting functions
  , formatQuery
  , formatDatabase
  , formatMeasurement
  , formatKey

  -- * Formatters for various types
  , database
  , key
  , keys
  , measurement
  , measurements
  , field
  , decimal
  , realFloat
  , text
  , string
  , byteString8
  , time

  -- * Utility functions
  , fromQuery
  ) where
import Control.Category
import Data.Monoid
import Data.String
import Prelude hiding ((.), id)

import Data.Time
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Builder as BB
import qualified Data.List as L
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 TL
import qualified Data.Text.Lazy.Builder.Int as TL
import qualified Data.Text.Lazy.Builder.RealFloat as TL

import Database.InfluxDB.Internal.Text
import Database.InfluxDB.Types hiding (database)

{- $setup
This module is desined to be imported qualified:

>>> :set -XOverloadedStrings
>>> import qualified Data.ByteString as B
>>> import qualified Database.InfluxDB.Format as F
-}

-- | Serialize a 'Query' to a 'B.ByteString'.
fromQuery :: Query -> B.ByteString
fromQuery :: Query -> ByteString
fromQuery (Query Text
q) =
  ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Builder
T.encodeUtf8Builder Text
q

-- | A typed format string. @Format a r@ means that @a@ is the type of formatted
-- string, and @r@ is the type of the formatter.
--
-- >>> :t F.formatQuery
-- F.formatQuery :: F.Format Query r -> r
-- >>> :t F.key
-- F.key :: F.Format r (Key -> r)
-- >>> :t "SELECT * FROM "%F.key
-- "SELECT * FROM "%F.key :: F.Format a (Key -> a)
-- >>> :t F.formatQuery ("SELECT * FROM "%F.key)
-- F.formatQuery ("SELECT * FROM "%F.key) :: Key -> Query
-- >>> F.formatQuery ("SELECT * FROM "%F.key) "series"
-- "SELECT * FROM \"series\""
newtype Format a r = Format { Format a r -> (Builder -> a) -> r
runFormat :: (TL.Builder -> a) -> r }

-- | 'Format's can be composed using @('.')@ from "Control.Category".
--
-- >>> import Control.Category ((.))
-- >>> import Prelude hiding ((.))
-- >>> F.formatQuery ("SELECT * FROM " . F.key) "series"
-- "SELECT * FROM \"series\""
instance Category Format where
  id :: Format a a
id = ((Builder -> a) -> a) -> Format a a
forall a r. ((Builder -> a) -> r) -> Format a r
Format (\Builder -> a
k -> Builder -> a
k Builder
"")
  Format b c
fmt1 . :: Format b c -> Format a b -> Format a c
. Format a b
fmt2 = ((Builder -> a) -> c) -> Format a c
forall a r. ((Builder -> a) -> r) -> Format a r
Format (((Builder -> a) -> c) -> Format a c)
-> ((Builder -> a) -> c) -> Format a c
forall a b. (a -> b) -> a -> b
$ \Builder -> a
k ->
    Format b c -> (Builder -> b) -> c
forall a r. Format a r -> (Builder -> a) -> r
runFormat Format b c
fmt1 ((Builder -> b) -> c) -> (Builder -> b) -> c
forall a b. (a -> b) -> a -> b
$ \Builder
a ->
      Format a b -> (Builder -> a) -> b
forall a r. Format a r -> (Builder -> a) -> r
runFormat Format a b
fmt2 ((Builder -> a) -> b) -> (Builder -> a) -> b
forall a b. (a -> b) -> a -> b
$ \Builder
b ->
        Builder -> a
k (Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)

-- | With the OverloadedStrings exension, string literals can be used to write
-- queries.
--
-- >>> "SELECT * FROM series" :: Query
-- "SELECT * FROM series"
instance a ~ r => IsString (Format a r) where
  fromString :: String -> Format a r
fromString String
xs = ((Builder -> a) -> a) -> Format a a
forall a r. ((Builder -> a) -> r) -> Format a r
Format (((Builder -> a) -> a) -> Format a a)
-> ((Builder -> a) -> a) -> Format a a
forall a b. (a -> b) -> a -> b
$ \Builder -> a
k -> Builder -> a
k (Builder -> a) -> Builder -> a
forall a b. (a -> b) -> a -> b
$ String -> Builder
forall a. IsString a => String -> a
fromString String
xs

-- | 'Format' specific synonym of @('.')@.
--
-- This is typically easier to use than @('.')@ is because it doesn't
-- conflict with @Prelude.(.)@.
(%) :: Format b c -> Format a b -> Format a c
% :: Format b c -> Format a b -> Format a c
(%) = Format b c -> Format a b -> Format a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.)

runFormatWith :: (T.Text -> a) -> Format a r -> r
runFormatWith :: (Text -> a) -> Format a r -> r
runFormatWith Text -> a
f Format a r
fmt = Format a r -> (Builder -> a) -> r
forall a r. Format a r -> (Builder -> a) -> r
runFormat Format a r
fmt (Text -> a
f (Text -> a) -> (Builder -> Text) -> Builder -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
TL.toLazyText)

-- | Format a 'Query'.
--
-- >>> F.formatQuery "SELECT * FROM series"
-- "SELECT * FROM series"
-- >>> F.formatQuery ("SELECT * FROM "%F.key) "series"
-- "SELECT * FROM \"series\""
formatQuery :: Format Query r -> r
formatQuery :: Format Query r -> r
formatQuery = (Text -> Query) -> Format Query r -> r
forall a r. (Text -> a) -> Format a r -> r
runFormatWith Text -> Query
Query

-- | Format a 'Database'.
--
-- >>> F.formatDatabase "test-db"
-- "test-db"
-- >>> F.formatDatabase ("test-db-"%F.decimal) 0
-- "test-db-0"
formatDatabase :: Format Database r -> r
formatDatabase :: Format Database r -> r
formatDatabase = (Text -> Database) -> Format Database r -> r
forall a r. (Text -> a) -> Format a r -> r
runFormatWith Text -> Database
Database

-- | Format a 'Measurement'.
--
-- >>> F.formatMeasurement "test-series"
-- "test-series"
-- >>> F.formatMeasurement ("test-series-"%F.decimal) 0
-- "test-series-0"
formatMeasurement :: Format Measurement r -> r
formatMeasurement :: Format Measurement r -> r
formatMeasurement = (Text -> Measurement) -> Format Measurement r -> r
forall a r. (Text -> a) -> Format a r -> r
runFormatWith Text -> Measurement
Measurement

-- | Format a 'Key'.
--
-- >>> F.formatKey "test-key"
-- "test-key"
-- >>> F.formatKey ("test-key-"%F.decimal) 0
-- "test-key-0"
formatKey :: Format Key r -> r
formatKey :: Format Key r -> r
formatKey Format Key r
fmt = Format Key r -> (Builder -> Key) -> r
forall a r. Format a r -> (Builder -> a) -> r
runFormat Format Key r
fmt (Text -> Key
Key (Text -> Key) -> (Builder -> Text) -> Builder -> Key
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
TL.toLazyText)

-- | Convenience function to make a custom formatter.
makeFormat :: (a -> TL.Builder) -> Format r (a -> r)
makeFormat :: (a -> Builder) -> Format r (a -> r)
makeFormat a -> Builder
build = ((Builder -> r) -> a -> r) -> Format r (a -> r)
forall a r. ((Builder -> a) -> r) -> Format a r
Format (((Builder -> r) -> a -> r) -> Format r (a -> r))
-> ((Builder -> r) -> a -> r) -> Format r (a -> r)
forall a b. (a -> b) -> a -> b
$ \Builder -> r
k a
a -> Builder -> r
k (Builder -> r) -> Builder -> r
forall a b. (a -> b) -> a -> b
$ a -> Builder
build a
a

doubleQuote :: T.Text -> TL.Builder
doubleQuote :: Text -> Builder
doubleQuote Text
name = Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TL.fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""

singleQuote :: T.Text -> TL.Builder
singleQuote :: Text -> Builder
singleQuote Text
name = Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
TL.fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"

identifierBuilder :: T.Text -> TL.Builder
identifierBuilder :: Text -> Builder
identifierBuilder = Text -> Builder
doubleQuote (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
escapeDoubleQuotes

stringBuilder :: T.Text -> TL.Builder
stringBuilder :: Text -> Builder
stringBuilder = Text -> Builder
singleQuote (Text -> Builder) -> (Text -> Text) -> Text -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
escapeSingleQuotes

-- | Format a database name.
--
-- >>> F.formatQuery ("CREATE DATABASE "%F.database) "test-db"
-- "CREATE DATABASE \"test-db\""
database :: Format r (Database -> r)
database :: Format r (Database -> r)
database = (Database -> Builder) -> Format r (Database -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat ((Database -> Builder) -> Format r (Database -> r))
-> (Database -> Builder) -> Format r (Database -> r)
forall a b. (a -> b) -> a -> b
$ \(Database Text
name) -> Text -> Builder
identifierBuilder Text
name

-- | Format an identifier (e.g. field names, tag names, etc).
--
-- Identifiers in InfluxDB protocol are surrounded with double quotes.
--
-- >>> F.formatQuery ("SELECT "%F.key%" FROM series") "field"
-- "SELECT \"field\" FROM series"
-- >>> F.formatQuery ("SELECT "%F.key%" FROM series") "foo\"bar"
-- "SELECT \"foo\\\"bar\" FROM series"
key :: Format r (Key -> r)
key :: Format r (Key -> r)
key = (Key -> Builder) -> Format r (Key -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat ((Key -> Builder) -> Format r (Key -> r))
-> (Key -> Builder) -> Format r (Key -> r)
forall a b. (a -> b) -> a -> b
$ \(Key Text
name) -> Text -> Builder
identifierBuilder Text
name

-- | Format multiple keys.
--
-- >>> F.formatQuery ("SELECT "%F.keys%" FROM series") ["field1", "field2"]
-- "SELECT \"field1\",\"field2\" FROM series"
keys :: Format r ([Key] -> r)
keys :: Format r ([Key] -> r)
keys = ([Key] -> Builder) -> Format r ([Key] -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat (([Key] -> Builder) -> Format r ([Key] -> r))
-> ([Key] -> Builder) -> Format r ([Key] -> r)
forall a b. (a -> b) -> a -> b
$
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> ([Key] -> [Builder]) -> [Key] -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
L.intersperse Builder
"," ([Builder] -> [Builder])
-> ([Key] -> [Builder]) -> [Key] -> [Builder]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Key -> Builder) -> [Key] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\(Key Text
name) -> Text -> Builder
identifierBuilder Text
name)

-- | Format a measurement.
--
-- >>> F.formatQuery ("SELECT * FROM "%F.measurement) "test-series"
-- "SELECT * FROM \"test-series\""
measurement :: Format r (Measurement -> r)
measurement :: Format r (Measurement -> r)
measurement = (Measurement -> Builder) -> Format r (Measurement -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat ((Measurement -> Builder) -> Format r (Measurement -> r))
-> (Measurement -> Builder) -> Format r (Measurement -> r)
forall a b. (a -> b) -> a -> b
$ \(Measurement Text
name) -> Text -> Builder
identifierBuilder Text
name

-- | Format a measurement.
--
-- >>> F.formatQuery ("SELECT * FROM "%F.measurements) ["series1", "series2"]
-- "SELECT * FROM \"series1\",\"series2\""
measurements :: Format r ([Measurement] -> r)
measurements :: Format r ([Measurement] -> r)
measurements = ([Measurement] -> Builder) -> Format r ([Measurement] -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat (([Measurement] -> Builder) -> Format r ([Measurement] -> r))
-> ([Measurement] -> Builder) -> Format r ([Measurement] -> r)
forall a b. (a -> b) -> a -> b
$
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Measurement] -> [Builder]) -> [Measurement] -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
L.intersperse Builder
","
    ([Builder] -> [Builder])
-> ([Measurement] -> [Builder]) -> [Measurement] -> [Builder]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Measurement -> Builder) -> [Measurement] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (\(Measurement Text
name) -> Text -> Builder
identifierBuilder Text
name)

-- | Format an InfluxDB value. Good for field and tag values.
--
-- >>> F.formatQuery ("SELECT * FROM series WHERE "%F.key%" = "%F.field) "location" "tokyo"
-- "SELECT * FROM series WHERE \"location\" = 'tokyo'"
field :: Format r (QueryField -> r)
field :: Format r (QueryField -> r)
field = (QueryField -> Builder) -> Format r (QueryField -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat ((QueryField -> Builder) -> Format r (QueryField -> r))
-> (QueryField -> Builder) -> Format r (QueryField -> r)
forall a b. (a -> b) -> a -> b
$ \case
  FieldInt Int64
n -> Int64 -> Builder
forall a. Integral a => a -> Builder
TL.decimal Int64
n
  FieldFloat Double
d -> Double -> Builder
forall a. RealFloat a => a -> Builder
TL.realFloat Double
d
  FieldString Text
s -> Text -> Builder
stringBuilder Text
s
  FieldBool Bool
b -> if Bool
b then Builder
"true" else Builder
"false"
  QueryField
FieldNull -> Builder
"null"

-- | Format a decimal number.
--
-- >>> F.formatQuery ("SELECT * FROM series WHERE time < now() - "%F.decimal%"h") 1
-- "SELECT * FROM series WHERE time < now() - 1h"
decimal :: Integral a => Format r (a -> r)
decimal :: Format r (a -> r)
decimal = (a -> Builder) -> Format r (a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat a -> Builder
forall a. Integral a => a -> Builder
TL.decimal

-- | Format a floating-point number.
--
-- >>> F.formatQuery ("SELECT * FROM series WHERE value > "%F.realFloat) 0.1
-- "SELECT * FROM series WHERE value > 0.1"
realFloat :: RealFloat a => Format r (a -> r)
realFloat :: Format r (a -> r)
realFloat = (a -> Builder) -> Format r (a -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat a -> Builder
forall a. RealFloat a => a -> Builder
TL.realFloat

-- | Format a text.
--
-- Note that this doesn't escape the string. Use 'formatKey' to format field
-- values in a query.
--
-- >>> :t F.formatKey F.text
-- F.formatKey F.text :: T.Text -> Key
text :: Format r (T.Text -> r)
text :: Format r (Text -> r)
text = (Text -> Builder) -> Format r (Text -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat Text -> Builder
TL.fromText

-- | Format a string.
--
-- Note that this doesn't escape the string. Use 'formatKey' to format field
-- values in a query.
--
-- >>> :t F.formatKey F.string
-- F.formatKey F.string :: String -> Key
string :: Format r (String -> r)
string :: Format r (String -> r)
string = (String -> Builder) -> Format r (String -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat String -> Builder
TL.fromString

-- | Format a UTF-8 encoded byte string.
--
-- Note that this doesn't escape the string. Use 'formatKey' to format field
-- values in a query.
--
-- >>> :t F.formatKey F.byteString8
-- F.formatKey F.byteString8 :: B.ByteString -> Key
byteString8 :: Format r (B.ByteString -> r)
byteString8 :: Format r (ByteString -> r)
byteString8 = (ByteString -> Builder) -> Format r (ByteString -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat ((ByteString -> Builder) -> Format r (ByteString -> r))
-> (ByteString -> Builder) -> Format r (ByteString -> r)
forall a b. (a -> b) -> a -> b
$ Text -> Builder
TL.fromText (Text -> Builder) -> (ByteString -> Text) -> ByteString -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
T.decodeUtf8

-- | Format a time.
--
-- >>> import Data.Time
-- >>> let Just t = parseTimeM False defaultTimeLocale "%s" "0" :: Maybe UTCTime
-- >>> F.formatQuery ("SELECT * FROM series WHERE time >= "%F.time) t
-- "SELECT * FROM series WHERE time >= '1970-01-01 00:00:00'"
time :: FormatTime time => Format r (time -> r)
time :: Format r (time -> r)
time = (time -> Builder) -> Format r (time -> r)
forall a r. (a -> Builder) -> Format r (a -> r)
makeFormat ((time -> Builder) -> Format r (time -> r))
-> (time -> Builder) -> Format r (time -> r)
forall a b. (a -> b) -> a -> b
$ \time
t ->
  Builder
"'" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
TL.fromString (TimeLocale -> String -> time -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
fmt time
t) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"'"
  where
    fmt :: String
fmt = String
"%F %X%Q" -- YYYY-MM-DD HH:MM:SS.nnnnnnnnn