packages feed

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 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 @@ [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/influxdb/badge)](https://matrix.hackage.haskell.org/package/influxdb) [![Gitter](https://badges.gitter.im/maoe/influxdb-haskell.svg)](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