version 0.5.00.5.0

7 files changed, 234 insertions, 82 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
index de5727d..9bb4b05 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,12 @@
+## v0.5.0 - 2014-07-18
+
+* Add `InfluxException` type and use it when decoding JSON or SeriesData (#12)
+* New API
+    * `ping`
+    * `listInterfaces`
+    * `isInSync`
+* BUGFIX: Fix `when expecting a Float, encountered Int instead` error (#14)
+
 ## v0.4.2 - 2014-06-06
 
 * Export `newServerPoolWithRetrySettings` from `Database.InfluxDB`
diff --git a/influxdb.cabal b/influxdb.cabal
index b34e191..ba1d0a9 100644
--- a/influxdb.cabal
+++ b/influxdb.cabal
@@ -1,5 +1,5 @@
 name: influxdb
-version: 0.4.2
+version: 0.5.0
 synopsis: Haskell client library for InfluxDB
 description: Haskell client library for InfluxDB
 homepage: https://github.com/maoe/influxdb-haskell
@@ -141,5 +141,5 @@ source-repository head
 
 source-repository this
   type: git
-  tag: v0.4.2
+  tag: v0.5.0
   location: https://github.com/maoe/influxdb-haskell.git
diff --git a/src/Database/InfluxDB.hs b/src/Database/InfluxDB.hs
index 25e763f..8275914 100644
--- a/src/Database/InfluxDB.hs
+++ b/src/Database/InfluxDB.hs
@@ -27,6 +27,7 @@ module Database.InfluxDB
   , Database(..)
   , User(..)
   , Admin(..)
+  , Ping(..)
 
   -- ** Writing Data
 
@@ -71,6 +72,11 @@ module Database.InfluxDB
   , deleteDatabaseUser
   , grantAdminPrivilegeTo
   , revokeAdminPrivilegeFrom
+
+  -- *** Other API
+  , ping
+  , listInterfaces
+  , isInSync
   ) where
 
 import Database.InfluxDB.Decode
diff --git a/src/Database/InfluxDB/Decode.hs b/src/Database/InfluxDB/Decode.hs
index 13ac513..7a2ac59 100644
--- a/src/Database/InfluxDB/Decode.hs
+++ b/src/Database/InfluxDB/Decode.hs
@@ -174,6 +174,10 @@ instance FromValue Word32 where
 
 instance FromValue Double where
   parseValue (Float d) = return d
+  -- If the floating number happens to be a whole number, it must
+  -- have encoded as an integer. We should decode it back as a floating
+  -- number here.
+  parseValue (Int n) = return $ fromIntegral n
   parseValue v = typeMismatch "Float" v
 
 instance FromValue T.Text where
diff --git a/src/Database/InfluxDB/Http.hs b/src/Database/InfluxDB/Http.hs
index fea8581..600316c 100644
--- a/src/Database/InfluxDB/Http.hs
+++ b/src/Database/InfluxDB/Http.hs
@@ -53,6 +53,11 @@ module Database.InfluxDB.Http
   , deleteDatabaseUser
   , grantAdminPrivilegeTo
   , revokeAdminPrivilegeFrom
+
+  -- ** Other API
+  , ping
+  , listInterfaces
+  , isInSync
   ) where
 
 import Control.Applicative
@@ -76,7 +81,10 @@ import Data.Aeson ((.=))
 import Data.Default.Class (Default(def))
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Encode as AE
+import qualified Data.Aeson.Parser as AP
+import qualified Data.Aeson.Types as AT
 import qualified Data.Attoparsec.ByteString as P
+import qualified Data.Attoparsec.ByteString.Lazy as PL
 import qualified Network.HTTP.Client as HC
 
 import Database.InfluxDB.Decode
@@ -118,10 +126,10 @@ data TimePrecision
   | MillisecondsPrecision
   | MicrosecondsPrecision
 
-timePrecChar :: TimePrecision -> Char
-timePrecChar SecondsPrecision = 's'
-timePrecChar MillisecondsPrecision = 'm'
-timePrecChar MicrosecondsPrecision = 'u'
+timePrecString :: TimePrecision -> String
+timePrecString SecondsPrecision = "s"
+timePrecString MillisecondsPrecision = "ms"
+timePrecString MicrosecondsPrecision = "u"
 
 -----------------------------------------------------------
 -- Writing Data
@@ -169,7 +177,7 @@ postGeneric Config {..} databaseName timePrec write = do
           (T.unpack credsPassword)
           (maybe
             ""
-            (printf "&time_precision=%c" . timePrecChar)
+            (printf "&time_precision=%s" . timePrecString)
             timePrec :: String)
       }
     Credentials {..} = configCreds
@@ -238,10 +246,9 @@ deleteSeries
   -> Text -- ^ Database name
   -> Text -- ^ Series name
   -> IO ()
-deleteSeries Config {..} databaseName seriesName =
-  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager
+deleteSeries config databaseName seriesName = runRequest_ config request
   where
-    makeRequest = def
+    request = def
       { HC.method = "DELETE"
       , HC.path = escapeString $ printf "/db/%s/series/%s"
           (T.unpack databaseName)
@@ -250,7 +257,7 @@ deleteSeries Config {..} databaseName seriesName =
           (T.unpack credsUser)
           (T.unpack credsPassword)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 -- TODO: Delete API hasn't been implemented in InfluxDB yet
 --
@@ -289,13 +296,11 @@ query
   -> Text -- ^ Database name
   -> Text -- ^ Query text
   -> IO [a]
-query Config {..} databaseName q = do
-  response <- httpLbsWithRetry configServerPool request configHttpManager
-  case A.decode (HC.responseBody response) of
-    Nothing -> fail $ show response
-    Just xs -> case mapM fromSeries xs of
-      Left reason -> fail reason
-      Right ys -> return ys
+query config databaseName q = do
+  xs <- runRequest config request
+  case mapM fromSeries xs of
+    Left reason -> seriesDecodeError reason
+    Right ys -> return ys
   where
     request = def
       { HC.path = escapeString $ printf "/db/%s/series"
@@ -305,7 +310,7 @@ query Config {..} databaseName q = do
           (T.unpack credsPassword)
           (T.unpack q)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 -- | Construct streaming output
 responseStream :: A.FromJSON a => HC.BodyReader -> IO (Stream IO a)
@@ -319,9 +324,9 @@ responseStream body = demandPayload $ \payload ->
       A.Success a -> return $ Yield a $ if BS.null leftover
         then responseStream body
         else decode $ parseAsJson leftover
-      A.Error message -> fail message
+      A.Error message -> jsonDecodeError message
     decode (P.Partial k) = demandPayload (decode . k)
-    decode (P.Fail _ _ message) = fail message
+    decode (P.Fail _ _ message) = jsonDecodeError message
     parseAsJson = P.parse A.json
 
 -- | Query a specified database like 'query' but in a streaming fashion.
@@ -339,7 +344,7 @@ queryChunked Config {..} databaseName q f =
       responseStream . HC.responseBody >=> S.mapM parse >=> f
   where
     parse series = case fromSeries series of
-      Left reason -> fail reason
+      Left reason -> seriesDecodeError reason
       Right a -> return a
     request = def
       { HC.path = escapeString $ printf "/db/%s/series"
@@ -356,26 +361,21 @@ queryChunked Config {..} databaseName q f =
 
 -- | List existing databases.
 listDatabases :: Config -> IO [Database]
-listDatabases Config {..} = do
-  response <- httpLbsWithRetry configServerPool makeRequest configHttpManager
-  case A.decode (HC.responseBody response) of
-    Nothing -> fail $ show response
-    Just xs -> return xs
+listDatabases config = runRequest config request
   where
-    makeRequest = def
+    request = def
       { HC.path = "/db"
       , HC.queryString = escapeString $ printf "u=%s&p=%s"
           (T.unpack credsUser)
           (T.unpack credsPassword)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 -- | Create a new database. Requires cluster admin privileges.
 createDatabase :: Config -> Text -> IO ()
-createDatabase Config {..} name =
-  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager
+createDatabase config name = runRequest_ config request
   where
-    makeRequest = def
+    request = def
       { HC.method = "POST"
       , HC.requestBody = HC.RequestBodyLBS $ AE.encode $ A.object
           [ "name" .= name
@@ -385,17 +385,16 @@ createDatabase Config {..} name =
           (T.unpack credsUser)
           (T.unpack credsPassword)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 -- | Drop a database. Requires cluster admin privileges.
 dropDatabase
   :: Config
   -> Text -- ^ Database name
   -> IO ()
-dropDatabase Config {..} databaseName =
-  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager
+dropDatabase config databaseName = runRequest_ config request
   where
-    makeRequest = def
+    request = def
       { HC.method = "DELETE"
       , HC.path = escapeString $ printf "/db/%s"
           (T.unpack databaseName)
@@ -403,35 +402,30 @@ dropDatabase Config {..} databaseName =
           (T.unpack credsUser)
           (T.unpack credsPassword)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 -- | List cluster administrators.
 listClusterAdmins :: Config -> IO [Admin]
-listClusterAdmins Config {..} = do
-  response <- httpLbsWithRetry configServerPool makeRequest configHttpManager
-  case A.decode (HC.responseBody response) of
-    Nothing -> fail $ show response
-    Just xs -> return xs
+listClusterAdmins config = runRequest config request
   where
-    makeRequest = def
+    request = def
       { HC.path = "/cluster_admins"
       , HC.queryString = escapeString $ printf "u=%s&p=%s"
           (T.unpack credsUser)
           (T.unpack credsPassword)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 authenticateClusterAdmin :: Config -> IO ()
-authenticateClusterAdmin Config {..} =
-  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager
+authenticateClusterAdmin config = runRequest_ config request
   where
-    makeRequest = def
+    request = def
       { HC.path = "/cluster_admins/authenticate"
       , HC.queryString = escapeString $ printf "u=%s&p=%s"
           (T.unpack credsUser)
           (T.unpack credsPassword)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 -- | Add a new cluster administrator. Requires cluster admin privilege.
 addClusterAdmin
@@ -439,13 +433,13 @@ addClusterAdmin
   -> Text -- ^ Admin name
   -> Text -- ^ Password
   -> IO Admin
-addClusterAdmin Config {..} name password = do
-  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager
+addClusterAdmin config name password = do
+  runRequest_ config request
   return Admin
     { adminName = name
     }
   where
-    makeRequest = def
+    request = def
       { HC.method = "POST"
       , HC.requestBody = HC.RequestBodyLBS $ AE.encode $ A.object
           [ "name" .= name
@@ -456,7 +450,7 @@ addClusterAdmin Config {..} name password = do
           (T.unpack credsUser)
           (T.unpack credsPassword)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 -- | Update a cluster administrator's password. Requires cluster admin
 -- privilege.
@@ -506,11 +500,7 @@ listDatabaseUsers
   :: Config
   -> Text
   -> IO [User]
-listDatabaseUsers Config {..} database = do
-  response <- httpLbsWithRetry configServerPool makeRequest configHttpManager
-  case A.decode (HC.responseBody response) of
-    Nothing -> fail $ show response
-    Just xs -> return xs
+listDatabaseUsers config@Config {..} database = runRequest config makeRequest
   where
     makeRequest = def
       { HC.path = escapeString $ printf "/db/%s/users"
@@ -544,10 +534,9 @@ addDatabaseUser
   -> Text -- ^ User name
   -> Text -- ^ Password
   -> IO ()
-addDatabaseUser Config {..} databaseName name password =
-  void $ httpLbsWithRetry configServerPool makeRequest configHttpManager
+addDatabaseUser config databaseName name password = runRequest_ config request
   where
-    makeRequest = def
+    request = def
       { HC.method = "POST"
       , HC.requestBody = HC.RequestBodyLBS $ AE.encode $ A.object
           [ "name" .= name
@@ -559,7 +548,7 @@ addDatabaseUser Config {..} databaseName name password =
           (T.unpack credsUser)
           (T.unpack credsPassword)
       }
-    Credentials {..} = configCreds
+    Credentials {..} = configCreds config
 
 -- | Delete an user from the database users.
 deleteDatabaseUser
@@ -567,8 +556,7 @@ deleteDatabaseUser
   -> Text -- ^ Database name
   -> Text -- ^ User name
   -> IO ()
-deleteDatabaseUser config@Config {..} databaseName userName =
-  void $ httpLbsWithRetry configServerPool request configHttpManager
+deleteDatabaseUser config databaseName userName = runRequest_ config request
   where
     request = (makeRequestFromDatabaseUser config databaseName userName)
       { HC.method = "DELETE"
@@ -581,8 +569,8 @@ updateDatabaseUserPassword
   -> Text -- ^ User name
   -> Text -- ^ New password
   -> IO ()
-updateDatabaseUserPassword config@Config {..} databaseName userName password =
-  void $ httpLbsWithRetry configServerPool request configHttpManager
+updateDatabaseUserPassword config databaseName userName password =
+  runRequest_ config request
   where
     request = (makeRequestFromDatabaseUser config databaseName userName)
       { HC.method = "POST"
@@ -597,8 +585,7 @@ grantAdminPrivilegeTo
   -> Text -- ^ Database name
   -> Text -- ^ User name
   -> IO ()
-grantAdminPrivilegeTo config@Config {..} databaseName userName =
-  void $ httpLbsWithRetry configServerPool request configHttpManager
+grantAdminPrivilegeTo config databaseName userName = runRequest_ config request
   where
     request = (makeRequestFromDatabaseUser config databaseName userName)
       { HC.method = "POST"
@@ -613,8 +600,8 @@ revokeAdminPrivilegeFrom
   -> Text -- ^ Database name
   -> Text -- ^ User name
   -> IO ()
-revokeAdminPrivilegeFrom config@Config {..} databaseName userName =
-  void $ httpLbsWithRetry configServerPool request configHttpManager
+revokeAdminPrivilegeFrom config databaseName userName =
+  runRequest_ config request
   where
     request = (makeRequestFromDatabaseUser config databaseName userName)
       { HC.method = "POST"
@@ -639,6 +626,39 @@ makeRequestFromDatabaseUser Config {..} databaseName userName = def
   where
     Credentials {..} = configCreds
 
+ping :: Config -> IO Ping
+ping config = runRequest config request
+  where
+    request = def
+      { HC.path = "/ping"
+      }
+
+-- | Fetch current list of available interfaces
+listInterfaces :: Config -> IO [Text]
+listInterfaces config = runRequest config request
+  where
+    request = def
+      { HC.path = "/interfaces"
+      }
+
+isInSync :: Config -> IO Bool
+isInSync Config {..} = do
+  response <- httpLbsWithRetry configServerPool makeRequest configHttpManager
+  case eitherDecodeBool (HC.responseBody response) of
+    Left reason -> jsonDecodeError reason
+    Right status -> return status
+  where
+    makeRequest = def
+      { HC.path = "/sync"
+      , HC.queryString = escapeString $ printf "u=%s&p=%s"
+          (T.unpack credsUser)
+          (T.unpack credsPassword)
+      }
+    Credentials {..} = configCreds
+    eitherDecodeBool lbs = do
+      val <- PL.eitherResult $ PL.parse AP.value lbs
+      AT.parseEither A.parseJSON val
+
 -----------------------------------------------------------
 
 httpLbsWithRetry
@@ -679,3 +699,21 @@ escapeText = escapeString . T.unpack
 
 escapeString :: String -> BS.ByteString
 escapeString = BS8.pack . escapeURIString isAllowedInURI
+
+decodeJsonResponse
+  :: A.FromJSON a
+  => HC.Response BL.ByteString
+  -> IO a
+decodeJsonResponse response =
+  case A.eitherDecode (HC.responseBody response) of
+    Left reason -> jsonDecodeError reason
+    Right a -> return a
+
+runRequest :: A.FromJSON a => Config -> HC.Request -> IO a
+runRequest Config {..} req = do
+  response <- httpLbsWithRetry configServerPool req configHttpManager
+  decodeJsonResponse response
+
+runRequest_ :: Config -> HC.Request -> IO ()
+runRequest_ Config {..} req =
+  void $ httpLbsWithRetry configServerPool req configHttpManager
diff --git a/src/Database/InfluxDB/Types.hs b/src/Database/InfluxDB/Types.hs
index cac94cc..1a7b3a9 100644
--- a/src/Database/InfluxDB/Types.hs
+++ b/src/Database/InfluxDB/Types.hs
@@ -20,6 +20,8 @@ module Database.InfluxDB.Types
   , ScheduledDelete(..)
   , User(..)
   , Admin(..)
+  , Ping(..)
+  , Interface
 
   -- * Server pool
   , ServerPool
@@ -28,9 +30,15 @@ module Database.InfluxDB.Types
   , newServerPoolWithRetrySettings
   , activeServer
   , failover
+
+  -- * Exceptions
+  , InfluxException(..)
+  , jsonDecodeError
+  , seriesDecodeError
   ) where
 
 import Control.Applicative (empty)
+import Control.Exception (Exception, throwIO)
 import Data.Data (Data)
 import Data.IORef
 import Data.Int (Int64)
@@ -142,15 +150,28 @@ instance A.FromJSON Value where
     where
 #if MIN_VERSION_aeson(0, 7, 0)
       numberToValue
+        -- If the number is larger than Int64, it must be
+        -- a float64 (Double in Haskell).
+        | n > maxInt = Float $ toRealFloat n
         | e < 0 = Float $ realToFrac n
         | otherwise = Int $ fromIntegral $ coefficient n * 10 ^ e
         where
           e = base10Exponent n
+#if !MIN_VERSION_scientific(0, 3, 0)
+          toRealFloat = realToFrac
+-- scientific
+#endif
 #else
       numberToValue = case n of
-        I i -> Int $ fromIntegral i
+        I i
+          -- If the number is larger than Int64, it must be
+          -- a float64 (Double in Haskell).
+          | i > maxInt -> Float $ fromIntegral i
+          | otherwise -> Int $ fromIntegral i
         D d -> Float d
+-- aeson
 #endif
+      maxInt = fromIntegral (maxBound :: Int64)
 
 -----------------------------------------------------------
 
@@ -198,6 +219,11 @@ newtype Admin = Admin
   { adminName :: Text
   } deriving Show
 
+newtype Ping = Ping
+  { pingStatus :: Text
+  } deriving Show
+
+type Interface = Text
 
 -----------------------------------------------------------
 -- Server pool manipulation
@@ -243,8 +269,25 @@ failover ref = atomicModifyIORef' ref $ \pool@ServerPool {..} ->
           }
 
 -----------------------------------------------------------
+-- Exceptions
+
+data InfluxException
+  = JsonDecodeError String
+  | SeriesDecodeError String
+  deriving (Show, Typeable)
+
+instance Exception InfluxException
+
+jsonDecodeError :: String -> IO a
+jsonDecodeError = throwIO . JsonDecodeError
+
+seriesDecodeError :: String -> IO a
+seriesDecodeError = throwIO . SeriesDecodeError
+
+-----------------------------------------------------------
 -- Aeson instances
 
 deriveFromJSON (stripPrefixOptions "database") ''Database
 deriveFromJSON (stripPrefixOptions "admin") ''Admin
 deriveFromJSON (stripPrefixOptions "user") ''User
+deriveFromJSON (stripPrefixOptions "ping") ''Ping
diff --git a/tests/test-suite.hs b/tests/test-suite.hs
index fbd8f81..e8ef7ce 100644
--- a/tests/test-suite.hs
+++ b/tests/test-suite.hs
@@ -1,10 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 import Control.Applicative
 import Control.Exception as E
-import Control.Monad
 import Control.Monad.Trans
-import Data.Function
 import Data.Int
 import Data.List (find)
 import Data.Monoid
@@ -16,13 +15,13 @@ 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 Test.Tasty.QuickCheck hiding (reason)
 import qualified Network.HTTP.Client as HC
 
 import Database.InfluxDB
+import Database.InfluxDB.TH
 import qualified Database.InfluxDB.Stream as S
 
 prop_fromValue_toValue_identity_Value :: Value -> Bool
@@ -92,6 +91,21 @@ fromValueToValueIdentity a = fromValue (toValue a) == Right a
 
 -------------------------------------------------
 
+case_ping :: Assertion
+case_ping = runTest $ \config -> do
+  Ping status <- ping config
+  status @?= "ok"
+
+case_listInterfaces :: Assertion
+case_listInterfaces = runTest $ \config -> do
+  ifaces <- listInterfaces config
+  ifaces @?= ["default"]
+
+case_isInSync :: Assertion
+case_isInSync = runTest $ \config -> do
+  inSync <- isInSync config
+  assertBool "The database is not in sync." inSync
+
 case_post :: Assertion
 case_post = runTest $ \config ->
   withTestDatabase config $ \database -> do
@@ -239,16 +253,16 @@ case_update_cluster_admin_password = runTest $ \config -> do
   updateClusterAdminPassword config admin newPassword
   let newCreds = Credentials name newPassword
       newConfig = config { configCreds = newCreds }
-  name <- newName
-  dropDatabaseIfExists config name
-  createDatabase newConfig name
+  name' <- newName
+  dropDatabaseIfExists config name'
+  createDatabase newConfig name'
   listDatabases newConfig >>= \databases ->
-    assertBool ("No such database: " ++ T.unpack name) $
-      any ((name ==) . databaseName) databases
-  dropDatabase newConfig name
+    assertBool ("No such database: " ++ T.unpack name') $
+      any ((name' ==) . databaseName) databases
+  dropDatabase newConfig name'
   listDatabases newConfig >>= \databases ->
-    assertBool ("Found a dropped database: " ++ T.unpack name) $
-      all ((name /=) . databaseName) 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 ->
@@ -306,6 +320,37 @@ case_grant_revoke_database_user = runTest $ \config ->
     deleteDatabaseUser config name newUserName
 
 -------------------------------------------------
+-- Regressions
+
+newtype WholeFloat = WholeFloat
+  { wholeFloatValue :: Double
+  } deriving (Eq, Show)
+
+-- #14: InfluxDB may return Int instead of Float when
+-- the WholeFloat value happens to be a whole number.
+case_regression_whole_Float_number :: Assertion
+case_regression_whole_Float_number = runTest $ \config ->
+  withTestDatabase config $ \database -> do
+    series <- newName
+    post config database $
+      writeSeries series $ WholeFloat 42.0
+    ss <- query config database $ "select value from " <> series
+    case ss of
+      [sd] -> fromSeriesData sd @?= Right [WholeFloat 42]
+      _ -> assertFailure $ "Expect one series, but got: " ++ show ss
+
+case_regression_really_big_Float_number :: Assertion
+case_regression_really_big_Float_number = runTest $ \config ->
+  withTestDatabase config $ \database -> do
+    series <- newName
+    post config database $
+      writeSeries series $ WholeFloat 42e100
+    ss <- query config database $ "select value from " <> series
+    case ss of
+      [sd] -> fromSeriesData sd @?= Right [WholeFloat 42e100]
+      _ -> assertFailure $ "Expect one series, but got: " ++ show ss
+
+-------------------------------------------------
 
 data Val = Val Int deriving (Eq, Show)
 
@@ -359,3 +404,10 @@ catchAll = E.catch
 
 main :: IO ()
 main = $defaultMainGenerator
+
+-------------------------------------------------
+-- Instance deriving
+
+deriveSeriesData defaultOptions
+  { fieldLabelModifier = stripPrefixLower "wholeFloat" }
+  ''WholeFloat