summaryrefslogtreecommitdiff
path: root/src/Database/InfluxDB/Decode.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Database/InfluxDB/Decode.hs')
-rw-r--r--src/Database/InfluxDB/Decode.hs96
1 files changed, 89 insertions, 7 deletions
diff --git a/src/Database/InfluxDB/Decode.hs b/src/Database/InfluxDB/Decode.hs
index 0a77b38..f733974 100644
--- a/src/Database/InfluxDB/Decode.hs
+++ b/src/Database/InfluxDB/Decode.hs
@@ -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 Series where
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 @@ instance FromSeriesData SeriesData where
, 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 @@ withValues f columns values =
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 @@ values .: column = do
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,10 +130,64 @@ instance FromValue Int where
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
-> Value