{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Database.InfluxDB.JSON
  ( -- * Result parsers
    parseResultsWith
  , parseResultsWithDecoder

  -- ** Decoder settings
  , Decoder(..)
  , SomeDecoder(..)
  , strictDecoder
  , lenientDecoder

  -- * Getting fields and tags
  , getField
  , getTag

  -- * Common JSON object parsers
  , A.parseJSON
  , parseUTCTime
  , parsePOSIXTime
  , parseRFC3339
  -- ** Utility functions
  , parseResultsObject
  , parseSeriesObject
  , parseSeriesBody
  , parseErrorObject
  ) where
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.Foldable
import Data.Maybe
import Prelude
import qualified Control.Monad.Fail as Fail

import Data.Aeson
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time.Format
import Data.Vector (Vector)
import qualified Data.Aeson.Types as A
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Scientific as Sci
import qualified Data.Text as T
import qualified Data.Vector as V

import Database.InfluxDB.Types

-- $setup
-- >>> import Data.Maybe
-- >>> import Data.Aeson (decode)
-- >>> import Database.InfluxDB.JSON
-- >>> import qualified Data.Aeson.Types as A

-- | Parse a JSON response with the 'strictDecoder'.
parseResultsWith
  :: (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> A.Parser a)
  -- ^ A parser that parses a measurement. A measurement consists of
  --
  -- 1. an optional name of the series
  -- 2. a map of tags
  -- 3. an array of field keys
  -- 4. an array of field values
  -> Value -- ^ JSON response
  -> A.Parser (Vector a)
parseResultsWith :: forall a.
(Maybe Text
 -> HashMap Text Text -> Vector Text -> Vector Value -> Parser a)
-> Value -> Parser (Vector a)
parseResultsWith = Decoder
-> (Maybe Text
    -> HashMap Text Text -> Vector Text -> Vector Value -> Parser a)
-> Value
-> Parser (Vector a)
forall a.
Decoder
-> (Maybe Text
    -> HashMap Text Text -> Vector Text -> Vector Value -> Parser a)
-> Value
-> Parser (Vector a)
parseResultsWithDecoder Decoder
strictDecoder

-- | Parse a JSON response with the specified decoder settings.
parseResultsWithDecoder
  :: Decoder
  -> (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> A.Parser a)
  -- ^ A parser that parses a measurement. A measurement consists of
  --
  -- 1. an optional name of the series
  -- 2. a map of tags
  -- 3. an array of field keys
  -- 4. an array of field values
  -> Value -- ^ JSON response
  -> A.Parser (Vector a)
parseResultsWithDecoder :: forall a.
Decoder
-> (Maybe Text
    -> HashMap Text Text -> Vector Text -> Vector Value -> Parser a)
-> Value
-> Parser (Vector a)
parseResultsWithDecoder (Decoder SomeDecoder {Parser a -> Parser b
Parser (Vector b) -> Parser (Vector a)
decodeEach :: Parser a -> Parser b
decodeFold :: Parser (Vector b) -> Parser (Vector a)
decodeEach :: ()
decodeFold :: ()
..}) Maybe Text
-> HashMap Text Text -> Vector Text -> Vector Value -> Parser a
row Value
val0 = do
  Either String (Vector a)
r <- (Parser (Either String (Vector a))
 -> Parser (Either String (Vector a))
 -> Parser (Either String (Vector a)))
-> [Parser (Either String (Vector a))]
-> Parser (Either String (Vector a))
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Parser (Either String (Vector a))
-> Parser (Either String (Vector a))
-> Parser (Either String (Vector a))
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
    [ String -> Either String (Vector a)
forall a b. a -> Either a b
Left (String -> Either String (Vector a))
-> Parser String -> Parser (Either String (Vector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
parseErrorObject Value
val0
    , Vector a -> Either String (Vector a)
forall a b. b -> Either a b
Right (Vector a -> Either String (Vector a))
-> Parser (Vector a) -> Parser (Either String (Vector a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Vector a)
success
    ]
  case Either String (Vector a)
r of
    Left String
err -> String -> Parser (Vector a)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Right Vector a
vec -> Vector a -> Parser (Vector a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector a
vec
  where
    success :: Parser (Vector a)
success = do
      Vector Value
results <- Value -> Parser (Vector Value)
parseResultsObject Value
val0

      (Vector (Vector Value) -> Vector Value
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Vector Value
series) <- Vector Value
-> (Value -> Parser (Vector Value))
-> Parser (Vector (Vector Value))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector Value
results ((Value -> Parser (Vector Value))
 -> Parser (Vector (Vector Value)))
-> (Value -> Parser (Vector Value))
-> Parser (Vector (Vector Value))
forall a b. (a -> b) -> a -> b
$ \Value
val -> do
        Either String (Vector Value)
r <- (Parser (Either String (Vector Value))
 -> Parser (Either String (Vector Value))
 -> Parser (Either String (Vector Value)))
-> [Parser (Either String (Vector Value))]
-> Parser (Either String (Vector Value))
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Parser (Either String (Vector Value))
-> Parser (Either String (Vector Value))
-> Parser (Either String (Vector Value))
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
          [ String -> Either String (Vector Value)
forall a b. a -> Either a b
Left (String -> Either String (Vector Value))
-> Parser String -> Parser (Either String (Vector Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
parseErrorObject Value
val
          , Vector Value -> Either String (Vector Value)
forall a b. b -> Either a b
Right (Vector Value -> Either String (Vector Value))
-> Parser (Vector Value) -> Parser (Either String (Vector Value))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Vector Value)
parseSeriesObject Value
val
          ]
        case Either String (Vector Value)
r of
          Left String
err -> String -> Parser (Vector Value)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
          Right Vector Value
vec -> Vector Value -> Parser (Vector Value)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Value
vec
      Vector (Vector a)
values <- Vector Value
-> (Value -> Parser (Vector a)) -> Parser (Vector (Vector a))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector Value
series ((Value -> Parser (Vector a)) -> Parser (Vector (Vector a)))
-> (Value -> Parser (Vector a)) -> Parser (Vector (Vector a))
forall a b. (a -> b) -> a -> b
$ \Value
val -> do
        (Maybe Text
name, HashMap Text Text
tags, Vector Text
columns, Vector Value
values) <- Value
-> Parser
     (Maybe Text, HashMap Text Text, Vector Text, Vector Value)
parseSeriesBody Value
val
        Parser (Vector b) -> Parser (Vector a)
decodeFold (Parser (Vector b) -> Parser (Vector a))
-> Parser (Vector b) -> Parser (Vector a)
forall a b. (a -> b) -> a -> b
$ Vector Value -> (Value -> Parser b) -> Parser (Vector b)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector Value
values ((Value -> Parser b) -> Parser (Vector b))
-> (Value -> Parser b) -> Parser (Vector b)
forall a b. (a -> b) -> a -> b
$ String -> (Vector Value -> Parser b) -> Value -> Parser b
forall a. String -> (Vector Value -> Parser a) -> Value -> Parser a
A.withArray String
"values" ((Vector Value -> Parser b) -> Value -> Parser b)
-> (Vector Value -> Parser b) -> Value -> Parser b
forall a b. (a -> b) -> a -> b
$ \Vector Value
fields -> do
          Bool -> Parser () -> Parser ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Vector Text -> Int
forall a. Vector a -> Int
V.length Vector Text
columns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
fields) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ () -> Parser ()
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Parser a -> Parser b
decodeEach (Parser a -> Parser b) -> Parser a -> Parser b
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> HashMap Text Text -> Vector Text -> Vector Value -> Parser a
row Maybe Text
name HashMap Text Text
tags Vector Text
columns Vector Value
fields
      Vector a -> Parser (Vector a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a -> Parser (Vector a)) -> Vector a -> Parser (Vector a)
forall a b. (a -> b) -> a -> b
$! Vector (Vector a) -> Vector a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Vector (Vector a)
values

-- | A decoder to use when parsing a JSON response.
--
-- Use 'strictDecoder' if you want to fail the entire decoding process if
-- there's any failure. Use 'lenientDecoder' if you want the decoding process
-- to collect only successful results.
newtype Decoder = Decoder (forall a. SomeDecoder a)

-- | @'SomeDecoder' a@ represents how to decode a JSON response given a row
-- parser of type @'A.Parser' a@.
data SomeDecoder a = forall b. SomeDecoder
  { ()
decodeEach :: A.Parser a -> A.Parser b
  -- ^ How to decode each row.
  --
  -- For example 'optional' can be used to turn parse
  -- failrues into 'Nothing's.
  , ()
decodeFold :: A.Parser (Vector b) -> A.Parser (Vector a)
  -- ^ How to aggregate rows into the resulting vector.
  --
  -- For example when @b ~ 'Maybe' a@, one way to aggregate the values is to
  -- return only 'Just's.
  }

-- | A decoder that fails immediately if there's any parse failure.
--
-- 'strictDecoder' is defined as follows:
--
-- @
-- strictDecoder :: Decoder
-- strictDecoder = Decoder $ SomeDecoder
--  { decodeEach = id
--  , decodeFold = id
--  }
-- @
strictDecoder :: Decoder
strictDecoder :: Decoder
strictDecoder = (forall a. SomeDecoder a) -> Decoder
Decoder ((forall a. SomeDecoder a) -> Decoder)
-> (forall a. SomeDecoder a) -> Decoder
forall a b. (a -> b) -> a -> b
$ SomeDecoder
  { decodeEach :: Parser a -> Parser a
decodeEach = Parser a -> Parser a
forall a. a -> a
id
  , decodeFold :: Parser (Vector a) -> Parser (Vector a)
decodeFold = Parser (Vector a) -> Parser (Vector a)
forall a. a -> a
id
  }

-- | A decoder that ignores parse failures and returns only successful results.
lenientDecoder :: Decoder
lenientDecoder :: Decoder
lenientDecoder = (forall a. SomeDecoder a) -> Decoder
Decoder ((forall a. SomeDecoder a) -> Decoder)
-> (forall a. SomeDecoder a) -> Decoder
forall a b. (a -> b) -> a -> b
$ SomeDecoder
  { decodeEach :: Parser a -> Parser (Maybe a)
decodeEach = Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
  , decodeFold :: Parser (Vector (Maybe a)) -> Parser (Vector a)
decodeFold = \Parser (Vector (Maybe a))
p -> do
    Vector (Maybe a)
bs <- Parser (Vector (Maybe a))
p
    Vector a -> Parser (Vector a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector a -> Parser (Vector a)) -> Vector a -> Parser (Vector a)
forall a b. (a -> b) -> a -> b
$! (Maybe a -> a) -> Vector (Maybe a) -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map Maybe a -> a
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust (Vector (Maybe a) -> Vector a) -> Vector (Maybe a) -> Vector a
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Bool) -> Vector (Maybe a) -> Vector (Maybe a)
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Vector (Maybe a)
bs
  }

-- | Get a field value from a column name
getField
  :: Fail.MonadFail m
  => Text -- ^ Column name
  -> Vector Text -- ^ Columns
  -> Vector Value -- ^ Field values
  -> m Value
getField :: forall (m :: * -> *).
MonadFail m =>
Text -> Vector Text -> Vector Value -> m Value
getField Text
column Vector Text
columns Vector Value
fields =
  case Text -> Vector Text -> Maybe Int
forall a. Eq a => a -> Vector a -> Maybe Int
V.elemIndex Text
column Vector Text
columns of
    Maybe Int
Nothing -> String -> m Value
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"getField: no such column " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
column
    Just Int
idx -> case Vector Value -> Int -> Maybe Value
forall (m :: * -> *) a. Monad m => Vector a -> Int -> m a
V.indexM Vector Value
fields Int
idx of
      Maybe Value
Nothing -> String -> m Value
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"getField: index out of bound for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
column
      Just Value
field -> Value -> m Value
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
field

-- | Get a tag value from a tag name
getTag
  :: Fail.MonadFail m
  => Text -- ^ Tag name
  -> HashMap Text Value -- ^ Tags
  -> m Value
getTag :: forall (m :: * -> *).
MonadFail m =>
Text -> HashMap Text Value -> m Value
getTag Text
tag HashMap Text Value
tags = case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
tag HashMap Text Value
tags of
  Maybe Value
Nothing -> String -> m Value
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"getTag: no such tag " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
tag
  Just Value
val -> Value -> m Value
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Value
val

-- | Parse a result response.
parseResultsObject :: Value -> A.Parser (Vector A.Value)
parseResultsObject :: Value -> Parser (Vector Value)
parseResultsObject = String
-> (Object -> Parser (Vector Value))
-> Value
-> Parser (Vector Value)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"results" ((Object -> Parser (Vector Value))
 -> Value -> Parser (Vector Value))
-> (Object -> Parser (Vector Value))
-> Value
-> Parser (Vector Value)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> Object
obj Object -> Key -> Parser (Vector Value)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"results"

-- | Parse a series response.
parseSeriesObject :: Value -> A.Parser (Vector A.Value)
parseSeriesObject :: Value -> Parser (Vector Value)
parseSeriesObject = String
-> (Object -> Parser (Vector Value))
-> Value
-> Parser (Vector Value)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"series" ((Object -> Parser (Vector Value))
 -> Value -> Parser (Vector Value))
-> (Object -> Parser (Vector Value))
-> Value
-> Parser (Vector Value)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
  Vector Value -> Maybe (Vector Value) -> Vector Value
forall a. a -> Maybe a -> a
fromMaybe Vector Value
forall a. Vector a
V.empty (Maybe (Vector Value) -> Vector Value)
-> Parser (Maybe (Vector Value)) -> Parser (Vector Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (Maybe (Vector Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"series"

-- | Parse the common JSON structure used in query responses.
parseSeriesBody
  :: Value
  -> A.Parser (Maybe Text, HashMap Text Text, Vector Text, Array)
parseSeriesBody :: Value
-> Parser
     (Maybe Text, HashMap Text Text, Vector Text, Vector Value)
parseSeriesBody = String
-> (Object
    -> Parser
         (Maybe Text, HashMap Text Text, Vector Text, Vector Value))
-> Value
-> Parser
     (Maybe Text, HashMap Text Text, Vector Text, Vector Value)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"series" ((Object
  -> Parser
       (Maybe Text, HashMap Text Text, Vector Text, Vector Value))
 -> Value
 -> Parser
      (Maybe Text, HashMap Text Text, Vector Text, Vector Value))
-> (Object
    -> Parser
         (Maybe Text, HashMap Text Text, Vector Text, Vector Value))
-> Value
-> Parser
     (Maybe Text, HashMap Text Text, Vector Text, Vector Value)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
  !Maybe Text
name <- Object
obj Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
  !Vector Text
columns <- Object
obj Object -> Key -> Parser (Vector Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columns"
  !Vector Value
values <- Object
obj Object -> Key -> Parser (Maybe (Vector Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"values" Parser (Maybe (Vector Value))
-> Vector Value -> Parser (Vector Value)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Vector Value
forall a. Vector a
V.empty
  !HashMap Text Text
tags <- Object
obj Object -> Key -> Parser (Maybe (HashMap Text Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tags" Parser (Maybe (HashMap Text Text))
-> HashMap Text Text -> Parser (HashMap Text Text)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap Text Text
forall k v. HashMap k v
HashMap.empty
  (Maybe Text, HashMap Text Text, Vector Text, Vector Value)
-> Parser
     (Maybe Text, HashMap Text Text, Vector Text, Vector Value)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
name, HashMap Text Text
tags, Vector Text
columns, Vector Value
values)

-- | Parse the common JSON structure used in failure response.
-- >>> A.parse parseErrorObject $ fromJust $ decode "{ \"error\": \"custom error\" }"
-- Success "custom error"
-- >>> A.parse parseErrorObject $ fromJust $ decode "{ \"message\": \"custom error\" }"
-- Success "custom error"
parseErrorObject :: A.Value -> A.Parser String
parseErrorObject :: Value -> Parser String
parseErrorObject = String -> (Object -> Parser String) -> Value -> Parser String
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"error" ((Object -> Parser String) -> Value -> Parser String)
-> (Object -> Parser String) -> Value -> Parser String
forall a b. (a -> b) -> a -> b
$ \Object
obj -> Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error" Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
obj Object -> Key -> Parser String
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"

-- | Parse either a POSIX timestamp or RFC3339 formatted timestamp as 'UTCTime'.
parseUTCTime :: Precision ty -> A.Value -> A.Parser UTCTime
parseUTCTime :: forall (ty :: RequestType). Precision ty -> Value -> Parser UTCTime
parseUTCTime Precision ty
prec Value
val = case Precision ty
prec of
  Precision ty
RFC3339 -> Value -> Parser UTCTime
forall time. ParseTime time => Value -> Parser time
parseRFC3339 Value
val
  Precision ty
_ -> POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> Parser POSIXTime -> Parser UTCTime
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Precision ty -> Value -> Parser POSIXTime
forall (ty :: RequestType).
Precision ty -> Value -> Parser POSIXTime
parsePOSIXTime Precision ty
prec Value
val

-- | Parse either a POSIX timestamp or RFC3339 formatted timestamp as
-- 'POSIXTime'.
parsePOSIXTime :: Precision ty -> A.Value -> A.Parser POSIXTime
parsePOSIXTime :: forall (ty :: RequestType).
Precision ty -> Value -> Parser POSIXTime
parsePOSIXTime Precision ty
prec Value
val = case Precision ty
prec of
  Precision ty
RFC3339 -> UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime) -> Parser UTCTime -> Parser POSIXTime
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Value -> Parser UTCTime
forall time. ParseTime time => Value -> Parser time
parseRFC3339 Value
val
  Precision ty
_ -> String
-> (Scientific -> Parser POSIXTime) -> Value -> Parser POSIXTime
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
A.withScientific String
err
    (\Scientific
s -> case Scientific -> Maybe POSIXTime
timestampToUTC Scientific
s of
      Maybe POSIXTime
Nothing -> String -> Value -> Parser POSIXTime
forall a. String -> Value -> Parser a
A.typeMismatch String
err Value
val
      Just !POSIXTime
utc -> POSIXTime -> Parser POSIXTime
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return POSIXTime
utc)
    Value
val
  where
    err :: String
err = String
"POSIX timestamp in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack (Precision ty -> Text
forall (ty :: RequestType). Precision ty -> Text
precisionName Precision ty
prec)
    timestampToUTC :: Scientific -> Maybe POSIXTime
timestampToUTC Scientific
s = do
      Int
n <- Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Sci.toBoundedInteger Scientific
s
      POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (POSIXTime -> Maybe POSIXTime) -> POSIXTime -> Maybe POSIXTime
forall a b. (a -> b) -> a -> b
$! Int -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n :: Int) POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* Precision ty -> POSIXTime
forall a (ty :: RequestType). Fractional a => Precision ty -> a
precisionScale Precision ty
prec

-- | Parse a RFC3339-formatted timestamp.
--
-- Note that this parser is slow as it converts a 'T.Text' input to a
-- 'Prelude.String' before parsing.
parseRFC3339 :: ParseTime time => A.Value -> A.Parser time
parseRFC3339 :: forall time. ParseTime time => Value -> Parser time
parseRFC3339 Value
val = String -> (Text -> Parser time) -> Value -> Parser time
forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
err
  (Parser time -> (time -> Parser time) -> Maybe time -> Parser time
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Value -> Parser time
forall a. String -> Value -> Parser a
A.typeMismatch String
err Value
val) (time -> Parser time
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (time -> Parser time) -> time -> Parser time
forall a b. (a -> b) -> a -> b
$!)
    (Maybe time -> Parser time)
-> (Text -> Maybe time) -> Text -> Parser time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> Maybe time
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
fmt
    (String -> Maybe time) -> (Text -> String) -> Text -> Maybe time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack)
  Value
val
  where
    fmt, err :: String
    fmt :: String
fmt = String
"%FT%X%QZ"
    err :: String
err = String
"RFC3339-formatted timestamp"