{-# 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

-- | 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 :: (Maybe Text
 -> HashMap Text Text -> Vector Text -> Array -> Parser a)
-> Value -> Parser (Vector a)
parseResultsWith = Decoder
-> (Maybe Text
    -> HashMap Text Text -> Vector Text -> Array -> Parser a)
-> Value
-> Parser (Vector a)
forall a.
Decoder
-> (Maybe Text
    -> HashMap Text Text -> Vector Text -> Array -> 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 :: Decoder
-> (Maybe Text
    -> HashMap Text Text -> Vector Text -> Array -> Parser a)
-> Value
-> Parser (Vector a)
parseResultsWithDecoder (Decoder SomeDecoder {..}) Maybe Text -> HashMap Text Text -> Vector Text -> Array -> 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 (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 (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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    Right Vector a
vec -> Vector a -> Parser (Vector a)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector a
vec
  where
    success :: Parser (Vector a)
success = do
      Array
results <- Value -> Parser Array
parseResultsObject Value
val0

      (Vector Array -> Array
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join -> Array
series) <- Array -> (Value -> Parser Array) -> Parser (Vector Array)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Array
results ((Value -> Parser Array) -> Parser (Vector Array))
-> (Value -> Parser Array) -> Parser (Vector Array)
forall a b. (a -> b) -> a -> b
$ \Value
val -> do
        Either String Array
r <- (Parser (Either String Array)
 -> Parser (Either String Array) -> Parser (Either String Array))
-> [Parser (Either String Array)] -> Parser (Either String Array)
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Parser (Either String Array)
-> Parser (Either String Array) -> Parser (Either String Array)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
          [ String -> Either String Array
forall a b. a -> Either a b
Left (String -> Either String Array)
-> Parser String -> Parser (Either String Array)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser String
parseErrorObject Value
val
          , Array -> Either String Array
forall a b. b -> Either a b
Right (Array -> Either String Array)
-> Parser Array -> Parser (Either String Array)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Array
parseSeriesObject Value
val
          ]
        case Either String Array
r of
          Left String
err -> String -> Parser Array
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
          Right Array
vec -> Array -> Parser Array
forall (m :: * -> *) a. Monad m => a -> m a
return Array
vec
      Vector (Vector a)
values <- Array -> (Value -> Parser (Vector a)) -> Parser (Vector (Vector a))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Array
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, Array
values) <- Value -> Parser (Maybe Text, HashMap Text Text, Vector Text, Array)
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
$ Array -> (Value -> Parser b) -> Parser (Vector b)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Array
values ((Value -> Parser b) -> Parser (Vector b))
-> (Value -> Parser b) -> Parser (Vector b)
forall a b. (a -> b) -> a -> b
$ String -> (Array -> Parser b) -> Value -> Parser b
forall a. String -> (Array -> Parser a) -> Value -> Parser a
A.withArray String
"values" ((Array -> Parser b) -> Value -> Parser b)
-> (Array -> Parser b) -> Value -> Parser b
forall a b. (a -> b) -> a -> b
$ \Array
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
== Array -> Int
forall a. Vector a -> Int
V.length Array
fields) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ () -> Parser ()
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 -> Array -> Parser a
row Maybe Text
name HashMap Text Text
tags Vector Text
columns Array
fields
      Vector a -> Parser (Vector 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 :: forall a b.
(Parser a -> Parser b)
-> (Parser (Vector b) -> Parser (Vector a)) -> SomeDecoder a
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 :: forall a b.
(Parser a -> Parser b)
-> (Parser (Vector b) -> Parser (Vector a)) -> SomeDecoder a
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 (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 :: Text -> Vector Text -> Array -> m Value
getField Text
column Vector Text
columns Array
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 (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 Array -> Int -> Maybe Value
forall (m :: * -> *) a. Monad m => Vector a -> Int -> m a
V.indexM Array
fields Int
idx of
      Maybe Value
Nothing -> String -> m Value
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 (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 :: 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 (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 (m :: * -> *) a. Monad m => a -> m a
return Value
val

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

-- | Parse a series response.
parseSeriesObject :: Value -> A.Parser (Vector A.Value)
parseSeriesObject :: Value -> Parser Array
parseSeriesObject = String
-> (HashMap Text Value -> Parser Array) -> Value -> Parser Array
forall a.
String -> (HashMap Text Value -> Parser a) -> Value -> Parser a
A.withObject String
"series" ((HashMap Text Value -> Parser Array) -> Value -> Parser Array)
-> (HashMap Text Value -> Parser Array) -> Value -> Parser Array
forall a b. (a -> b) -> a -> b
$ \HashMap Text Value
obj ->
  Array -> Maybe Array -> Array
forall a. a -> Maybe a -> a
fromMaybe Array
forall a. Vector a
V.empty (Maybe Array -> Array) -> Parser (Maybe Array) -> Parser Array
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text Value
obj HashMap Text Value -> Text -> Parser (Maybe Array)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"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, Array)
parseSeriesBody = String
-> (HashMap Text Value
    -> Parser (Maybe Text, HashMap Text Text, Vector Text, Array))
-> Value
-> Parser (Maybe Text, HashMap Text Text, Vector Text, Array)
forall a.
String -> (HashMap Text Value -> Parser a) -> Value -> Parser a
A.withObject String
"series" ((HashMap Text Value
  -> Parser (Maybe Text, HashMap Text Text, Vector Text, Array))
 -> Value
 -> Parser (Maybe Text, HashMap Text Text, Vector Text, Array))
-> (HashMap Text Value
    -> Parser (Maybe Text, HashMap Text Text, Vector Text, Array))
-> Value
-> Parser (Maybe Text, HashMap Text Text, Vector Text, Array)
forall a b. (a -> b) -> a -> b
$ \HashMap Text Value
obj -> do
  !Maybe Text
name <- HashMap Text Value
obj HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"name"
  !Vector Text
columns <- HashMap Text Value
obj HashMap Text Value -> Text -> Parser (Vector Text)
forall a. FromJSON a => HashMap Text Value -> Text -> Parser a
.: Text
"columns"
  !Array
values <- HashMap Text Value
obj HashMap Text Value -> Text -> Parser (Maybe Array)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"values" Parser (Maybe Array) -> Array -> Parser Array
forall a. Parser (Maybe a) -> a -> Parser a
.!= Array
forall a. Vector a
V.empty
  !HashMap Text Text
tags <- HashMap Text Value
obj HashMap Text Value -> Text -> Parser (Maybe (HashMap Text Text))
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"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, Array)
-> Parser (Maybe Text, HashMap Text Text, Vector Text, Array)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
name, HashMap Text Text
tags, Vector Text
columns, Array
values)

-- | Parse the common JSON structure used in failure response.
parseErrorObject :: A.Value -> A.Parser String
parseErrorObject :: Value -> Parser String
parseErrorObject = String
-> (HashMap Text Value -> Parser String) -> Value -> Parser String
forall a.
String -> (HashMap Text Value -> Parser a) -> Value -> Parser a
A.withObject String
"error" ((HashMap Text Value -> Parser String) -> Value -> Parser String)
-> (HashMap Text Value -> Parser String) -> Value -> Parser String
forall a b. (a -> b) -> a -> b
$ \HashMap Text Value
obj -> HashMap Text Value
obj HashMap Text Value -> Text -> Parser String
forall a. FromJSON a => HashMap Text Value -> Text -> Parser a
.: Text
"error"

-- | Parse either a POSIX timestamp or RFC3339 formatted timestamp as 'UTCTime'.
parseUTCTime :: Precision ty -> A.Value -> A.Parser UTCTime
parseUTCTime :: 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 :: 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 (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 (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 :: 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 (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"