rethinkdb-client-driver 0.0.5 → 0.0.6
raw patch · 3 files changed
+93/−34 lines, 3 files
Files
- rethinkdb-client-driver.cabal +1/−1
- src/Database/RethinkDB/Types.hs +90/−31
- src/Database/RethinkDB/Types/Datum.hs +2/−2
rethinkdb-client-driver.cabal view
@@ -1,5 +1,5 @@ name: rethinkdb-client-driver-version: 0.0.5+version: 0.0.6 license: MIT license-file: LICENSE author: Tomas Carnecky
src/Database/RethinkDB/Types.hs view
@@ -39,7 +39,7 @@ toTerm :: a -> State Context A.Value instance Term A.Value where- toTerm = return+ toTerm = pure @@ -66,7 +66,7 @@ newVar = do ix <- gets varCounter modify $ \s -> s { varCounter = ix + 1 }- return ix+ pure ix @@ -75,7 +75,7 @@ instance IsDatum Datum instance Term Datum where- toTerm (Null ) = return $ A.Null+ toTerm (Null ) = pure $ A.Null toTerm (Bool x) = toTerm x toTerm (Number x) = toTerm x toTerm (String x) = toTerm x@@ -91,8 +91,8 @@ (SuccessAtom, [a]) -> do res0 <- parseWire a case res0 of- Null -> return Nothing- res -> return $ Just res+ Null -> pure Nothing+ res -> pure $ Just res _ -> fail $ "responseAtomParser: Not a single-element vector " ++ show (responseResult r) @@ -106,7 +106,7 @@ parseResponse = responseAtomParser instance Term Bool where- toTerm = return . A.Bool+ toTerm = pure . A.Bool @@ -120,10 +120,14 @@ parseResponse = responseAtomParser instance Term Double where- toTerm = return . toJSON+ toTerm = pure . toJSON +instance FromResponse Int where+ parseResponse = responseAtomParser ++ ------------------------------------------------------------------------------ -- | For strings, we're using the Haskell 'Text' type. @@ -133,7 +137,7 @@ parseResponse = responseAtomParser instance Term Text where- toTerm = return . toJSON+ toTerm = pure . toJSON @@ -150,7 +154,7 @@ toTerm v = do vals <- mapM toTerm (V.toList v) options <- toTerm emptyOptions- return $ A.Array $ V.fromList $+ pure $ A.Array $ V.fromList $ [ A.Number 2 , toJSON vals , toJSON $ options@@ -174,7 +178,7 @@ instance Term Object where toTerm x = do items <- mapM (\(k, v) -> (,) <$> pure k <*> toTerm v) $ HMS.toList x- return $ A.Object $ HMS.fromList $ items+ pure $ A.Object $ HMS.fromList $ items @@ -191,7 +195,7 @@ parseResponse = responseAtomParser instance Term ZonedTime where- toTerm x = return $ A.object+ toTerm x = pure $ A.object [ "$reql_type$" A..= ("TIME" :: Text) , "timezone" A..= (timeZoneOffsetString $ zonedTimeZone x) , "epoch_time" A..= (realToFrac $ utcTimeToPOSIXSeconds $ zonedTimeToUTC x :: Double)@@ -211,12 +215,8 @@ instance Term UTCTime where toTerm = toTerm . utcToZonedTime utc -instance Lift Exp UTCTime where- type Simplified UTCTime = ZonedTime- lift = Constant . utcToZonedTime utc - ------------------------------------------------------------------------------ -- | Tables are something you can select objects from. --@@ -295,8 +295,8 @@ data Order = Ascending !Text | Descending !Text instance Term Order where- toTerm (Ascending key) = simpleTerm 73 [SomeExp $ Constant $ String key]- toTerm (Descending key) = simpleTerm 74 [SomeExp $ Constant $ String key]+ toTerm (Ascending key) = simpleTerm 73 [SomeExp $ lift key]+ toTerm (Descending key) = simpleTerm 74 [SomeExp $ lift key] @@ -392,12 +392,9 @@ Any :: [Exp Bool] -> Exp Bool -- True if any element in the input is True. - ObjectField :: (IsObject a, IsDatum r) => Exp a -> Exp Text -> Exp r+ GetField :: (IsObject a, IsDatum r) => Exp Text -> Exp a -> Exp r -- Get a particular field from an object (or SingleSelection). - ExtractField :: (IsSequence a) => Exp a -> Exp Text -> Exp a- -- Like 'ObjectField' but over a sequence.- HasFields :: (IsObject a) => [Text] -> Exp a -> Exp Bool -- True if the object has all the given fields. @@ -443,14 +440,42 @@ Limit :: (IsSequence s) => Double -> Exp s -> Exp s -- ^ Limit the number of items in the sequence. + UUID :: Exp Text+ -- ^ An expression which when evaluated will generate a fresh UUID (in its+ -- standard string encoding). + Now :: Exp ZonedTime+ -- ^ The time when the query was received by the server.++ Timezone :: Exp ZonedTime -> Exp Text+ -- ^ The timezone in which the given time is.++ RandomInteger :: Exp Int -> Exp Int -> Exp Int+ -- ^ Takes a lower and upper bound and returns a random integer between+ -- the two. Note that the lower bound is closed, the upper bound is open,+ -- ie: [min, max)++ RandomFloat :: Exp Double -> Exp Double -> Exp Double+ -- ^ Same as 'RandomInteger' but uses floating-point numbers.++ Info :: Exp a -> Exp Object+ -- ^ Gets info about anything.++ Default :: Exp a -> Exp a -> Exp a+ -- ^ Evaluate the first argument. If it throws an error then the second+ -- argument is returned.++ Error :: Exp Text -> Exp a+ -- ^ Throw an error with the given message.++ instance Term (Exp a) where toTerm (Constant datum) = toTerm $ toDatum datum toTerm ListDatabases =- simpleTerm 59 ([] :: [SomeExp])+ noargTerm 59 toTerm (CreateDatabase name) = simpleTerm 57 [SomeExp name]@@ -489,7 +514,7 @@ simpleTerm 14 [SomeExp name] toTerm (Table mbDatabase name) = do- db <- maybe (gets defaultDatabase) return mbDatabase+ db <- maybe (gets defaultDatabase) pure mbDatabase simpleTerm 15 [SomeExp db, SomeExp name] toTerm (Filter f s) =@@ -528,10 +553,7 @@ toTerm (Delete selection) = simpleTerm 54 [SomeExp selection] - toTerm (ObjectField obj field) =- simpleTerm 31 [SomeExp obj, SomeExp field]-- toTerm (ExtractField obj field) =+ toTerm (GetField field obj) = simpleTerm 31 [SomeExp obj, SomeExp field] toTerm (HasFields fields obj) =@@ -602,18 +624,46 @@ toTerm (Limit n s) = simpleTerm 71 [SomeExp s, SomeExp (lift n)] + toTerm UUID =+ noargTerm 169 + toTerm Now =+ noargTerm 103++ toTerm (Timezone time) =+ simpleTerm 127 [SomeExp time]++ toTerm (RandomInteger lo hi) =+ simpleTerm 151 [SomeExp lo, SomeExp hi]++ toTerm (RandomFloat lo hi) =+ termWithOptions 151 [SomeExp lo, SomeExp hi] $+ HMS.singleton "float" (Bool True)++ toTerm (Info a) =+ simpleTerm 79 [SomeExp a]++ toTerm (Default action def) =+ simpleTerm 92 [SomeExp action, SomeExp def]++ toTerm (Error message) =+ simpleTerm 12 [SomeExp message]+++noargTerm :: Int -> State Context A.Value+noargTerm termType = pure $ A.Array $ V.fromList [toJSON termType]+ simpleTerm :: (Term a) => Int -> [a] -> State Context A.Value simpleTerm termType args = do args' <- mapM toTerm args- return $ A.Array $ V.fromList [toJSON termType, toJSON args']+ pure $ A.Array $ V.fromList [toJSON termType, toJSON args'] termWithOptions :: (Term a) => Int -> [a] -> Object -> State Context A.Value termWithOptions termType args options = do args' <- mapM toTerm args options' <- toTerm options - return $ A.Array $ V.fromList [toJSON termType, toJSON args', toJSON options']+ pure $ A.Array $ V.fromList [toJSON termType, toJSON args', toJSON options'] -- | Convenience to for automatically converting a 'Text' to a constant@@ -652,6 +702,10 @@ type Simplified Bool = Bool lift = Constant +instance Lift Exp Int where+ type Simplified Int = Int+ lift = Constant+ instance Lift Exp Double where type Simplified Double = Double lift = Constant@@ -672,6 +726,10 @@ type Simplified ZonedTime = ZonedTime lift = Constant +instance Lift Exp UTCTime where+ type Simplified UTCTime = ZonedTime+ lift = Constant . utcToZonedTime utc+ instance Lift Exp (Array Datum) where type Simplified (Array Datum) = (Array Datum) lift = Constant@@ -680,14 +738,14 @@ type Simplified (Exp a -> Exp r) = Exp r lift f = Function $ do v1 <- newVar- return $ ([v1], f (Var v1))+ pure $ ([v1], f (Var v1)) instance Lift Exp (Exp a -> Exp b -> Exp r) where type Simplified (Exp a -> Exp b -> Exp r) = Exp r lift f = Function $ do v1 <- newVar v2 <- newVar- return $ ([v1, v2], f (Var v1) (Var v2))+ pure $ ([v1, v2], f (Var v1) (Var v2)) @@ -728,6 +786,7 @@ type instance Result Text = Text type instance Result Double = Double+type instance Result Int = Int type instance Result Bool = Bool type instance Result ZonedTime = ZonedTime
src/Database/RethinkDB/Types/Datum.hs view
@@ -110,7 +110,7 @@ parseWire (A.Object x) = (Time <$> zonedTimeParser x) <|> do -- HashMap does not provide a mapM, what a shame :( items <- mapM (\(k, v) -> (,) <$> pure k <*> parseWire v) $ HMS.toList x- return $ Object $ HMS.fromList items+ pure $ Object $ HMS.fromList items zonedTimeParser :: HashMap Text A.Value -> Parser ZonedTime@@ -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 (return Nothing) (fmap Just . parseDatum) $ HMS.lookup k o+o .:? k = maybe (pure Nothing) (fmap Just . parseDatum) $ HMS.lookup k o object :: [(Text, Datum)] -> Datum object = Object . HMS.fromList