influxdb 1.7.1.6 → 1.8.0
raw patch · 9 files changed
+255/−114 lines, 9 filesdep ~lensdep ~vectorPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: lens, vector
API changes (from Hackage documentation)
- Database.InfluxDB: Decoder :: (Parser a -> Parser b) -> (Parser (Vector b) -> Parser (Vector a)) -> Decoder a
- Database.InfluxDB: [decodeEach] :: Decoder a -> Parser a -> Parser b
- Database.InfluxDB: [decodeFold] :: Decoder a -> Parser (Vector b) -> Parser (Vector a)
- Database.InfluxDB: newtype Tagged (s :: k) b :: forall k. () => k -> Type -> Type
- Database.InfluxDB: parseQueryField :: Value -> Parser QueryField
- Database.InfluxDB: parseResultsWith :: (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> Parser a) -> Value -> Parser (Vector a)
- Database.InfluxDB: parseResultsWithDecoder :: Decoder a -> (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> Parser a) -> Value -> Parser (Vector a)
- Database.InfluxDB.Format: instance (a Data.Type.Equality.~ r) => Data.String.IsString (Database.InfluxDB.Format.Format a r)
- Database.InfluxDB.JSON: data Decoder a
- Database.InfluxDB.JSON: parseQueryField :: Value -> Parser QueryField
- Database.InfluxDB.Query: newtype Tagged (s :: k) b :: forall k. () => k -> Type -> Type
- Database.InfluxDB.Query: parseResultsWith :: (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> Parser a) -> Value -> Parser (Vector a)
+ Database.InfluxDB: decoder :: Lens' QueryParams Decoder
+ Database.InfluxDB: newtype Tagged (s :: k) b
+ Database.InfluxDB: parseMeasurement :: QueryResults a => Precision 'QueryRequest -> Maybe Text -> HashMap Text Text -> Vector Text -> Array -> Parser a
+ Database.InfluxDB.Format: instance (a GHC.Types.~ r) => Data.String.IsString (Database.InfluxDB.Format.Format a r)
+ Database.InfluxDB.JSON: SomeDecoder :: (Parser a -> Parser b) -> (Parser (Vector b) -> Parser (Vector a)) -> SomeDecoder a
+ Database.InfluxDB.JSON: data SomeDecoder a
+ Database.InfluxDB.JSON: newtype Decoder
+ Database.InfluxDB.Query: authentication :: HasCredentials a => Lens' a (Maybe Credentials)
+ Database.InfluxDB.Query: decoder :: Lens' QueryParams Decoder
+ Database.InfluxDB.Query: newtype Tagged (s :: k) b
+ Database.InfluxDB.Query: parseMeasurement :: QueryResults a => Precision 'QueryRequest -> Maybe Text -> HashMap Text Text -> Vector Text -> Array -> Parser a
+ Database.InfluxDB.Query: parseQueryResults :: QueryResults a => Precision 'QueryRequest -> Value -> Parser (Vector a)
+ Database.InfluxDB.Query: parseQueryResultsWith :: QueryResults a => Decoder -> Precision 'QueryRequest -> Value -> Parser (Vector a)
- Database.InfluxDB: Tagged :: b -> Tagged b
+ Database.InfluxDB: Tagged :: b -> Tagged (s :: k) b
- Database.InfluxDB: [FieldNull] :: Field 'Nullable
+ Database.InfluxDB: [FieldNull] :: Field 'Nullable
- Database.InfluxDB: [RFC3339] :: Precision 'QueryRequest
+ Database.InfluxDB: [RFC3339] :: Precision 'QueryRequest
- Database.InfluxDB: [unTagged] :: Tagged b -> b
+ Database.InfluxDB: [unTagged] :: Tagged (s :: k) b -> b
- Database.InfluxDB: data Decoder a
+ Database.InfluxDB: data Decoder
- Database.InfluxDB: lenientDecoder :: Decoder a
+ Database.InfluxDB: lenientDecoder :: Decoder
- Database.InfluxDB: parseResults :: QueryResults a => Precision 'QueryRequest -> Value -> Parser (Vector a)
+ Database.InfluxDB: parseResults :: QueryResults a => Precision 'QueryRequest -> Value -> Parser (Vector a)
- Database.InfluxDB: roundTo :: Timestamp time => Precision 'WriteRequest -> time -> Int64
+ Database.InfluxDB: roundTo :: Timestamp time => Precision 'WriteRequest -> time -> Int64
- Database.InfluxDB: scaleTo :: Timestamp time => Precision 'WriteRequest -> time -> Int64
+ Database.InfluxDB: scaleTo :: Timestamp time => Precision 'WriteRequest -> time -> Int64
- Database.InfluxDB: strictDecoder :: Decoder a
+ Database.InfluxDB: strictDecoder :: Decoder
- Database.InfluxDB: type LineField = Field 'NonNullable
+ Database.InfluxDB: type LineField = Field 'NonNullable
- Database.InfluxDB: type QueryField = Field 'Nullable
+ Database.InfluxDB: type QueryField = Field 'Nullable
- Database.InfluxDB: untag :: () => Tagged s b -> b
+ Database.InfluxDB: untag :: forall k (s :: k) b. Tagged s b -> b
- Database.InfluxDB.JSON: Decoder :: (Parser a -> Parser b) -> (Parser (Vector b) -> Parser (Vector a)) -> Decoder a
+ Database.InfluxDB.JSON: Decoder :: (forall a. SomeDecoder a) -> Decoder
- Database.InfluxDB.JSON: [decodeEach] :: Decoder a -> Parser a -> Parser b
+ Database.InfluxDB.JSON: [decodeEach] :: SomeDecoder a -> Parser a -> Parser b
- Database.InfluxDB.JSON: [decodeFold] :: Decoder a -> Parser (Vector b) -> Parser (Vector a)
+ Database.InfluxDB.JSON: [decodeFold] :: SomeDecoder a -> Parser (Vector b) -> Parser (Vector a)
- Database.InfluxDB.JSON: lenientDecoder :: Decoder a
+ Database.InfluxDB.JSON: lenientDecoder :: Decoder
- Database.InfluxDB.JSON: parseErrorObject :: Value -> Parser a
+ Database.InfluxDB.JSON: parseErrorObject :: Value -> Parser String
- Database.InfluxDB.JSON: parseResultsWithDecoder :: Decoder a -> (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> Parser a) -> Value -> Parser (Vector a)
+ Database.InfluxDB.JSON: parseResultsWithDecoder :: Decoder -> (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> Parser a) -> Value -> Parser (Vector a)
- Database.InfluxDB.JSON: strictDecoder :: Decoder a
+ Database.InfluxDB.JSON: strictDecoder :: Decoder
- Database.InfluxDB.Line: [FieldNull] :: Field 'Nullable
+ Database.InfluxDB.Line: [FieldNull] :: Field 'Nullable
- Database.InfluxDB.Line: [RFC3339] :: Precision 'QueryRequest
+ Database.InfluxDB.Line: [RFC3339] :: Precision 'QueryRequest
- Database.InfluxDB.Line: type LineField = Field 'NonNullable
+ Database.InfluxDB.Line: type LineField = Field 'NonNullable
- Database.InfluxDB.Query: Tagged :: b -> Tagged b
+ Database.InfluxDB.Query: Tagged :: b -> Tagged (s :: k) b
- Database.InfluxDB.Query: [unTagged] :: Tagged b -> b
+ Database.InfluxDB.Query: [unTagged] :: Tagged (s :: k) b -> b
- Database.InfluxDB.Query: parseResults :: QueryResults a => Precision 'QueryRequest -> Value -> Parser (Vector a)
+ Database.InfluxDB.Query: parseResults :: QueryResults a => Precision 'QueryRequest -> Value -> Parser (Vector a)
- Database.InfluxDB.Query: untag :: () => Tagged s b -> b
+ Database.InfluxDB.Query: untag :: forall k (s :: k) b. Tagged s b -> b
- Database.InfluxDB.Types: [FieldNull] :: Field 'Nullable
+ Database.InfluxDB.Types: [FieldNull] :: Field 'Nullable
- Database.InfluxDB.Types: [RFC3339] :: Precision 'QueryRequest
+ Database.InfluxDB.Types: [RFC3339] :: Precision 'QueryRequest
- Database.InfluxDB.Types: roundTo :: Timestamp time => Precision 'WriteRequest -> time -> Int64
+ Database.InfluxDB.Types: roundTo :: Timestamp time => Precision 'WriteRequest -> time -> Int64
- Database.InfluxDB.Types: scaleTo :: Timestamp time => Precision 'WriteRequest -> time -> Int64
+ Database.InfluxDB.Types: scaleTo :: Timestamp time => Precision 'WriteRequest -> time -> Int64
- Database.InfluxDB.Types: type LineField = Field 'NonNullable
+ Database.InfluxDB.Types: type LineField = Field 'NonNullable
- Database.InfluxDB.Types: type QueryField = Field 'Nullable
+ Database.InfluxDB.Types: type QueryField = Field 'Nullable
Files
- CHANGELOG.md +15/−0
- README.md +1/−1
- examples/random-points.hs +1/−2
- influxdb.cabal +3/−1
- src/Database/InfluxDB.hs +3/−5
- src/Database/InfluxDB/JSON.hs +64/−49
- src/Database/InfluxDB/Manage.hs +26/−27
- src/Database/InfluxDB/Query.hs +77/−17
- tests/regressions.hs +65/−12
CHANGELOG.md view
@@ -1,5 +1,20 @@ # Revision history for influxdb +## v1.8.0 - 2020-06-19++This release reworked the `QueryResuls` type class. There are some breaking changes:++* `parseResults` has been deprecated. `QueryResults` has now `parseMeasurement` method.+* `Decoder` has been monomorphized so that it can be used with lens. The original `Decoder` type has been renamed to `SomeDecoder`.+* `QueryParams` has now `decoder` field.+* `parseResults` and `parseResultsWith` had been using `lenientDecoder` and it caused some unintuitive behavior ([#64](https://github.com/maoe/influxdb-haskell/issues/64), [#66](https://github.com/maoe/influxdb-haskell/issues/66)). Now they use `strictDecoder` instead.+* `parseErrorObject` now doesn't fail. It returns the error message of a response.+* `parseQueryField` which has been deprecated is now deleted.+* `QueryResults` instance for `ShowSeries` was broken. This is fixed.+* The constructor of `Decoder`, `parseResultsWith`, and `parseResultsWithDecoder` have been hidden from the top-level module. They're still available from `Database.InfluxDB.JSON`.++See [#68](https://github.com/maoe/influxdb-haskell/pull/68/files) for how to migrate your code from v1.7.x to v1.8.x.+ ## v1.7.1.6 - 2020-06-03 * Relax upper version bound for doctest
README.md view
@@ -6,7 +6,7 @@ [](https://matrix.hackage.haskell.org/package/influxdb) [](https://gitter.im/maoe/influxdb-haskell?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge) -Currently this library is tested against InfluxDB 1.7.+Currently this library is tested against InfluxDB 1.8. ## Getting started
examples/random-points.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-} import Data.Foldable@@ -76,7 +75,7 @@ } deriving Show instance QueryResults Row where- parseResults prec = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement prec _ _ columns fields = do rowTime <- getField "time" columns fields >>= parsePOSIXTime prec String name <- getField "value" columns fields rowValue <- case name of
influxdb.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.24 name: influxdb-version: 1.7.1.6+version: 1.8.0 synopsis: Haskell client library for InfluxDB description: @influxdb@ is an InfluxDB client library for Haskell.@@ -115,10 +115,12 @@ base , containers , influxdb+ , lens , tasty , tasty-hunit , time , raw-strings-qq >= 1.1 && < 1.2+ , vector ghc-options: -Wall -threaded hs-source-dirs: tests default-language: Haskell2010
src/Database/InfluxDB.hs view
@@ -45,12 +45,11 @@ , QueryParams , queryParams , authentication+ , decoder -- ** Parsing results , QueryResults(..)- , parseResultsWith- , parseResultsWithDecoder- , Decoder(..)+ , Decoder , lenientDecoder , strictDecoder , getField@@ -58,7 +57,6 @@ , parseJSON , parseUTCTime , parsePOSIXTime- , parseQueryField -- *** Re-exports from tagged , Tagged(..)@@ -200,7 +198,7 @@ , cpuIdle, cpuSystem, cpuUser :: Double } deriving Show instance QueryResults CPUUsage where- parseResults prec = parseResultsWithDecoder strictDecoder $ \_ _ columns fields -> do+ parseMeasurement prec _name _tags columns fields = do time <- getField "time" columns fields >>= parseUTCTime prec cpuIdle <- getField "idle" columns fields >>= parseJSON cpuSystem <- getField "system" columns fields >>= parseJSON
src/Database/InfluxDB/JSON.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Database.InfluxDB.JSON@@ -12,6 +13,7 @@ -- ** Decoder settings , Decoder(..)+ , SomeDecoder(..) , strictDecoder , lenientDecoder @@ -24,7 +26,6 @@ , parseUTCTime , parsePOSIXTime , parseRFC3339- , parseQueryField -- ** Utility functions , parseResultsObject , parseSeriesObject@@ -34,8 +35,10 @@ import Control.Applicative import Control.Exception import Control.Monad-import qualified Control.Monad.Fail as Fail+import Data.Foldable import Data.Maybe+import Prelude+import qualified Control.Monad.Fail as Fail import Data.Aeson import Data.HashMap.Strict (HashMap)@@ -52,43 +55,51 @@ import Database.InfluxDB.Types --- | Parse a JSON response with the 'lenientDecoder'. This can be useful to--- implement the 'Database.InfluxDB.Query.parseResults' method.+-- | Parse a JSON response with the 'strictDecoder'. parseResultsWith :: (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> A.Parser a)- -- ^ A parser that takes+ -- ^ 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 names- -- 4. an array of values- --- -- to construct a value.- -> Value+ -- 3. an array of field keys+ -- 4. an array of field values+ -> Value -- ^ JSON response -> A.Parser (Vector a)-parseResultsWith = parseResultsWithDecoder lenientDecoder+parseResultsWith = parseResultsWithDecoder strictDecoder -- | Parse a JSON response with the specified decoder settings. parseResultsWithDecoder- :: Decoder a+ :: Decoder -> (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> A.Parser a)- -- ^ A parser that takes+ -- ^ 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 names- -- 4. an array of values- --- -- to construct a value.- -> Value+ -- 3. an array of field keys+ -- 4. an array of field values+ -> Value -- ^ JSON response -> A.Parser (Vector a)-parseResultsWithDecoder Decoder {..} row val0 = success+parseResultsWithDecoder (Decoder SomeDecoder {..}) row val0 = do+ r <- foldr1 (<|>)+ [ Left <$> parseErrorObject val0+ , Right <$> success+ ]+ case r of+ Left err -> fail err+ Right vec -> return vec where success = do results <- parseResultsObject val0 - (join -> series) <- V.forM results $ \val ->- parseSeriesObject val <|> parseErrorObject val+ (join -> series) <- V.forM results $ \val -> do+ r <- foldr1 (<|>)+ [ Left <$> parseErrorObject val+ , Right <$> parseSeriesObject val+ ]+ case r of+ Left err -> fail err+ Right vec -> return vec values <- V.forM series $ \val -> do (name, tags, columns, values) <- parseSeriesBody val decodeFold $ V.forM values $ A.withArray "values" $ \fields -> do@@ -96,25 +107,48 @@ decodeEach $ row name tags columns fields return $! join values --- | Decoder settings-data Decoder a = forall b. Decoder+-- | 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+ -- ^ 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 :: Decoder a-strictDecoder = Decoder+--+-- 'strictDecoder' is defined as follows:+--+-- @+-- strictDecoder :: Decoder+-- strictDecoder = Decoder $ SomeDecoder+-- { decodeEach = id+-- , decodeFold = id+-- }+-- @+strictDecoder :: Decoder+strictDecoder = Decoder $ SomeDecoder { decodeEach = id , decodeFold = id } -- | A decoder that ignores parse failures and returns only successful results.-lenientDecoder :: Decoder a-lenientDecoder = Decoder+lenientDecoder :: Decoder+lenientDecoder = Decoder $ SomeDecoder { decodeEach = optional , decodeFold = \p -> do bs <- p@@ -166,10 +200,8 @@ return (name, tags, columns, values) -- | Parse the common JSON structure used in failure response.-parseErrorObject :: A.Value -> A.Parser a-parseErrorObject = A.withObject "error" $ \obj -> do- message <- obj .: "error"- fail $ T.unpack message+parseErrorObject :: A.Value -> A.Parser String+parseErrorObject = A.withObject "error" $ \obj -> obj .: "error" -- | Parse either a POSIX timestamp or RFC3339 formatted timestamp as 'UTCTime'. parseUTCTime :: Precision ty -> A.Value -> A.Parser UTCTime@@ -207,20 +239,3 @@ fmt, err :: String fmt = "%FT%X%QZ" err = "RFC3339-formatted timestamp"---- | Parse a 'QueryField'.-parseQueryField :: A.Value -> A.Parser QueryField-parseQueryField val = case val of- A.Number sci ->- return $! either FieldFloat FieldInt $ Sci.floatingOrInteger sci- A.String txt ->- return $! FieldString txt- A.Bool b ->- return $! FieldBool b- A.Null ->- return FieldNull- _ -> fail $ "parseQueryField: expected a flat data structure, but got "- ++ show val-{-# DEPRECATED parseQueryField- "This function parses numbers in a misleading way. Use 'parseJSON' instead."- #-}
src/Database/InfluxDB/Manage.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -33,7 +35,6 @@ , ShowSeries , key ) where-import Control.Applicative import Control.Exception import Control.Monad @@ -74,19 +75,20 @@ case eitherDecode' body of Left message -> throwIO $ UnexpectedResponse message request body- Right val -> case A.parse (parseResults (params^.precision)) val of- A.Success (_ :: V.Vector Void) -> return ()- A.Error message -> do- let status = HC.responseStatus response- when (HT.statusIsServerError status) $- throwIO $ ServerError message- when (HT.statusIsClientError status) $- throwIO $ ClientError message request- throwIO $ UnexpectedResponse- ("BUG: " ++ message ++ " in Database.InfluxDB.Manage.manage")- request- (encode val)-+ Right val -> do+ let parser = parseQueryResultsWith (params^.decoder) (params^.precision)+ case A.parse parser val of+ A.Success (_ :: V.Vector Void) -> return ()+ A.Error message -> do+ let status = HC.responseStatus response+ when (HT.statusIsServerError status) $+ throwIO $ ServerError message+ when (HT.statusIsClientError status) $+ throwIO $ ClientError message request+ throwIO $ UnexpectedResponse+ ("BUG: " ++ message ++ " in Database.InfluxDB.Manage.manage")+ request+ (encode val) where request = HC.setQueryString qs $ manageRequest params qs =@@ -114,29 +116,26 @@ } instance QueryResults ShowQuery where- parseResults _ = parseResultsWith $ \_ _ columns fields ->+ parseMeasurement _ _ _ columns fields = maybe (fail "parseResults: parse error") return $ do Number (toBoundedInteger -> Just showQueryQid) <-- V.elemIndex "qid" columns >>= V.indexM fields+ getField "qid" columns fields String (F.formatQuery F.text -> showQueryText) <-- V.elemIndex "query" columns >>= V.indexM fields+ getField "query" columns fields String (F.formatDatabase F.text -> showQueryDatabase) <-- V.elemIndex "database" columns >>= V.indexM fields+ getField "database" columns fields String (parseDuration -> Right showQueryDuration) <-- V.elemIndex "duration" columns >>= V.indexM fields+ getField "duration" columns fields return ShowQuery {..} parseDuration :: Text -> Either String NominalDiffTime-parseDuration = AT.parseOnly $ sum <$!> durations+parseDuration = AT.parseOnly duration where- durations = some $ (*)- <$> fmap fromIntegral int+ duration = (*)+ <$> fmap (fromIntegral @Int) AT.decimal <*> unit- where- int :: AT.Parser Int- int = AT.decimal unit = AC.choice- [ 10^^(-6 :: Int) <$ AT.char 'u'+ [ 10^^(-6 :: Int) <$ AT.string "µs" , 1 <$ AT.char 's' , 60 <$ AT.char 'm' , 3600 <$ AT.char 'h'@@ -147,7 +146,7 @@ } instance QueryResults ShowSeries where- parseResults _ = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement _ _ _ columns fields = do name <- getField "key" columns fields >>= parseJSON return $ ShowSeries $ F.formatKey F.text name
src/Database/InfluxDB/Query.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}@@ -24,10 +25,13 @@ , database , precision , manager+ , authentication+ , decoder -- * Parsing results , QueryResults(..)- , parseResultsWith+ , parseQueryResults+ , parseQueryResultsWith -- * Low-level functions , withQueryResponse@@ -45,8 +49,10 @@ import Control.Lens import Data.Aeson+import Data.HashMap.Strict (HashMap) import Data.Optional (Optional(..), optional) import Data.Tagged+import Data.Text (Text) import Data.Vector (Vector) import Data.Void import qualified Control.Foldl as L@@ -58,7 +64,6 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.Text.Encoding as TE import qualified Data.Text as T-import qualified Data.Vector as V import qualified Network.HTTP.Client as HC import qualified Network.HTTP.Types as HT @@ -70,6 +75,7 @@ -- >>> :set -XOverloadedStrings -- >>> :set -XRecordWildCards -- >>> import Data.Time (UTCTime)+-- >>> import qualified Data.Vector as V -- | Types that can be converted from an JSON object returned by InfluxDB. --@@ -85,7 +91,7 @@ -- , waterLevel :: Double -- } -- instance QueryResults H2OFeet where--- parseResults prec = parseResultsWith $ \_ _ columns fields -> do+-- parseMeasurement prec _name _tags columns fields = do -- time <- getField "time" columns fields >>= parseUTCTime prec -- levelDesc <- getField "level_description" columns fields >>= parseJSON -- location <- getField "location" columns fields >>= parseJSON@@ -98,10 +104,46 @@ :: Precision 'QueryRequest -> Value -> A.Parser (Vector a)+ parseResults = parseQueryResultsWith strictDecoder + -- | Parse a measurement in a JSON object.+ parseMeasurement+ :: Precision 'QueryRequest+ -- ^ Timestamp precision+ -> Maybe Text+ -- ^ Optional series name+ -> HashMap Text Text+ -- ^ Tag set+ -> Vector Text+ -- ^ Field keys+ -> Array+ -- ^ Field values+ -> A.Parser a++{-# DEPRECATED parseResults+ "Use 'parseQueryResults' or 'parseQueryResultsWith' " #-}++-- | Parse a JSON object as an array of values of expected type.+parseQueryResults+ :: QueryResults a+ => Precision 'QueryRequest+ -> Value+ -> A.Parser (Vector a)+parseQueryResults = parseQueryResultsWith strictDecoder++parseQueryResultsWith+ :: QueryResults a+ => Decoder+ -> Precision 'QueryRequest+ -> Value+ -> A.Parser (Vector a)+parseQueryResultsWith decoder prec =+ parseResultsWithDecoder decoder (parseMeasurement prec)++-- | 'QueryResults' instance for empty results. Used by+-- 'Database.InfluxDB.Manage.manage'. instance QueryResults Void where- parseResults _ = A.withObject "error" $ \obj -> obj .:? "error"- >>= maybe (pure V.empty) (withText "error" $ fail . T.unpack)+ parseMeasurement _ _ _ _ _ = parseJSON A.emptyArray fieldName :: KnownSymbol k => proxy k -> T.Text fieldName = T.pack . symbolVal@@ -113,7 +155,7 @@ -- >>> find ((== "_internal") . untag) dbs -- Just (Tagged "_internal") instance (KnownSymbol k, FromJSON v) => QueryResults (Tagged k v) where- parseResults _ = parseResultsWith $ \_ _ columns fields ->+ parseMeasurement _ _name _ columns fields = getField (fieldName (Proxy :: Proxy k)) columns fields >>= parseJSON -- | One-off tuple for sigle-field measurements@@ -121,7 +163,7 @@ ( KnownSymbol k1, FromJSON v1 , KnownSymbol k2, FromJSON v2 ) => QueryResults (Tagged k1 v1, Tagged k2 v2) where- parseResults _ = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON@@ -134,7 +176,7 @@ , KnownSymbol k2, FromJSON v2 , KnownSymbol k3, FromJSON v3 ) => QueryResults (Tagged k1 v1, Tagged k2 v2, Tagged k3 v3) where- parseResults _ = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON@@ -150,7 +192,7 @@ , KnownSymbol k3, FromJSON v3 , KnownSymbol k4, FromJSON v4 ) => QueryResults (Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4) where- parseResults _ = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON@@ -172,7 +214,7 @@ ( Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4 , Tagged k5 v5 ) where- parseResults _ = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON@@ -197,7 +239,7 @@ ( Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4 , Tagged k5 v5, Tagged k6 v6 ) where- parseResults _ = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON@@ -225,7 +267,7 @@ ( Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4 , Tagged k5 v5, Tagged k6 v6, Tagged k7 v7 ) where- parseResults _ = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON@@ -256,7 +298,7 @@ ( Tagged k1 v1, Tagged k2 v2, Tagged k3 v3, Tagged k4 v4 , Tagged k5 v5, Tagged k6 v6, Tagged k7 v7, Tagged k8 v8 ) where- parseResults _ = parseResultsWith $ \_ _ columns fields -> do+ parseMeasurement _ _ _ columns fields = do v1 <- parseJSON =<< getField (fieldName (Proxy :: Proxy k1)) columns fields v2 <- parseJSON@@ -282,8 +324,9 @@ -- * 'server' -- * 'database' -- * 'precision'--- * 'authentication' -- * 'manager'+-- * 'authentication'+-- * 'decoder' data QueryParams = QueryParams { queryServer :: !Server , queryDatabase :: !Database@@ -295,6 +338,9 @@ -- ^ No authentication by default , queryManager :: !(Either HC.ManagerSettings HC.Manager) -- ^ HTTP connection manager+ , queryDecoder :: Decoder+ -- ^ Decoder settings to configure how to parse a JSON resposne given a row+ -- parser } -- | Smart constructor for 'QueryParams'@@ -305,12 +351,14 @@ -- ['precision'] 'RFC3339' -- ['authentication'] 'Nothing' -- ['manager'] @'Left' 'HC.defaultManagerSettings'@+-- ['decoder'] @'strictDecoder'@ queryParams :: Database -> QueryParams queryParams queryDatabase = QueryParams { queryServer = defaultServer , queryPrecision = RFC3339 , queryAuthentication = Nothing , queryManager = Left HC.defaultManagerSettings+ , queryDecoder = strictDecoder , .. } @@ -328,9 +376,13 @@ let body = BL.fromChunks chunks case eitherDecode' body of Left message -> throwIO $ UnexpectedResponse message request body- Right val -> case A.parse (parseResults (queryPrecision params)) val of- A.Success vec -> return vec- A.Error message -> errorQuery message request response val+ Right val -> do+ let parser = parseQueryResultsWith+ (queryDecoder params)+ (queryPrecision params)+ case A.parse parser val of+ A.Success vec -> return vec+ A.Error message -> errorQuery message request response val setPrecision :: Precision 'QueryRequest@@ -506,3 +558,11 @@ -- "john" instance HasCredentials QueryParams where authentication = _authentication++-- | Decoder settings+--+-- >>> let p = queryParams "foo"+-- >>> let _ = p & decoder .~ strictDecoder+-- >>> let _ = p & decoder .~ lenientDecoder+decoder :: Lens' QueryParams Decoder+decoder = _decoder
tests/regressions.hs view
@@ -1,34 +1,79 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}-import Data.Time.Clock (UTCTime)+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+import Control.Exception (bracket_, try)++import Control.Lens+import Data.Time import Test.Tasty import Test.Tasty.HUnit-import Text.RawString.QQ (r) import qualified Data.Map as M+import qualified Data.Map.Strict as Map+import qualified Data.Vector as V+import qualified Text.RawString.QQ as Raw (r) import Database.InfluxDB import Database.InfluxDB.Line import qualified Database.InfluxDB.Format as F main :: IO ()-main = defaultMain tests--tests :: TestTree-tests = testGroup "regression tests"- [ issue75+main = defaultMain $ testGroup "regression tests"+ [ testCase "issue #64" case_issue64+ , testCase "issue #66" case_issue66+ , testCaseSteps "issue #75" case_issue75 ] --- https://github.com/maoe/influxdb-haskell/issues/75+-- https://github.com/maoe/influxdb-haskell/issues/64+case_issue64 :: Assertion+case_issue64 = withDatabase dbName $ do+ write wp $ Line "count" Map.empty+ (Map.fromList [("value", FieldInt 1)])+ (Nothing :: Maybe UTCTime)+ r <- try $ query qp "SELECT value FROM count"+ case r of+ Left err -> case err of+ UnexpectedResponse message _ _ ->+ message @?=+ "BUG: parsing Int failed, expected Number, but encountered String in Database.InfluxDB.Query.query"+ _ ->+ assertFailure $ got ++ show err+ Right (v :: (V.Vector (Tagged "time" Int, Tagged "value" Int))) ->+ -- NOTE: The time columns should be UTCTime, Text, or String+ assertFailure $ got ++ "no errors: " ++ show v+ where+ dbName = "case_issue64"+ qp = queryParams dbName & precision .~ RFC3339+ wp = writeParams dbName+ got = "expeted an UnexpectedResponse but got " -issue75 :: TestTree-issue75 = testCaseSteps "issue #75" $ \step -> do+-- https://github.com/maoe/influxdb-haskell/issues/66+case_issue66 :: Assertion+case_issue66 = do+ r <- try $ query (queryParams "_internal") "SELECT time FROM dummy"+ case r of+ Left err -> case err of+ UnexpectedResponse message _ _ ->+ message @?=+ "BUG: at least 1 non-time field must be queried in Database.InfluxDB.Query.query"+ _ ->+ assertFailure $ got ++ show err+ Right (v :: V.Vector (Tagged "time" Int)) ->+ assertFailure $ got ++ "no errors: " ++ show v+ where+ got = "expected an UnexpectedResponse but got "++-- https://github.com/maoe/influxdb-haskell/issues/75+case_issue75 :: (String -> IO ()) -> Assertion+case_issue75 step = do step "Checking encoded value"- let string = [r|bl\"a|]+ let string = [Raw.r|bl\"a|] let encoded = encodeLine (scaleTo Nanosecond) $ Line "testing" mempty (M.singleton "test" $ FieldString string) (Nothing :: Maybe UTCTime)- encoded @?= [r|testing test="bl\\\"a"|]+ encoded @?= [Raw.r|testing test="bl\\\"a"|] step "Preparing a test database" let db = "issue75"@@ -39,3 +84,11 @@ step "Checking server response" let wp = writeParams db writeByteString wp encoded++withDatabase :: Database -> IO a -> IO a+withDatabase dbName f = bracket_+ (manage q (formatQuery ("CREATE DATABASE "%F.database) dbName))+ (manage q (formatQuery ("DROP DATABASE "%F.database) dbName))+ f+ where+ q = queryParams dbName