rethinkdb 1.15.2.0 → 1.15.2.1
raw patch · 5 files changed
+76/−56 lines, 5 filesdep ~networkPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: network
API changes (from Hackage documentation)
Files
- Database/RethinkDB/Datum.hs +61/−43
- Database/RethinkDB/Driver.hs +7/−6
- Database/RethinkDB/Geospatial.hs +5/−5
- Database/RethinkDB/ReQL.hs +1/−0
- rethinkdb.cabal +2/−2
Database/RethinkDB/Datum.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, PatternGuards, DefaultSignatures, +{-# LANGUAGE OverloadedStrings, PatternGuards, DefaultSignatures, FlexibleInstances, OverlappingInstances #-} module Database.RethinkDB.Datum (@@ -12,6 +12,7 @@ ) where import qualified Data.Aeson as J+import qualified Data.Aeson.Types as J import Data.Aeson.Types (Parser, Result(..), FromJSON(..), parse, ToJSON(..), Value) import Data.Aeson (fromJSON) import qualified Data.ByteString as SB@@ -56,70 +57,73 @@ default parseDatum :: FromJSON a => Datum -> Parser a parseDatum = parseJSON . toJSON +errorExpected :: Show d => String -> d -> J.Parser x+errorExpected t d = fail $ "Expected " ++ t ++ " but found " ++ take 100 (show d)+ instance FromDatum a => FromDatum [a] where parseDatum (Array v) = mapM parseDatum $ V.toList v- parseDatum _ = mempty+ parseDatum d = errorExpected "Array" d instance FromDatum Datum where parseDatum = return instance FromDatum () where parseDatum (Array a) | V.null a = return ()- parseDatum _ = mempty+ parseDatum d = errorExpected "Array" d instance (FromDatum a, FromDatum b) => FromDatum (a, b) where parseDatum (Array xs) | [a,b] <- V.toList xs = (,) <$> parseDatum a <*> parseDatum b- parseDatum _ = mempty+ parseDatum d = errorExpected "Array" d instance (FromDatum a, FromDatum b, FromDatum c) => FromDatum (a, b, c) where parseDatum (Array xs) | [a,b,c] <- V.toList xs = (,,) <$> parseDatum a <*> parseDatum b <*> parseDatum c- parseDatum _ = mempty+ parseDatum d = errorExpected "Array" d instance (FromDatum a, FromDatum b, FromDatum c, FromDatum d) => FromDatum (a, b, c, d) where parseDatum (Array xs) | [a,b,c,d] <- V.toList xs = (,,,) <$> parseDatum a <*> parseDatum b <*> parseDatum c <*> parseDatum d- parseDatum _ = mempty+ parseDatum d = errorExpected "Array" d instance (FromDatum a, FromDatum b, FromDatum c, FromDatum d, FromDatum e) => FromDatum (a, b, c, d, e) where parseDatum (Array xs) | [a,b,c,d,e] <- V.toList xs = (,,,,) <$> parseDatum a <*> parseDatum b <*> parseDatum c <*> parseDatum d <*> parseDatum e- parseDatum _ = mempty+ parseDatum d = errorExpected "Array" d instance (FromDatum a, FromDatum b) => FromDatum (Either a b) where parseDatum (Object o) =- Left <$> o .: "Left" + Left <$> o .: "Left" <|> Right <$> o .: "Right"- parseDatum _ = mempty+ parseDatum d = errorExpected "Object" d instance FromDatum SB.ByteString where parseDatum (Binary b) = return b- parseDatum _ = mempty+ parseDatum d = errorExpected "Binary" d instance FromDatum LB.ByteString where parseDatum (Binary b) = return $ LB.fromStrict b- parseDatum _ = mempty+ parseDatum d = errorExpected "Binary" d instance FromDatum a => FromDatum (HM.HashMap ST.Text a) where parseDatum (Object o) = fmap HM.fromList . sequence . map (\(k,v) -> (,) k <$> parseDatum v) $ HM.toList o- parseDatum _ = mempty+ parseDatum d = errorExpected "Object" d instance FromDatum a => FromDatum (HM.HashMap [Char] a) where parseDatum (Object o) = fmap HM.fromList . sequence . map (\(k,v) -> (,) (ST.unpack k) <$> parseDatum v) $ HM.toList o- parseDatum _ = mempty+ parseDatum d = errorExpected "Object" d instance FromDatum a => FromDatum (Map.Map ST.Text a) where parseDatum (Object o) = fmap Map.fromList . mapM (\(k,v) -> (,) k <$> parseDatum v) $ HM.toList o- parseDatum _ = mempty+ parseDatum d = errorExpected "Object" d instance FromDatum a => FromDatum (Map.Map [Char] a) where parseDatum (Object o) = fmap Map.fromList . mapM (\(k,v) -> (,) (ST.unpack k) <$> parseDatum v) $ HM.toList o- parseDatum _ = mempty+ parseDatum d = errorExpected "Object" d instance FromDatum a => FromDatum (Maybe a) where parseDatum Null = return Nothing@@ -127,20 +131,27 @@ instance (Ord a, FromDatum a) => FromDatum (Set.Set a) where parseDatum (Array a) = fmap Set.fromList . mapM parseDatum $ V.toList a- parseDatum _ = mempty+ parseDatum d = errorExpected "Array" d instance FromDatum ZonedTime where parseDatum (Time t) = return t- parseDatum _ = mempty+ parseDatum d = errorExpected "Time" d instance FromDatum UTCTime where parseDatum (Time t) = return $ zonedTimeToUTC t- parseDatum _ = mempty+ parseDatum d = errorExpected "Time" d -instance FromDatum a => FromDatum (Vector a) where +-- TODO: This instance breaks (fmap toDatum . fromDatum) == return+instance FromDatum a => FromDatum (Vector a) where parseDatum (Array v) = fmap V.fromList . mapM parseDatum $ V.toList v- parseDatum _ = mempty+ parseDatum (Line l) = fmap V.fromList . mapM (parseDatum . toDatum) $ V.toList l+ parseDatum (Polygon p) = fmap V.fromList . mapM (parseDatum . toDatum) $ V.toList p+ parseDatum d = errorExpected "Array, Line or Polygon" d +instance FromDatum LonLat where+ parseDatum (Point l) = return l+ parseDatum d = errorExpected "Point" d+ instance FromDatum Float instance FromDatum String instance FromDatum Int@@ -170,9 +181,6 @@ data LonLat = LonLat { longitude, latitude :: Double } deriving (Eq, Ord) -instance ToJSON LonLat where- toJSON (LonLat a b) = toJSON [a, b]- instance Eq Datum where Null == Null = True Bool a == Bool b = a == b@@ -188,11 +196,7 @@ _ == _ = False instance Show LonLat where- show (LonLat lon lat) = "[" ++ showDouble lon ++ "," ++ showDouble lat ++ "]"--instance J.FromJSON LonLat where- parseJSON v | Success [lon, lat] <- fromJSON v = return $ LonLat lon lat- parseJSON _ = mempty+ show (LonLat lon lat) = "LonLat " ++ showDouble lon ++ " " ++ showDouble lat instance Show Datum where show Null = "null"@@ -203,11 +207,14 @@ show (Array v) = "[" ++ intercalate "," (map show $ V.toList v) ++ "]" show (Object o) = "{" ++ intercalate "," (map (\(k,v) -> show k ++ ":" ++ show v) $ HM.toList o) ++ "}" show (Time t) = "Time<" ++ show t ++ ">"- show (Point p) = "Point<" ++ show p ++ ">"- show (Line l) = "Line<" ++ intercalate "," (map show $ V.toList l) ++ ">"- show (Polygon p) = "Polygon<" ++ intercalate "," (map (\x -> "[" ++ intercalate "," (map show $ V.toList x) ++ "]") (V.toList p)) ++ ">"+ show (Point p) = "Point<" ++ showLonLat p ++ ">"+ show (Line l) = "Line<[" ++ intercalate "],[" (map showLonLat $ V.toList l) ++ "]>"+ show (Polygon p) = "Polygon<[" ++ intercalate "],[" (map (\x -> "[" ++ intercalate "],[" (map showLonLat $ V.toList x) ++ "]") (V.toList p)) ++ "]>" show (Binary b) = "Binary<" ++ show b ++ ">" +showLonLat :: LonLat -> String+showLonLat (LonLat a b) = showDouble a ++ "," ++ showDouble b+ showDouble :: Double -> String showDouble d = let s = show d in if ".0" `isSuffixOf` s then init (init s) else s @@ -278,6 +285,14 @@ instance ToDatum a => ToDatum (Set.Set a) where toDatum = Array . V.fromList . map toDatum . Set.toList +instance ToDatum (Ratio Integer) where+ toDatum a = toDatum (toDouble a)+ where toDouble :: Rational -> Double+ toDouble = fromRational++instance ToDatum LonLat where+ toDatum l = Point l+ instance ToDatum Value instance ToDatum Int instance ToDatum Int8@@ -297,7 +312,6 @@ instance ToDatum Bool instance ToDatum Double instance ToDatum Float-instance ToDatum (Ratio Integer) toJSONDatum :: ToJSON a => a -> Datum toJSONDatum a = case toJSON a of@@ -309,9 +323,9 @@ Just t <- HM.lookup "type" o, Just c <- HM.lookup "coordinates" o -> case t of- "Point" | Success p <- fromJSON c -> Point p- "LineString" | Success l <- fromJSON c -> Line l- "Polygon" | Success p <- fromJSON c -> Polygon p+ "Point" | Success [lon, lat] <- fromJSON c -> Point (LonLat lon lat)+ "LineString" | Success l <- V.mapM toLonLat =<< fromJSON c -> Line l+ "Polygon" | Success p <- V.mapM (V.mapM toLonLat) =<< fromJSON c -> Polygon p _ -> asObject Just "TIME" | Just (J.Number ts) <- HM.lookup "epoch_time" o,@@ -321,14 +335,16 @@ Just "BINARY" | Just (J.String b64) <- HM.lookup "data" o, Right dat <- Base64.decode (encodeUtf8 b64) ->- Binary dat + Binary dat _ -> asObject J.Null -> Null J.Bool b -> Bool b J.Number s -> Number (toRealFloat s) J.String t -> String t J.Array v -> Array (fmap toJSONDatum v)-+ where + toLonLat [lon, lat] = J.Success $ LonLat lon lat+ toLonLat _ = J.Error "expected a pair" instance J.FromJSON Datum where parseJSON = return . toJSONDatum @@ -346,23 +362,25 @@ toJSON (Point p) = J.object [ "$reql_type$" J..= ("GEOMETRY" :: ST.Text), "type" J..= ("Point" :: ST.Text),- "coordinates" J..= toJSON p]+ "coordinates" J..= pointToPair p] toJSON (Line l) = J.object [ "$reql_type$" J..= ("GEOMETRY" :: ST.Text), "type" J..= ("LineString" :: ST.Text),- "coordinates" J..= toJSON l]+ "coordinates" J..= V.map pointToPair l] toJSON (Polygon p) = J.object [ "$reql_type$" J..= ("GEOMETRY" :: ST.Text), "type" J..= ("Polygon" :: ST.Text),- "coordinates" J..= toJSON p]+ "coordinates" J..= V.map (V.map pointToPair) p] toJSON (Binary b) = J.object [ "$reql_type$" J..= ("BINARY" :: ST.Text), "data" J..= Char8.unpack (Base64.encode b)]- +pointToPair :: LonLat -> (Double, Double)+pointToPair (LonLat lon lat) = (lon, lat)+ parseTimeZone :: String -> Maybe TimeZone parseTimeZone "Z" = Just utc-parseTimeZone tz = minutesToTimeZone <$> case tz of +parseTimeZone tz = minutesToTimeZone <$> case tz of ('-':tz') -> negate <$> go tz' ('+':tz') -> go tz' _ -> go tz@@ -414,7 +432,7 @@ k .= v = (k, toDatum v) (.:) :: FromDatum a => HM.HashMap ST.Text Datum -> ST.Text -> Parser a-o .: k = maybe mempty parseDatum $ HM.lookup k o+o .: k = maybe (fail $ "key " ++ show k ++ "not found") parseDatum $ HM.lookup k o (.:?) :: FromDatum a => HM.HashMap ST.Text Datum -> ST.Text -> Parser (Maybe a) o .:? k = maybe (return Nothing) (fmap Just . parseDatum) $ HM.lookup k o
Database/RethinkDB/Driver.hs view
@@ -118,22 +118,22 @@ instance FromDatum a => Result [a] where convertResult = collect <=< convertResult -instance (FromDatum a, e ~ RethinkDBError) => Result (Either e a) where+instance (FromDatum b, a ~ RethinkDBError) => Result (Either a b) where convertResult v = do r <- takeMVar v ed <- case r of ResponseSingle Null -> return $ Right Null- ResponseSingle a -> return $ Right a- ResponseError e -> return $ Left e+ ResponseSingle b -> return $ Right b+ ResponseError a -> return $ Left a ResponseBatch Nothing batch -> return $ Right $ toDatum batch ResponseBatch (Just _more) batch -> do rest <- collect' =<< convertResult v return $ Right $ toDatum $ batch ++ rest case ed of- Left e -> return $ Left e+ Left a -> return $ Left a Right d -> case fromDatum d of- Success a -> return $ Right a- Error e -> return $ Left $ RethinkDBError ErrorUnexpectedResponse (Datum Null) e []+ Success b -> return $ Right b+ Error a -> return $ Left $ RethinkDBError ErrorUnexpectedResponse (Datum Null) a [] instance FromDatum a => Result (Maybe a) where convertResult v = do @@ -180,6 +180,7 @@ instance FromDatum a => Result (Map.Map [Char] a) instance FromDatum a => Result (Map.Map ST.Text a) instance Result (Ratio Integer)+instance Result LonLat nextFail :: FromDatum a => Cursor Datum -> IO a nextFail c = do
Database/RethinkDB/Geospatial.hs view
@@ -35,7 +35,7 @@ -- | Convert a GeoJSON object into a RethinkDB geometry object -- -- >>> run' h $ geoJSON ["type" := "Point", "coordinates" := [-45,80]]--- Point<[-45,80]>+-- Point<-45,80> geoJSON :: Expr geojson => geojson -> ReQL geoJSON g = op GEOJSON [g]@@ -93,7 +93,7 @@ -- | Create a point objects -- -- >>> run' h $ point (-73) 40--- Point<[-73,40]>+-- Point<-73,40> point :: (Expr longitude, Expr latitude) => longitude -> latitude -> ReQL point lon lat = op POINT (lon, lat) @@ -121,16 +121,16 @@ -- | Distance between a point and another geometry object -- -- >>> run' h $ distance (point (-73) 40) (point (-122) 37)--- 4233453.467303547+-- 4233453.467303546 -- >>> run' h $ ex distance [unit Mile] (point (-73) 40) (point (-122) 37)--- 2630.54602825968+-- 2630.5460282596796 distance :: (Expr a, Expr b) => a -> b -> ReQL distance a b = op DISTANCE (a,b) -- | Optional argument for getNearest maxResults :: ReQL -> Attribute a maxResults n = "max_results" := n- + -- | Optional argument for getNearest maxDist :: ReQL -> Attribute a maxDist d = "max_dist" := d
Database/RethinkDB/ReQL.hs view
@@ -388,6 +388,7 @@ instance Expr Word32 instance Expr Word64 instance Expr (Ratio Integer)+instance Expr LonLat instance (a ~ ReQL) => Expr (a -> ReQL) where expr f = ReQL $ do
rethinkdb.cabal view
@@ -1,5 +1,5 @@ name: rethinkdb-version: 1.15.2.0+version: 1.15.2.1 cabal-version: >=1.8 build-type: Simple license: Apache@@ -29,7 +29,7 @@ bytestring ==0.10.*, containers ==0.5.*, data-default ==0.5.*,- network >=2.4 && <2.6,+ network >=2.4 && <2.7, mtl >=2.1 && <2.3, vector ==0.10.*, time ==1.4.*,