rethinkdb-client-driver 0.0.9 → 0.0.10

raw patch · 3 files changed

+49/−17 lines, 3 files

Files

• rethinkdb-client-driver.cabal +3/−2
• src/Database/RethinkDB/Types.hs +21/−14
• src/Database/RethinkDB/Types/Datum.hs +25/−1

@@ -1,5 +1,5 @@ name:                   rethinkdb-client-driver-version:                0.0.9+version:                0.0.10 license:                MIT license-file:           LICENSE author:                 Tomas Carnecky@@ -49,10 +49,11 @@                       , vector      exposed-modules   : Database.RethinkDB+                      , Database.RethinkDB.TH+     other-modules     : Database.RethinkDB.Messages                       , Database.RethinkDB.Types                       , Database.RethinkDB.Types.Datum-                      , Database.RethinkDB.TH      ghc-options       : -Wall 

@@ -24,6 +24,7 @@  import           Data.Vector         (Vector) import qualified Data.Vector         as V+import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HMS  import           Database.RethinkDB.Types.Datum@@ -422,6 +423,9 @@     OrderBy :: (IsSequence s) => [Order] -> Exp s -> Exp (Array Datum)     -- Order a sequence based on the given order specificiation. +    OrderByIndexed :: (IsSequence s) => Order -> Exp s -> Exp (Array Datum)+    -- Like OrderBy but uses a secondary index instead of a object field.+     Keys :: (IsObject a) => Exp a -> Exp (Array Text)      Var :: Int -> Exp a@@ -529,16 +533,16 @@     toTerm (Between (l, u) s) =         termWithOptions 36 [SomeExp s, SomeExp $ lift (boundDatum l), SomeExp $ lift (boundDatum u)] $             HMS.fromList-                [ ("left_bound",  String (boundString l))-                , ("right_bound", String (boundString u))+                [ ("left_bound",  toJSON $ String (boundString l))+                , ("right_bound", toJSON $ String (boundString u))                 ]      toTerm (BetweenIndexed index (l, u) s) =         termWithOptions 36 [SomeExp s, SomeExp $ lift (boundDatum l), SomeExp $ lift (boundDatum u)] $             HMS.fromList-                [ ("left_bound",  String (boundString l))-                , ("right_bound", String (boundString u))-                , ("index",       String index)+                [ ("left_bound",  toJSON $ String (boundString l))+                , ("right_bound", toJSON $ String (boundString u))+                , ("index",       toJSON $ String index)                 ]      toTerm (OrderBy spec s) = do@@ -546,12 +550,17 @@         spec' <- mapM toTerm spec         simpleTerm 41 ([s'] ++ spec') +    toTerm (OrderByIndexed spec s) = do+        s'    <- toTerm s+        spec' <- toTerm spec+        termWithOptions 41 [s'] $ HMS.singleton "index" spec'+     toTerm (InsertObject crs table obj) =         termWithOptions 56 [SomeExp table, SomeExp (lift obj)] $-            HMS.singleton "conflict" (toDatum crs)+            HMS.singleton "conflict" (toJSON $ toDatum crs)      toTerm (InsertSequence table s) =-        termWithOptions 56 [SomeExp table, SomeExp s] emptyOptions+        termWithOptions 56 [SomeExp table, SomeExp s] HMS.empty      toTerm (Delete selection) =         simpleTerm 54 [SomeExp selection]@@ -597,7 +606,7 @@      toTerm (GetAllIndexed table keys index) =         termWithOptions 78 ([SomeExp table] ++ map SomeExp keys)-            (HMS.singleton "index" (String index))+            (HMS.singleton "index" (toJSON $ String index))      toTerm (Take n s) =         simpleTerm 71 [SomeExp s, SomeExp n]@@ -644,7 +653,7 @@      toTerm (RandomFloat lo hi) =         termWithOptions 151 [SomeExp lo, SomeExp hi] $-            HMS.singleton "float" (Bool True)+            HMS.singleton "float" (toJSON $ Bool True)      toTerm (Info a) =         simpleTerm 79 [SomeExp a]@@ -664,12 +673,10 @@     args' <- mapM toTerm args     pure $ A.Array $ V.fromList [toJSON termType, toJSON args'] -termWithOptions :: (Term a) => Int -> [a] -> Object -> State Context A.Value+termWithOptions :: (Term a) => Int -> [a] -> HashMap Text Value -> State Context A.Value termWithOptions termType args options = do-    args'    <- mapM toTerm args-    options' <- toTerm options--    pure $ A.Array $ V.fromList [toJSON termType, toJSON args', toJSON options']+    args' <- mapM toTerm args+    pure $ A.Array $ V.fromList [toJSON termType, toJSON args', toJSON options]   -- | Convenience to for automatically converting a 'Text' to a constant

@@ -149,7 +149,7 @@ o .: k = maybe (fail $ "key " ++ show k ++ "not found") parseDatum $ HMS.lookup k o  (.:?) :: FromDatum a => HashMap Text Datum -> Text -> Parser (Maybe a)-o .:? k = maybe (pure Nothing) (fmap Just . parseDatum) $ HMS.lookup k o+o .:? k = maybe (pure Nothing) parseDatum $ HMS.lookup k o  object :: [(Text, Datum)] -> Datum object = Object . HMS.fromList@@ -168,6 +168,18 @@   ------------------------------------------------------------------------------+-- ()++instance ToDatum () where+    toDatum () = Array V.empty++instance FromDatum () where+    parseDatum (Array x) = if V.null x then pure () else fail "()"+    parseDatum _         = fail "()"++++------------------------------------------------------------------------------ -- Bool  instance ToDatum Bool where@@ -188,6 +200,18 @@ instance FromDatum Double where     parseDatum (Number x) = pure x     parseDatum _          = fail "Double"++++------------------------------------------------------------------------------+-- Float++instance ToDatum Float where+    toDatum = Number . realToFrac++instance FromDatum Float where+    parseDatum (Number x) = pure $ realToFrac x+    parseDatum _          = fail "Float"