packages feed

influxdb 0.1.0.1 → 0.2.0

raw patch · 11 files changed

+415/−89 lines, 11 filesdep +HUnitdep +tasty-quickcheckdep +template-haskell

Dependencies added: HUnit, tasty-quickcheck, template-haskell

Files

examples/random-points.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE ViewPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE TemplateHaskell #-} import Control.Applicative import Control.Exception as E import Control.Monad@@ -13,13 +13,14 @@ import System.Environment import System.IO import qualified Data.Text as T-import qualified Data.Vector as V  import System.Random.MWC (Variate(..)) import qualified Network.HTTP.Client as HC import qualified System.Random.MWC as MWC  import Database.InfluxDB+import Database.InfluxDB.TH+import qualified Database.InfluxDB.Stream as S  oneWeekInSeconds :: Int oneWeekInSeconds = 7*24*60*60@@ -45,7 +46,7 @@             <$> getPOSIXTime             <*> (fromIntegral <$> uniformR (0, oneWeekInSeconds) gen)           !value <- liftIO $ uniform gen-          writePoints $ Point value timestamp+          writePoints $ Point value (Time timestamp)           innerLoop $ n - 1       outerLoop $ m - 1 @@ -56,16 +57,13 @@         print $ seriesColumns series         print $ seriesPoints series     -- Streaming output-    queryChunked config db "select * from ct1;" $ \stream0 ->-      flip fix stream0 $ \loop stream -> case stream of-        Done -> return ()-        Yield series next -> do-          case fromSeriesData series of-            Left reason -> hPutStrLn stderr reason-            Right points -> mapM_ print (points :: [Point])-          putStrLn "--"-          stream' <- next-          loop stream'+    queryChunked config db "select * from ct1;" $ S.fold step ()+  where+    step _ series = do+      case fromSeriesData series of+        Left reason -> hPutStrLn stderr reason+        Right points -> mapM_ print (points :: [Point])+      putStrLn "--"  newConfig :: HC.Manager -> IO Config newConfig manager = do@@ -81,22 +79,24 @@   { HC.managerResponseTimeout = Just $ 60*(10 :: Int)^(6 :: Int)   } -data Point = Point !Name !POSIXTime deriving Show+data Point = Point+  { pointValue :: !Name+  , pointTime :: !Time+  } deriving Show -instance ToSeriesData Point where-  toSeriesColumns _ = V.fromList ["value", "time"]-  toSeriesPoints (Point value time) = V.fromList-    [ toValue value-    , epochInSeconds time-    ]+newtype Time = Time POSIXTime+  deriving Show -instance FromSeriesData Point where-  parseSeriesData = withValues $ \values -> Point-    <$> values .: "value"-    <*> values .: "time"+instance ToValue Time where+  toValue (Time epoch) = toValue $ epochInSeconds epoch+    where+      epochInSeconds :: POSIXTime -> Value+      epochInSeconds = Int . floor -epochInSeconds :: POSIXTime -> Value-epochInSeconds = Int . floor+instance FromValue Time where+  parseValue (Int n) = return $ Time $ fromIntegral n+  parseValue (Float d) = return $ Time $ realToFrac d+  parseValue v = typeMismatch "Int or Float" v  data Name   = Foo@@ -129,7 +129,8 @@     name <- uniformR (fromEnum lower, fromEnum upper) g     return $! toEnum name -instance FromValue POSIXTime where-  parseValue (Int n) = return $ fromIntegral n-  parseValue (Float d) = return $ realToFrac d-  parseValue v = typeMismatch "Int or Float" v+-- Instance deriving++deriveSeriesData defaultOptions+  { fieldLabelModifier = stripPrefixLower "point" }+  ''Point
influxdb.cabal view
@@ -1,5 +1,5 @@ name: influxdb-version: 0.1.0.1+version: 0.2.0 synopsis: Haskell client library for InfluxDB description: Haskell client library for InfluxDB homepage: https://github.com/maoe/influxdb-haskell@@ -28,6 +28,7 @@     -- Database.InfluxDB.Query     Database.InfluxDB.Stream     Database.InfluxDB.Types+    Database.InfluxDB.TH   other-modules:     Database.InfluxDB.Types.Internal   ghc-options: -Wall@@ -46,6 +47,7 @@     , retry     , scientific     , tagged+    , template-haskell     , text     , time     , vector@@ -58,10 +60,12 @@   build-depends:       base     , http-client+    , HUnit     , influxdb     , mtl     , tasty     , tasty-hunit+    , tasty-quickcheck     , tasty-th     , text     , vector@@ -85,7 +89,6 @@     , mwc-random     , text     , time-    , vector   default-language: Haskell2010  source-repository head@@ -95,5 +98,5 @@  source-repository this   type: git-  tag: v0.1.0.1+  tag: v0.2.0   location: https://github.com/maoe/influxdb-haskell.git
src/Database/InfluxDB.hs view
@@ -14,7 +14,7 @@   , FromSeriesData(..), fromSeriesData   , FromValue(..), fromValue -  , withValues, (.:)+  , withValues, (.:), (.:?), (.!=)   , typeMismatch    -- * HTTP API
src/Database/InfluxDB/Decode.hs view
@@ -1,24 +1,30 @@+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeSynonymInstances #-} module Database.InfluxDB.Decode   ( FromSeries(..), fromSeries   , FromSeriesData(..), fromSeriesData-  , withValues, (.:)+  , withValues, (.:), (.:?), (.!=)   , FromValue(..), fromValue   , Parser, ValueParser, typeMismatch   ) where import Control.Applicative import Control.Monad.Reader+import Data.Int+import Data.Word import Data.Map (Map)+import Data.Maybe (fromMaybe) import Data.Vector (Vector) import Data.Tuple (swap) import qualified Data.Map as Map import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.Vector as V  import Database.InfluxDB.Types --- | A type that can be converted from a @Series@.+-- | A type that can be converted from a 'Series'. class FromSeries a where   parseSeries :: Series -> Parser a @@ -28,11 +34,11 @@ instance FromSeries SeriesData where   parseSeries = return . seriesData --- | Converte a value from a @Series@, failing if the types do not match.+-- | Converte a value from a 'Series', failing if the types do not match. fromSeries :: FromSeries a => Series -> Either String a fromSeries = runParser . parseSeries --- | A type that can be converted from a @SeriesData@. A typical implementation+-- | A type that can be converted from a 'SeriesData'. A typical implementation -- is as follows. -- -- > import Control.Applicative ((<$>), (<*>))@@ -56,12 +62,13 @@     , seriesDataPoints = [values]     } --- | Converte a value from a @SeriesData@, failing if the types do not match.+-- | Converte a value from a 'SeriesData', failing if the types do not match. fromSeriesData :: FromSeriesData a => SeriesData -> Either String [a] fromSeriesData SeriesData {..} = mapM   (runParser . parseSeriesData seriesDataColumns)   seriesDataPoints +-- | Helper function to define 'parseSeriesData' from 'ValueParser's. withValues   :: (Vector Value -> ValueParser a)   -> Vector Column -> Vector Value -> Parser a@@ -70,6 +77,9 @@   where     ValueParser m = f values +-- | Retrieve the value associated with the given column. The result is 'empty'+-- if the column is not present or the value cannot be converted to the desired+-- type. (.:) :: FromValue a => Vector Value -> Column -> ValueParser a values .: column = do   found <- asks $ Map.lookup column@@ -79,11 +89,29 @@       value <- V.indexM values idx       liftParser $ parseValue value --- | A type that can be converted from a @Value@.+-- | Retrieve the value associated with the given column. The result is+-- 'Nothing' if the column is not present or the value cannot be converted to+-- the desired type.+(.:?) :: FromValue a => Vector Value -> Column -> ValueParser (Maybe a)+values .:? column = do+  found <- asks $ Map.lookup column+  case found of+    Nothing -> return Nothing+    Just idx ->+      case values V.!? idx of+        Nothing -> return Nothing+        Just value -> liftParser $ parseValue value++-- | Helper for use in combination with '.:?' to provide default values for+-- optional columns.+(.!=) :: Parser (Maybe a) -> a -> Parser a+p .!= def = fromMaybe def <$> p++-- | A type that can be converted from a 'Value'. class FromValue a where   parseValue :: Value -> Parser a --- | Converte a value from a @Value@, failing if the types do not match.+-- | Converte a value from a 'Value', failing if the types do not match. fromValue :: FromValue a => Value -> Either String a fromValue = runParser . parseValue @@ -102,9 +130,63 @@   parseValue (Int n) = return $ fromIntegral n   parseValue v = typeMismatch "Int" v +instance FromValue Int8 where+  parseValue (Int n)+    | n <= fromIntegral (maxBound :: Int8) = return $ fromIntegral n+    | otherwise = fail $ "Larger than the maximum Int8: " ++ show n+  parseValue v = typeMismatch "Int8" v++instance FromValue Int16 where+  parseValue (Int n)+    | n <= fromIntegral (maxBound :: Int16) = return $ fromIntegral n+    | otherwise = fail $ "Larger than the maximum Int16: " ++ show n+  parseValue v = typeMismatch "Int16" v++instance FromValue Int32 where+  parseValue (Int n)+    | n <= fromIntegral (maxBound :: Int32) = return $ fromIntegral n+    | otherwise = fail $ "Larger than the maximum Int32: " ++ show n+  parseValue v = typeMismatch "Int32" v++instance FromValue Int64 where+  parseValue (Int n)+    | n <= fromIntegral (maxBound :: Int64) = return $ fromIntegral n+    | otherwise = fail $ "Larger than the maximum Int64: " ++ show n+  parseValue v = typeMismatch "Int64" v++instance FromValue Word8 where+  parseValue (Int n)+    | n <= fromIntegral (maxBound :: Word8) = return $ fromIntegral n+    | otherwise = fail $ "Larger than the maximum Word8: " ++ show n+  parseValue v = typeMismatch "Word8" v++instance FromValue Word16 where+  parseValue (Int n)+    | n <= fromIntegral (maxBound :: Word16) = return $ fromIntegral n+    | otherwise = fail $ "Larger than the maximum Word16: " ++ show n+  parseValue v = typeMismatch "Word16" v++instance FromValue Word32 where+  parseValue (Int n)+    | n <= fromIntegral (maxBound :: Word32) = return $ fromIntegral n+    | otherwise = fail $ "Larger than the maximum Word32: " ++ show n+  parseValue v = typeMismatch "Word32" v+ instance FromValue Double where   parseValue (Float d) = return d   parseValue v = typeMismatch "Float" v++instance FromValue T.Text where+  parseValue (String xs) = return xs+  parseValue v = typeMismatch "Text" v++instance FromValue TL.Text where+  parseValue (String xs) = return $ TL.fromStrict xs+  parseValue v = typeMismatch "lazy Text" v++instance FromValue String where+  parseValue (String xs) = return $ T.unpack xs+  parseValue v = typeMismatch "String" v  typeMismatch   :: String
src/Database/InfluxDB/Encode.hs view
@@ -15,11 +15,11 @@  import Database.InfluxDB.Types --- | A type that can be converted to a @Series@.+-- | A type that can be converted to a 'Series'. class ToSeries a where   toSeries :: a -> Series --- | A type that can be converted to a @SeriesData@. A typical implementation is+-- | A type that can be converted to a 'SeriesData'. A typical implementation is -- as follows. -- -- > import qualified Data.Vector as V@@ -48,6 +48,9 @@ class ToValue a where   toValue :: a -> Value +instance ToValue Value where+  toValue = id+ instance ToValue Bool where   toValue = Bool @@ -78,9 +81,6 @@  instance ToValue Word32 where   toValue = Int . fromIntegral--instance ToValue Float where-  toValue = Float . realToFrac  instance ToValue Double where   toValue = Float
src/Database/InfluxDB/Http.hs view
@@ -128,7 +128,7 @@   postGeneric config databaseName Nothing  -- | Post a bunch of writes for (possibly multiple) series into a database like--- @post@ but with time precision.+-- 'post' but with time precision. postWithPrecision   :: Config   -> Text -- ^ Database name@@ -305,7 +305,7 @@     decode (P.Fail _ _ message) = fail message     parseAsJson = P.parse A.json --- | Query a specified database like @query@ but in a streaming fashion.+-- | Query a specified database like 'query' but in a streaming fashion. queryChunked   :: FromSeries a   => Config
src/Database/InfluxDB/Stream.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} module Database.InfluxDB.Stream where import Prelude hiding (mapM) @@ -16,3 +17,25 @@   a' <- f a   b <- mb   return $ Yield a' (mapM f b)++-- | Monadic left fold for 'Stream'.+fold :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b+fold f = loop+  where+    loop z stream = case stream of+      Done -> return z+      Yield a nextStream -> do+        b <- f z a+        stream' <- nextStream+        loop b stream'++-- | Strict version of 'fold'.+fold' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> m b+fold' f = loop+  where+    loop z stream = case stream of+      Done -> return z+      Yield a nextStream -> do+        !b <- f z a+        stream' <- nextStream+        loop b stream'
+ src/Database/InfluxDB/TH.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++#if __GLASGOW_HASKELL__ == 704+{-# LANGUAGE ConstraintKinds #-}+#endif++module Database.InfluxDB.TH+  ( Options(..), defaultOptions+  , deriveSeriesData+  , deriveToSeriesData+  , deriveFromSeriesData++  , stripPrefixLower+  ) where+import Control.Applicative+import Language.Haskell.TH+import Language.Haskell.TH.Syntax (VarStrictType)++import qualified Data.Vector as V++import Database.InfluxDB.Decode+import Database.InfluxDB.Encode+import Database.InfluxDB.Types.Internal (stripPrefixLower)++data Options = Options+  { fieldLabelModifier :: String -> String+  }++defaultOptions :: Options+defaultOptions = Options+  { fieldLabelModifier = id+  }++deriveSeriesData :: Options -> Name -> Q [Dec]+deriveSeriesData opts name = (++)+  <$> deriveToSeriesData opts name+  <*> deriveFromSeriesData opts name++deriveToSeriesData :: Options -> Name -> Q [Dec]+deriveToSeriesData opts name = do+  info <- reify name+  case info of+    TyConI dec -> pure <$> deriveWith toSeriesDataBody opts dec+    _ -> fail $ "Expected a type constructor, but got " ++ show info++deriveFromSeriesData :: Options -> Name -> Q [Dec]+deriveFromSeriesData opts name = do+  info <- reify name+  case info of+    TyConI dec -> pure <$> deriveWith fromSeriesDataBody opts dec+    _ -> fail $ "Expected a type constructor, but got " ++ show info++deriveWith+  :: (Options -> Name -> [TyVarBndr] -> Con -> Q Dec)+  -> Options -> Dec -> Q Dec+deriveWith f opts dec = case dec of+  DataD _ tyName tyVars [con] _ -> f opts tyName tyVars con+  NewtypeD _ tyName tyVars con _ -> f opts tyName tyVars con+  _ -> fail $ "Expected a data or newtype declaration, but got " ++ show dec++toSeriesDataBody :: Options -> Name -> [TyVarBndr] -> Con -> Q Dec+toSeriesDataBody opts tyName tyVars con = do+  case con of+    RecC conName vars -> InstanceD+      <$> mapM tyVarToPred tyVars+      <*> [t| ToSeriesData $(conT tyName) |]+      <*> deriveDecs conName vars+    _ -> fail $ "Expected a record, but got " ++ show con+  where+    tyVarToPred tv = case tv of+      PlainTV name -> classP ''FromValue [varT name]+      KindedTV name _ -> classP ''FromValue [varT name]+    deriveDecs conName vars = do+      a <- newName "a"+      sequence+        [ funD 'toSeriesColumns+          [ clause [wildP]+            (normalB [| V.fromList $(listE columns) |]) []+          ]+        , funD 'toSeriesPoints+          [ clause [varP a]+            (normalB [| V.fromList $(listE $ map (applyToValue a) vars) |]) []+          ]+        ]+      where+        applyToValue a (name, _, _) = [| toValue ($(varE name) $(varE a)) |]+        columns = map (varStrictTypeToColumn opts) vars++fromSeriesDataBody :: Options -> Name -> [TyVarBndr] -> Con -> Q Dec+fromSeriesDataBody opts tyName tyVars con = do+  case con of+    RecC conName vars -> instanceD+      (mapM tyVarToPred tyVars)+      [t| FromSeriesData $(conT tyName) |]+      [deriveDec conName vars]+    _ -> fail $ "Expected a record, but got " ++ show con+  where+    tyVarToPred tv = case tv of+      PlainTV name -> classP ''FromValue [varT name]+      KindedTV name _ -> classP ''FromValue [varT name]+    deriveDec conName vars = funD 'parseSeriesData+      [ clause [] (normalB deriveBody) []+      ]+      where+        deriveBody = do+          values <- newName "values"+          appE (varE 'withValues) $ lamE [varP values] $+              foldl (go values) [| pure $(conE conName) |] columns+          where+            go :: Name -> Q Exp -> Q Exp -> Q Exp+            go values expQ col = [| $expQ <*> $(varE values) .: $col |]+            columns = map (varStrictTypeToColumn opts) vars++varStrictTypeToColumn :: Options -> VarStrictType -> Q Exp+varStrictTypeToColumn opts = column opts . f+  where+    f (var, _, _) = var++column :: Options -> Name -> Q Exp+column opts = litE . stringL . fieldLabelModifier opts . nameBase
src/Database/InfluxDB/Types.hs view
@@ -66,7 +66,7 @@ -----------------------------------------------------------  -- | A series consists of name, columns and points. The columns and points are--- expressed in a separate type @SeriesData@.+-- expressed in a separate type 'SeriesData'. data Series = Series   { seriesName :: {-# UNPACK #-} !Text   -- ^ Series name@@ -105,11 +105,11 @@       }   parseJSON _ = empty --- | @SeriesData@ consists of columns and points.+-- | 'SeriesData' consists of columns and points. data SeriesData = SeriesData   { seriesDataColumns :: Vector Column   , seriesDataPoints :: [Vector Value]-  }+  } deriving Show  type Column = Text
src/Database/InfluxDB/Types/Internal.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} module Database.InfluxDB.Types.Internal   ( stripPrefixOptions+  , stripPrefixLower   ) where import Data.Char (toLower) @@ -16,14 +17,14 @@ #if MIN_VERSION_aeson(0, 6, 2) stripPrefixOptions :: String -> Options stripPrefixOptions name = defaultOptions-  { fieldLabelModifier = stripPrefix name+  { fieldLabelModifier = stripPrefixLower name   } #else stripPrefixOptions :: String -> String -> String-stripPrefixOptions = stripPrefix+stripPrefixOptions = stripPrefixLower #endif -stripPrefix :: String -> String -> String-stripPrefix prefix xs = case drop (length prefix) xs of+stripPrefixLower :: String -> String -> String+stripPrefixLower prefix xs = case drop (length prefix) xs of   [] -> error "Insufficient length of field name"   c:cs -> toLower c : cs
tests/test-suite.hs view
@@ -5,32 +5,103 @@ import Control.Monad import Control.Monad.Trans import Data.Function+import Data.Int import Data.List (find) import Data.Monoid import Data.Text (Text) import Data.Unique+import Data.Word import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified Data.Vector as V +import Test.HUnit.Lang (HUnitFailure(..)) import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.TH+import Test.Tasty.QuickCheck import qualified Network.HTTP.Client as HC  import Database.InfluxDB+import qualified Database.InfluxDB.Stream as S -main :: IO ()-main = $defaultMainGenerator+prop_fromValue_toValue_identity_Value :: Value -> Bool+prop_fromValue_toValue_identity_Value = fromValueToValueIdentity +prop_fromValue_toValue_identity_Bool :: Bool -> Bool+prop_fromValue_toValue_identity_Bool = fromValueToValueIdentity++prop_fromValue_toValue_identity_Int :: Int -> Bool+prop_fromValue_toValue_identity_Int = fromValueToValueIdentity++prop_fromValue_toValue_identity_Int8 :: Int8 -> Bool+prop_fromValue_toValue_identity_Int8 = fromValueToValueIdentity++prop_fromValue_toValue_identity_Int16 :: Int16 -> Bool+prop_fromValue_toValue_identity_Int16 = fromValueToValueIdentity++prop_fromValue_toValue_identity_Int32 :: Int32 -> Bool+prop_fromValue_toValue_identity_Int32 = fromValueToValueIdentity++prop_fromValue_toValue_identity_Int64 :: Int64 -> Bool+prop_fromValue_toValue_identity_Int64 = fromValueToValueIdentity++prop_fromValue_toValue_identity_Word8 :: Word8 -> Bool+prop_fromValue_toValue_identity_Word8 = fromValueToValueIdentity++prop_fromValue_toValue_identity_Word16 :: Word16 -> Bool+prop_fromValue_toValue_identity_Word16 = fromValueToValueIdentity++prop_fromValue_toValue_identity_Word32 :: Word32 -> Bool+prop_fromValue_toValue_identity_Word32 = fromValueToValueIdentity++prop_fromValue_toValue_identity_Double :: Double -> Bool+prop_fromValue_toValue_identity_Double = fromValueToValueIdentity++prop_fromValue_toValue_identity_Text :: T.Text -> Bool+prop_fromValue_toValue_identity_Text = fromValueToValueIdentity++prop_fromValue_toValue_identity_LazyText :: TL.Text -> Bool+prop_fromValue_toValue_identity_LazyText = fromValueToValueIdentity++prop_fromValue_toValue_identity_String :: String -> Bool+prop_fromValue_toValue_identity_String = fromValueToValueIdentity++prop_fromValue_toValue_identity_Maybe_Int :: Maybe Int -> Bool+prop_fromValue_toValue_identity_Maybe_Int = fromValueToValueIdentity++-------------------------------------------------++instance Arbitrary Value where+  arbitrary = oneof+    [ Int <$> arbitrary+    , Float <$> arbitrary+    , String <$> arbitrary+    , Bool <$> arbitrary+    , pure Null+    ]++instance Arbitrary T.Text where+  arbitrary = T.pack <$> arbitrary++instance Arbitrary TL.Text where+  arbitrary = TL.pack <$> arbitrary++fromValueToValueIdentity :: (Eq a, FromValue a, ToValue a) => a -> Bool+fromValueToValueIdentity a = fromValue (toValue a) == Right a++-------------------------------------------------+ case_post :: Assertion case_post = runTest $ \config ->   withTestDatabase config $ \database -> do     name <- liftIO newName     post config database $       writeSeries name $ Val 42-    [series] <- query config database $-      "select value from " <> name-    fromSeriesData series @=? Right [Val 42]+    ss <- query config database $ "select value from " <> name+    case ss of+      [series] -> fromSeriesData series @=? Right [Val 42]+      _ -> assertFailure $ "Expect one series, but got: " ++ show ss  case_post_multi_series :: Assertion case_post_multi_series = runTest $ \config ->@@ -40,9 +111,10 @@       writeSeries name $ Val 42       writeSeries name $ Val 42       writeSeries name $ Val 42-    [series] <- query config database $-      "select value from " <> name-    fromSeriesData series @=? Right [Val 42, Val 42, Val 42]+    ss <- query config database $ "select value from " <> name+    case ss of+      [series] -> fromSeriesData series @=? Right [Val 42, Val 42, Val 42]+      _ -> assertFailure $ "Expect one series, but got: " ++ show ss  case_post_multi_points :: Assertion case_post_multi_points = runTest $ \config ->@@ -52,19 +124,37 @@       writePoints $ Val 42       writePoints $ Val 42       writePoints $ Val 42-    [series] <- query config database $-      "select value from " <> name-    fromSeriesData series @=? Right [Val 42, Val 42, Val 42]+    ss <- query config database $ "select value from " <> name+    case ss of+      [series] -> fromSeriesData series @=? Right [Val 42, Val 42, Val 42]+      _ -> assertFailure $ "Expect one series, but got: " ++ show ss +case_queryChunked :: Assertion+case_queryChunked = runTest $ \config ->+  withTestDatabase config $ \database -> do+    name <- liftIO newName+    post config database $ withSeries name $ do+      writePoints $ Val 42+      writePoints $ Val 42+      writePoints $ Val 42+    ss <- queryChunked config database ("select value from " <> name) $+      S.fold step []+    mapM fromSeriesData ss @=? Right [[Val 42], [Val 42], [Val 42]]+  where+    step xs series = case fromSeriesData series of+      Left reason -> throwIO $ HUnitFailure reason+      Right values -> return $ xs ++ values+ case_post_with_precision :: Assertion case_post_with_precision = runTest $ \config ->   withTestDatabase config $ \database -> do     name <- liftIO newName     postWithPrecision config database SecondsPrecision $       writeSeries name $ Val 42-    [series] <- query config database $-      "select value from " <> name-    fromSeriesData series @=? Right [Val 42]+    ss <- query config database $ "select value from " <> name+    case ss of+      [series] -> fromSeriesData series @=? Right [Val 42]+      _ -> assertFailure $ "Expect one series, but got: " ++ show ss  case_listDatabases :: Assertion case_listDatabases = runTest $ \config ->@@ -78,13 +168,13 @@   name <- newName   dropDatabaseIfExists config name   createDatabase config name-  databases <- listDatabases config-  assertBool ("No such database: " ++ T.unpack name) $-    any ((name ==) . databaseName) databases+  listDatabases config >>= \databases ->+    assertBool ("No such database: " ++ T.unpack name) $+      any ((name ==) . databaseName) databases   dropDatabase config name-  databases' <- listDatabases config-  assertBool ("Found a dropped database: " ++ T.unpack name) $-    all ((name /=) . databaseName) databases'+  listDatabases config >>= \databases ->+    assertBool ("Found a dropped database: " ++ T.unpack name) $+      all ((name /=) . databaseName) databases  case_list_cluster_admins :: Assertion case_list_cluster_admins = runTest $ \config -> do@@ -96,13 +186,13 @@ case_add_then_delete_cluster_admin = runTest $ \config -> do   name <- newName   admin <- addClusterAdmin config name "somePassword"-  admins <- listClusterAdmins config-  assertBool ("No such admin: " ++ T.unpack name) $-    any ((name ==) . adminUsername) admins+  listClusterAdmins config >>= \admins ->+    assertBool ("No such admin: " ++ T.unpack name) $+      any ((name ==) . adminUsername) admins   deleteClusterAdmin config admin-  admins' <- listClusterAdmins config-  assertBool ("Found a deleted admin: " ++ T.unpack name) $-    all ((name /=) . adminUsername) admins'+  listClusterAdmins config >>= \admins ->+    assertBool ("Found a deleted admin: " ++ T.unpack name) $+      all ((name /=) . adminUsername) admins  case_update_cluster_admin_password :: Assertion case_update_cluster_admin_password = runTest $ \config -> do@@ -117,13 +207,13 @@   name <- newName   dropDatabaseIfExists config name   createDatabase newConfig name-  databases <- listDatabases newConfig-  assertBool ("No such database: " ++ T.unpack name) $-    any ((name ==) . databaseName) databases+  listDatabases newConfig >>= \databases ->+    assertBool ("No such database: " ++ T.unpack name) $+      any ((name ==) . databaseName) databases   dropDatabase newConfig name-  databases' <- listDatabases newConfig-  assertBool ("Found a dropped database: " ++ T.unpack name) $-    all ((name /=) . databaseName) databases'+  listDatabases newConfig >>= \databases ->+    assertBool ("Found a dropped database: " ++ T.unpack name) $+      all ((name /=) . databaseName) databases  case_add_then_delete_database_users :: Assertion case_add_then_delete_database_users = runTest $ \config ->@@ -160,14 +250,14 @@       assertBool ("No such user: " <> T.unpack newUserName) $         any ((newUserName ==) . userName) users     grantAdminPrivilegeTo config name newUserName-    listDatabaseUsers config name >>= \users -> do+    listDatabaseUsers config name >>= \users ->       case find ((newUserName ==) . userName) users of         Nothing -> assertFailure $ "No such user: " <> T.unpack newUserName         Just user -> assertBool           ("User is not privileged: " <> T.unpack newUserName)           (userIsAdmin user)     revokeAdminPrivilegeFrom config name newUserName-    listDatabaseUsers config name >>= \users -> do+    listDatabaseUsers config name >>= \users ->       case find ((newUserName ==) . userName) users of         Nothing -> assertFailure $ "No such user: " <> T.unpack newUserName         Just user -> assertBool@@ -224,3 +314,8 @@  catchAll :: IO a -> (SomeException -> IO a) -> IO a catchAll = E.catch++-------------------------------------------------++main :: IO ()+main = $defaultMainGenerator