From 1105cf06f0ac87acf30bf5adcc2da8f63795bec8 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Wed, 17 Jun 2020 23:39:47 +0900
Subject: [PATCH 01/14] Check in hie.yaml

---
 hie.yaml | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)
 create mode 100644 hie.yaml

diff --git a/hie.yaml b/hie.yaml
new file mode 100644
index 0000000..9af529c
--- /dev/null
+++ b/hie.yaml
@@ -0,0 +1,16 @@
+cradle:
+  cabal:
+    - path: "./src"
+      component: "lib:influxdb"
+
+    - path: "./tests"
+      component: "influxdb:test:doctests"
+
+    - path: "./tests"
+      component: "influxdb:test:regressions"
+
+    - path: "./examples/random-points.hs"
+      component: "influxdb:exe:influx-random-points"
+
+    - path: "./examples/write-udp.hs"
+      component: "influxdb:exe:influx-write-udp"

From 9308dbba0e261e8c14990ea5624312a19761826c Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <maoe@foldr.in>
Date: Sun, 20 May 2018 00:29:00 +0900
Subject: [PATCH 02/14] Add test cases for #64 and #66

---
 influxdb.cabal       |  2 ++
 tests/regressions.hs | 77 +++++++++++++++++++++++++++++++++++++-------
 2 files changed, 67 insertions(+), 12 deletions(-)

diff --git a/influxdb.cabal b/influxdb.cabal
index 965150f..7b66db7 100644
--- a/influxdb.cabal
+++ b/influxdb.cabal
@@ -115,10 +115,12 @@ test-suite regressions
       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
diff --git a/tests/regressions.hs b/tests/regressions.hs
index 542a470..11fafe5 100644
--- a/tests/regressions.hs
+++ b/tests/regressions.hs
@@ -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 @@ issue75 = testCaseSteps "issue #75" $ \step -> do
   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

From 8cdc95c1bc6b792041602b6c68f73c5996f3d218 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <maoe@foldr.in>
Date: Sun, 20 May 2018 00:32:14 +0900
Subject: [PATCH 03/14] Handle error objects properly

* Handle top-level error objects
* Do not ignore error objects in the results object (fixes #66)
---
 src/Database/InfluxDB/JSON.hs | 29 +++++++++++++++++++++--------
 1 file changed, 21 insertions(+), 8 deletions(-)

diff --git a/src/Database/InfluxDB/JSON.hs b/src/Database/InfluxDB/JSON.hs
index 7cabb9d..2d527c0 100644
--- a/src/Database/InfluxDB/JSON.hs
+++ b/src/Database/InfluxDB/JSON.hs
@@ -34,8 +34,10 @@ module Database.InfluxDB.JSON
 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)
@@ -82,13 +84,26 @@ parseResultsWithDecoder
   -- to construct a value.
   -> Value
   -> A.Parser (Vector a)
-parseResultsWithDecoder Decoder {..} row val0 = success
+parseResultsWithDecoder Decoder {..} 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
@@ -166,10 +181,8 @@ parseSeriesBody = A.withObject "series" $ \obj -> do
   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

From daaf1496244545a4c46d91fa4b014f70ec9ba20c Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <maoe@foldr.in>
Date: Sun, 20 May 2018 00:39:43 +0900
Subject: [PATCH 04/14] Switch the default decoder to strictDecoder (fixes #64)

---
 src/Database/InfluxDB/JSON.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Database/InfluxDB/JSON.hs b/src/Database/InfluxDB/JSON.hs
index 2d527c0..1d7e95d 100644
--- a/src/Database/InfluxDB/JSON.hs
+++ b/src/Database/InfluxDB/JSON.hs
@@ -54,7 +54,7 @@ import qualified Data.Vector as V
 
 import Database.InfluxDB.Types
 
--- | Parse a JSON response with the 'lenientDecoder'. This can be useful to
+-- | Parse a JSON response with the 'strictDecoder'. This can be useful to
 -- implement the 'Database.InfluxDB.Query.parseResults' method.
 parseResultsWith
   :: (Maybe Text -> HashMap Text Text -> Vector Text -> Array -> A.Parser a)
@@ -68,7 +68,7 @@ parseResultsWith
   -- to construct a value.
   -> Value
   -> A.Parser (Vector a)
-parseResultsWith = parseResultsWithDecoder lenientDecoder
+parseResultsWith = parseResultsWithDecoder strictDecoder
 
 -- | Parse a JSON response with the specified decoder settings.
 parseResultsWithDecoder

From 211a64122b068cfac78350aaada4d2c7fd07e07c Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Wed, 17 Jun 2020 23:39:10 +0900
Subject: [PATCH 05/14] Fix broken ShowQuery

---
 src/Database/InfluxDB/Manage.hs | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

diff --git a/src/Database/InfluxDB/Manage.hs b/src/Database/InfluxDB/Manage.hs
index 9861af7..008e94e 100644
--- a/src/Database/InfluxDB/Manage.hs
+++ b/src/Database/InfluxDB/Manage.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -33,7 +35,6 @@ module Database.InfluxDB.Manage
   , ShowSeries
   , key
   ) where
-import Control.Applicative
 import Control.Exception
 import Control.Monad
 
@@ -117,26 +118,23 @@ instance QueryResults ShowQuery where
   parseResults _ = parseResultsWith $ \_ _ 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'

From fd13520ba0292759e23c5f8d6b86003d8a2e2e6e Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Thu, 18 Jun 2020 15:56:03 +0900
Subject: [PATCH 06/14] Refactor QueryResults and Decoder

QueryResults has now parseMeasurement as the only method.
parseResults is a normal function and is deprecated now.

QueryParams now stores a Decoder so that the user can configure
a Decoder at runtime rather than hardcoding into QueryResults
instances. Due to the lack of impredicative types in GHC
Decoder needs to be monomorphic to be usable with lens.
---
 examples/random-points.hs       |  2 +-
 src/Database/InfluxDB.hs        |  3 +-
 src/Database/InfluxDB/JSON.hs   | 67 +++++++++++++++--------
 src/Database/InfluxDB/Manage.hs | 31 +++++------
 src/Database/InfluxDB/Query.hs  | 94 +++++++++++++++++++++++++++------
 5 files changed, 140 insertions(+), 57 deletions(-)

diff --git a/examples/random-points.hs b/examples/random-points.hs
index f2287aa..674f231 100644
--- a/examples/random-points.hs
+++ b/examples/random-points.hs
@@ -76,7 +76,7 @@ data Row = Row
   } 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
diff --git a/src/Database/InfluxDB.hs b/src/Database/InfluxDB.hs
index 0cfbf47..e1e3e60 100644
--- a/src/Database/InfluxDB.hs
+++ b/src/Database/InfluxDB.hs
@@ -45,6 +45,7 @@ module Database.InfluxDB
   , QueryParams
   , queryParams
   , authentication
+  , decoder
 
   -- ** Parsing results
   , QueryResults(..)
@@ -200,7 +201,7 @@ data CPUUsage = CPUUsage
   , 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
diff --git a/src/Database/InfluxDB/JSON.hs b/src/Database/InfluxDB/JSON.hs
index 1d7e95d..4a50d27 100644
--- a/src/Database/InfluxDB/JSON.hs
+++ b/src/Database/InfluxDB/JSON.hs
@@ -3,7 +3,9 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 module Database.InfluxDB.JSON
   ( -- * Result parsers
@@ -12,6 +14,7 @@ module Database.InfluxDB.JSON
 
   -- ** Decoder settings
   , Decoder(..)
+  , SomeDecoder(..)
   , strictDecoder
   , lenientDecoder
 
@@ -54,37 +57,32 @@ import qualified Data.Vector as V
 
 import Database.InfluxDB.Types
 
--- | Parse a JSON response with the 'strictDecoder'. 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 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 = do
+parseResultsWithDecoder (Decoder SomeDecoder {..}) row val0 = do
   r <- foldr1 (<|>)
     [ Left <$> parseErrorObject val0
     , Right <$> success
@@ -111,25 +109,48 @@ parseResultsWithDecoder Decoder {..} row val0 = do
           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
diff --git a/src/Database/InfluxDB/Manage.hs b/src/Database/InfluxDB/Manage.hs
index 008e94e..13ce2ea 100644
--- a/src/Database/InfluxDB/Manage.hs
+++ b/src/Database/InfluxDB/Manage.hs
@@ -75,19 +75,20 @@ manage params q = do
   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 =
@@ -115,7 +116,7 @@ data ShowQuery = ShowQuery
   }
 
 instance QueryResults ShowQuery where
-  parseResults _ = parseResultsWith $ \_ _ columns fields ->
+  parseMeasurement _ _ _ columns fields =
     maybe (fail "parseResults: parse error") return $ do
       Number (toBoundedInteger -> Just showQueryQid) <-
         getField "qid" columns fields
@@ -145,7 +146,7 @@ newtype ShowSeries = ShowSeries
   }
 
 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
 
diff --git a/src/Database/InfluxDB/Query.hs b/src/Database/InfluxDB/Query.hs
index 38d4dee..95832ff 100644
--- a/src/Database/InfluxDB/Query.hs
+++ b/src/Database/InfluxDB/Query.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -24,10 +25,13 @@ module Database.InfluxDB.Query
   , database
   , precision
   , manager
+  , authentication
+  , decoder
 
   -- * Parsing results
   , QueryResults(..)
-  , parseResultsWith
+  , parseQueryResults
+  , parseQueryResultsWith
 
   -- * Low-level functions
   , withQueryResponse
@@ -45,8 +49,10 @@ import GHC.TypeLits
 
 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.Builder as BB
 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 @@ import qualified Database.InfluxDB.Format as F
 -- >>> :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 @@ import qualified Database.InfluxDB.Format as F
 --   , 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 @@ class QueryResults a where
     :: 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 @@ fieldName = T.pack . symbolVal
 -- >>> 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 @@ instance
   ( 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 @@ instance
   , 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 @@ instance
   , 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 @@ instance
     ( 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 @@ instance
     ( 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 @@ instance
     ( 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 @@ instance
     ( 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 @@ instance
 -- * 'server'
 -- * 'database'
 -- * 'precision'
--- * 'authentication'
 -- * 'manager'
+-- * 'authentication'
+-- * 'decoder'
 data QueryParams = QueryParams
   { queryServer :: !Server
   , queryDatabase :: !Database
@@ -295,6 +338,9 @@ data QueryParams = QueryParams
   -- ^ 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 @@ data QueryParams = QueryParams
 --   ['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 @@ query params q = withQueryResponse params Nothing q go
       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 @@ instance HasManager QueryParams where
 -- "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

From d76f122e4dda7ab390c2dc18036cacd7279be078 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Thu, 18 Jun 2020 15:59:59 +0900
Subject: [PATCH 07/14] random-points: Remove unused TemplateHaskell extension

---
 examples/random-points.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/examples/random-points.hs b/examples/random-points.hs
index 674f231..7d0c381 100644
--- a/examples/random-points.hs
+++ b/examples/random-points.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 import Data.Foldable

From 3e3dcb4c164ca37db913c3a817fd26a6e6a39991 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Thu, 18 Jun 2020 16:00:15 +0900
Subject: [PATCH 08/14] Delete the deprecated parseQueryField

---
 src/Database/InfluxDB.hs      |  1 -
 src/Database/InfluxDB/JSON.hs | 18 ------------------
 2 files changed, 19 deletions(-)

diff --git a/src/Database/InfluxDB.hs b/src/Database/InfluxDB.hs
index e1e3e60..946ff3d 100644
--- a/src/Database/InfluxDB.hs
+++ b/src/Database/InfluxDB.hs
@@ -59,7 +59,6 @@ module Database.InfluxDB
   , parseJSON
   , parseUTCTime
   , parsePOSIXTime
-  , parseQueryField
 
   -- *** Re-exports from tagged
   , Tagged(..)
diff --git a/src/Database/InfluxDB/JSON.hs b/src/Database/InfluxDB/JSON.hs
index 4a50d27..7127ef3 100644
--- a/src/Database/InfluxDB/JSON.hs
+++ b/src/Database/InfluxDB/JSON.hs
@@ -27,7 +27,6 @@ module Database.InfluxDB.JSON
   , parseUTCTime
   , parsePOSIXTime
   , parseRFC3339
-  , parseQueryField
   -- ** Utility functions
   , parseResultsObject
   , parseSeriesObject
@@ -241,20 +240,3 @@ parseRFC3339 val = A.withText err
     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."
-  #-}

From 0cd843168c39573ca19a417a446b0b80580f7007 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Thu, 18 Jun 2020 16:08:33 +0900
Subject: [PATCH 09/14] Don't expose parseResultsWith and
 parseResultsWithDecoder from the toplevel module

They were used to define parseResults but the method is now gone.
---
 src/Database/InfluxDB.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/src/Database/InfluxDB.hs b/src/Database/InfluxDB.hs
index 946ff3d..3e25f17 100644
--- a/src/Database/InfluxDB.hs
+++ b/src/Database/InfluxDB.hs
@@ -49,8 +49,6 @@ module Database.InfluxDB
 
   -- ** Parsing results
   , QueryResults(..)
-  , parseResultsWith
-  , parseResultsWithDecoder
   , Decoder(..)
   , lenientDecoder
   , strictDecoder

From 1cb4f867489f7241572daafb291e3633ca01e86a Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Thu, 18 Jun 2020 23:47:38 +0900
Subject: [PATCH 10/14] Hide the constructor of Decoder in Database.InfluxDB

---
 src/Database/InfluxDB.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Database/InfluxDB.hs b/src/Database/InfluxDB.hs
index 3e25f17..538b40d 100644
--- a/src/Database/InfluxDB.hs
+++ b/src/Database/InfluxDB.hs
@@ -49,7 +49,7 @@ module Database.InfluxDB
 
   -- ** Parsing results
   , QueryResults(..)
-  , Decoder(..)
+  , Decoder
   , lenientDecoder
   , strictDecoder
   , getField

From e156b6530e446b7e0ca2789d317e1f7eae7adf04 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Fri, 19 Jun 2020 09:09:44 +0900
Subject: [PATCH 11/14] travis: Test with InfluxDB 1.8.0

---
 .travis.yml            | 6 +++---
 .travis/influxdb.patch | 2 +-
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/.travis.yml b/.travis.yml
index 543fbfc..b219b1c 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -8,7 +8,7 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.10.1
+# version: 0.10.2
 #
 version: ~> 1.0
 language: c
@@ -16,7 +16,7 @@ os: linux
 dist: xenial
 env:
   global:
-    - INFLUXDB_VERSION=1.7.10
+    - INFLUXDB_VERSION=1.8.0
 git:
   # whether to recursively clone submodules
   submodules: false
@@ -171,5 +171,5 @@ script:
   - rm -f cabal.project.local
   - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
 
-# REGENDATA ("0.10.1",["influxdb.cabal","--ghc-head","--travis-patches=.travis/influxdb.patch"])
+# REGENDATA ("0.10.2",["influxdb.cabal","--ghc-head","--travis-patches=.travis/influxdb.patch"])
 # EOF
diff --git a/.travis/influxdb.patch b/.travis/influxdb.patch
index 086107e..9d488b7 100644
--- a/.travis/influxdb.patch
+++ b/.travis/influxdb.patch
@@ -8,7 +8,7 @@ index c9bac24..2fcb7ab 100644
  dist: xenial
 +env:
 +  global:
-+    - INFLUXDB_VERSION=1.7.10
++    - INFLUXDB_VERSION=1.8.0
  git:
    # whether to recursively clone submodules
    submodules: false

From ceea27a6b28be39dd8f8b8846b5075cfd491a9a1 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Fri, 19 Jun 2020 09:32:34 +0900
Subject: [PATCH 12/14] Remove unused language extension

---
 src/Database/InfluxDB/JSON.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Database/InfluxDB/JSON.hs b/src/Database/InfluxDB/JSON.hs
index 7127ef3..23848c9 100644
--- a/src/Database/InfluxDB/JSON.hs
+++ b/src/Database/InfluxDB/JSON.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 module Database.InfluxDB.JSON
   ( -- * Result parsers

From 1dd0723fbbc0028483d74e35a75cdcf803b86ad4 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Fri, 19 Jun 2020 09:34:49 +0900
Subject: [PATCH 13/14] Update README

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 210815b..f49ddf8 100644
--- a/README.md
+++ b/README.md
@@ -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
 

From bda504f6d103d26bba2779b8afc8d687822807d9 Mon Sep 17 00:00:00 2001
From: Mitsutoshi Aoe <me@maoe.name>
Date: Sat, 20 Jun 2020 00:02:14 +0900
Subject: [PATCH 14/14] Prepare v1.8.0

---
 CHANGELOG.md   | 15 +++++++++++++++
 influxdb.cabal |  2 +-
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 5d68ca0..5a19836 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
diff --git a/influxdb.cabal b/influxdb.cabal
index 7b66db7..764cdf8 100644
--- a/influxdb.cabal
+++ b/influxdb.cabal
@@ -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.