packages feed

rethinkdb 1.8.0.5 → 1.15.0.0

raw patch · 45 files changed

+3596/−3445 lines, 45 filesdep +base64-bytestringdep +binarydep +criteriondep −attoparsecdep −ghc-primdep −protocol-buffersdep ~aesondep ~basedep ~bytestring

Dependencies added: base64-bytestring, binary, criterion, doctest, rethinkdb, scientific

Dependencies removed: attoparsec, ghc-prim, protocol-buffers, protocol-buffers-descriptor

Dependency ranges changed: aeson, base, bytestring, containers, data-default, mtl, network, text, time, unordered-containers, utf8-string, vector

Files

Database/RethinkDB.hs view
@@ -9,111 +9,152 @@ -- > import qualified Database.RethinkDB.NoClash  module Database.RethinkDB (+     -- * Accessing RethinkDB -  RethinkDBHandle,   connect,+  RethinkDBHandle,   close,   use,   run, run', runOpts,-  next, collect,-  RunOptions(..),-  Cursor,-  Response,-  Result(..),+  ReQL,+  Datum(..),+  ToDatum(..), FromDatum(..), fromDatum,+  RunFlag(..),+  noReplyWait,   RethinkDBError(..),-  SuccessCode(..),   ErrorCode(..),-  ReQL,-  JSON(..),-+  Response,+  Result(..),+  +  -- * Cursors+  +  next, collect, collect', each,+  Cursor,+     -- * Manipulating databases    Database(..),-  db, dbCreate, dbDrop, dbList,+  dbCreate, dbDrop, dbList,    -- * Manipulating Tables -  Table(..), TableCreateOptions(..), IndexCreateOptions(..),-  table, tableCreate, tableDrop, tableList,+  Table(..),+  tableCreate, tableDrop, tableList,   indexCreate, indexDrop, indexList,+  indexRename, indexStatus, indexWait,+  changes,    -- * Writing data    WriteResponse(..),-  insert, upsert,+  Change(..),+  insert,   update, replace, delete,-  returnVals, nonAtomic,+  sync,+  returnChanges, nonAtomic,+  durability, Durability,+  conflict, ConflictResolution(..),    -- * Selecting data +  db, table,+  get, getAll,+  filter, between,   Bound(..),-  get, filter, between, getAll,    -- * Joins -  innerJoin, outerJoin, eqJoin, mergeLeftRight,+  innerJoin, outerJoin, eqJoin, zip,+  Index(..),    -- * Transformations -  map, withFields, concatMap, drop, take,-  (!!), slice,-  orderBy,  Order(..),-  indexesOf, isEmpty, (++), sample,+  map, withFields, concatMap,+  orderBy, asc, desc,+  skip, limit, slice,+  indexesOf, isEmpty, union, sample,    -- * Aggregation -  reduce, reduce1, nub, groupBy, elem,+  group,+  reduce, reduce0,+  distinct, contains,+  mapReduce,    -- * Aggregators -  length, sum, avg,+  count, sum, avg,+  min, max, argmin, argmax,    -- * Document manipulation    pluck, without,-  merge, append,-  prepend, (\\),+  merge,+  append, prepend,+  difference,   setInsert, setUnion, setIntersection, setDifference,-  (!), hasFields,-  insertAt, spliceAt, deleteAt, changeAt, keys,--  -- * Math and logic--  (+), (-), (*), (/), mod, (&&), (||),-  (==), (/=), (>), (<), (<=), (>=), not,+  (!), (!?),+  hasFields,+  insertAt, spliceAt, deleteAt, changeAt, keys,  +  literal, remove,+  Attribute(..),    -- * String manipulation   -  (=~),+  match, upcase, downcase,+  split, splitOn, splitMax,   +  -- * Math and logic++  (+), (-), (*), (/), mod,+  (&&), (||),+  (==), (/=), (>), (>=), (<), (<=),+  not,+  random, randomTo, randomFromTo,+     -- * Dates and times   -  UTCTime(..), ZonedTime(..),   now, time, epochTime, iso8601, inTimezone, during,-  timezone, date, timeOfDay, year, month, day, dayOfWeek, dayOfYear, hours, minutes, seconds,+  timezone, date, timeOfDay, year, month, day, dayOfWeek,+  dayOfYear, hours, minutes, seconds,   toIso8601, toEpochTime,      -- * Control structures -  apply, js, if', forEach, error,+  args, apply, js, branch, forEach, error,   handle, Expr(..), coerceTo,   asArray, asString, asNumber, asObject, asBool,-  typeOf, info, json,+  typeOf, info, json, uuid,+  http,+  HttpOptions(..), HttpResultFormat(..),+  HttpMethod(..), PaginationStrategy(..),   +  -- * Geospatial commands+  +  circle, distance, fill, geoJSON,+  toGeoJSON, getIntersecting,+  getNearest, includes, intersects,+  line, point, polygon, polygonSub,+  LonLat(..), Line, Polygon,+  maxResults, maxDist, unit, numVertices,+  Unit(..),+     -- * Helpers -  Obj(..), Object, Attribute(..), str, num, (.), (#),+  ex, str, num, (#), note, empty,   def-+     ) where  import Prelude ()  import Database.RethinkDB.ReQL import Database.RethinkDB.Network-import Database.RethinkDB.Objects+import Database.RethinkDB.Types import Database.RethinkDB.Driver import Database.RethinkDB.Functions import Database.RethinkDB.Time+import Database.RethinkDB.Geospatial+import Database.RethinkDB.Datum hiding (Result) import Data.Default
+ Database/RethinkDB/Datum.hs view
@@ -0,0 +1,440 @@+{-# LANGUAGE OverloadedStrings, PatternGuards, DefaultSignatures, +    FlexibleInstances, OverlappingInstances #-}++module Database.RethinkDB.Datum (+  parse, Parser, Result(..),+  Datum(..), ToDatum(..), FromDatum(..), fromDatum,+  LonLat(..), Array, Object, Line, Polygon,+  (.=), (.:), (.:?),+  encode, decode, eitherDecode,+  resultToMaybe, resultToEither,+  object+  ) where++import qualified Data.Aeson as J+import Data.Aeson.Types (Parser, Result(..), FromJSON(..), parse, ToJSON(..), Value)+import Data.Aeson (fromJSON)+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import Data.Time+import Data.Time.Clock.POSIX+import qualified Data.Text as ST+import qualified Data.Text.Lazy as LT+import Data.Text.Encoding (encodeUtf8)+import qualified Data.HashMap.Strict as HM+import Data.Monoid+import Data.List+import Data.Vector (Vector)+import qualified Data.Vector as V+import qualified Data.ByteString.Base64 as Base64+import Control.Applicative+import Data.Scientific+import Data.Int+import Data.Word+import qualified Data.ByteString.Char8 as Char8+import Control.Monad+import qualified Data.Map as Map+import Data.Ratio+import qualified Data.Set as Set++-- | A ReQL value+data Datum =+  Null |+  Bool Bool |+  String ST.Text |+  Number Double |+  Array Array |+  Object Object |+  Time ZonedTime |+  Point LonLat |+  Line Line |+  Polygon Polygon |+  Binary SB.ByteString++class FromDatum a where+  parseDatum :: Datum -> Parser a+  default parseDatum :: FromJSON a => Datum -> Parser a+  parseDatum = parseJSON . toJSON++instance FromDatum a => FromDatum [a] where+  parseDatum (Array v) = mapM parseDatum $ V.toList v+  parseDatum _ = mempty++instance FromDatum Datum where+  parseDatum = return++instance FromDatum () where+  parseDatum (Array a) | V.null a = return ()+  parseDatum _ = mempty++instance (FromDatum a, FromDatum b) => FromDatum (a, b) where+  parseDatum (Array xs) | [a,b] <- V.toList xs =+    (,) <$> parseDatum a <*> parseDatum b+  parseDatum _ = mempty++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++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++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++instance (FromDatum a, FromDatum b) => FromDatum (Either a b) where+  parseDatum (Object o) =+    Left <$> o .: "Left" +    <|> Right <$> o .: "Right"+  parseDatum _ = mempty++instance FromDatum SB.ByteString where+  parseDatum (Binary b) = return b+  parseDatum _ = mempty++instance FromDatum LB.ByteString where+  parseDatum (Binary b) = return $ LB.fromStrict b+  parseDatum _ = mempty++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++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++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++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++instance FromDatum a => FromDatum (Maybe a) where+  parseDatum Null = return Nothing+  parseDatum d = Just <$> parseDatum d++instance (Ord a, FromDatum a) => FromDatum (Set.Set a) where+  parseDatum (Array a) = fmap Set.fromList . mapM parseDatum $ V.toList a+  parseDatum _ = mempty++instance FromDatum ZonedTime where+  parseDatum (Time t) = return t+  parseDatum _ = mempty++instance FromDatum UTCTime where+  parseDatum (Time t) = return $ zonedTimeToUTC t+  parseDatum _ = mempty++instance FromDatum a => FromDatum (Vector a) where  +  parseDatum (Array v) = fmap V.fromList . mapM parseDatum $ V.toList v+  parseDatum _ = mempty++instance FromDatum Float+instance FromDatum String+instance FromDatum Int+instance FromDatum Int8+instance FromDatum Int16+instance FromDatum Int32+instance FromDatum Int64+instance FromDatum Word+instance FromDatum Word8+instance FromDatum Word16+instance FromDatum Word32+instance FromDatum Word64+instance FromDatum Double+instance FromDatum Bool+instance FromDatum J.Value+instance FromDatum Char+instance FromDatum Integer+instance FromDatum LT.Text+instance FromDatum ST.Text+instance FromDatum (Ratio Integer)++type Array = Vector Datum+type Object = HM.HashMap ST.Text Datum+type Line = Vector LonLat+type Polygon = Vector (Vector LonLat)++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+  String a == String b = a == b+  Number a == Number b = a == b+  Array a == Array b = a == b+  Object a == Object b = a == b+  Time a == Time b = zonedTimeToUTC a == zonedTimeToUTC b+  Point a == Point b = a == b+  Line a == Line b = a == b+  Polygon a == Polygon b = a == b+  Binary a == Binary b = a == b+  _ == _ = 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++instance Show Datum where+  show Null = "null"+  show (Bool True) = "true"+  show (Bool False) = "false"+  show (Number d) = showDouble d+  show (String t) = show t+  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 (Binary b) = "Binary<" ++ show b ++ ">"++showDouble :: Double -> String+showDouble d = let s = show d in if ".0" `isSuffixOf` s then init (init s) else s++fromDatum :: FromDatum a => Datum -> Result a+fromDatum = parse parseDatum++class ToDatum a where+  toDatum :: a -> Datum+  default toDatum :: ToJSON a => a -> Datum+  toDatum = toJSONDatum++instance ToDatum a => ToDatum [a] where+  toDatum = Array . V.fromList . map toDatum++instance ToDatum a => ToDatum (V.Vector a) where+  toDatum = Array . V.map toDatum++instance ToDatum Datum where+  toDatum = id++instance ToDatum () where+  toDatum _ = Array $ V.empty++instance (ToDatum a, ToDatum b) => ToDatum (a, b) where+  toDatum (a, b) = Array $ V.fromList [toDatum a, toDatum b]++instance (ToDatum a, ToDatum b, ToDatum c) => ToDatum (a, b, c) where+  toDatum (a, b, c) = Array $ V.fromList [toDatum a, toDatum b, toDatum c]++instance (ToDatum a, ToDatum b, ToDatum c, ToDatum d) => ToDatum (a, b, c, d) where+  toDatum (a, b, c, d) = Array $ V.fromList [toDatum a, toDatum b, toDatum c, toDatum d]++instance (ToDatum a, ToDatum b, ToDatum c, ToDatum d, ToDatum e) => ToDatum (a, b, c, d, e) where+  toDatum (a, b, c, d, e) = Array $ V.fromList [toDatum a, toDatum b, toDatum c, toDatum d, toDatum e]++instance ToDatum a => ToDatum (HM.HashMap ST.Text a) where+  toDatum = Object . HM.map toDatum++instance ToDatum a => ToDatum (HM.HashMap [Char] a) where+  toDatum = Object . HM.fromList . map (\(k, v) -> (ST.pack k, toDatum v)) . HM.toList++instance ToDatum a => ToDatum (Map.Map ST.Text a) where+  toDatum = Object . HM.fromList . Map.toList . Map.map toDatum++instance ToDatum a => ToDatum (Map.Map [Char] a) where+  toDatum = Object . HM.fromList . map (\(k, v) -> (ST.pack k, toDatum v)) . Map.toList++instance ToDatum ZonedTime where+  toDatum = Time++instance ToDatum UTCTime where+  toDatum = Time . utcToZonedTime utc++instance (ToDatum a, ToDatum b) => ToDatum (Either a b) where+  toDatum (Left a) = Object $ HM.fromList [("Left", toDatum a)]+  toDatum (Right b) = Object $ HM.fromList [("Right", toDatum b)]++instance ToDatum LB.ByteString where+  toDatum = Binary . LB.toStrict++instance ToDatum SB.ByteString where+  toDatum = Binary++instance ToDatum a => ToDatum (Maybe a) where+  toDatum Nothing = Null+  toDatum (Just a) = toDatum a++instance ToDatum a => ToDatum (Set.Set a) where+  toDatum = Array . V.fromList . map toDatum . Set.toList++instance ToDatum Value+instance ToDatum Int+instance ToDatum Int8+instance ToDatum Int16+instance ToDatum Int32+instance ToDatum Int64+instance ToDatum Word+instance ToDatum Word8+instance ToDatum Word16+instance ToDatum Word32+instance ToDatum Word64+instance ToDatum Char+instance ToDatum [Char]+instance ToDatum Integer+instance ToDatum ST.Text+instance ToDatum LT.Text+instance ToDatum Bool+instance ToDatum Double+instance ToDatum Float+instance ToDatum (Ratio Integer)++toJSONDatum :: ToJSON a => a -> Datum+toJSONDatum a = case toJSON a of+  J.Object o ->+    let asObject = Object $ HM.map toJSONDatum o+        ptype = HM.lookup "$reql_type$" o+    in case ptype of+      Just "GEOMETRY" |+        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+            _ -> asObject+      Just "TIME" |+        Just (J.Number ts) <- HM.lookup "epoch_time" o,+        Just (J.String tz) <- HM.lookup "timezone" o,+        Just tz' <- parseTimeZone (ST.unpack tz) ->+          Time $ utcToZonedTime tz' (posixSecondsToUTCTime . fromRational . toRational $ ts)+      Just "BINARY" |+        Just (J.String b64) <- HM.lookup "data" o,+        Right dat <- Base64.decode (encodeUtf8 b64) ->+         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)++instance J.FromJSON Datum where+  parseJSON = return . toJSONDatum++instance ToJSON Datum where+  toJSON Null = J.Null+  toJSON (Bool b) = J.Bool b+  toJSON (Number d) = J.Number $ realToFrac d+  toJSON (String t) = J.String t+  toJSON (Array v) = J.Array $ V.map toJSON v+  toJSON (Object o) = J.Object $ HM.map toJSON o+  toJSON (Time ts@(ZonedTime _ tz)) = J.object [+    "$reql_type$" J..= ("TIME" :: ST.Text),+    "epoch_time" J..= (realToFrac (utcTimeToPOSIXSeconds (zonedTimeToUTC ts)) :: Double),+    "timezone" J..= timeZoneOffsetString tz]+  toJSON (Point p) = J.object [+    "$reql_type$" J..= ("GEOMETRY" :: ST.Text),+    "type" J..= ("Point" :: ST.Text),+    "coordinates" J..= toJSON p]+  toJSON (Line l) = J.object [+    "$reql_type$" J..= ("GEOMETRY" :: ST.Text),+    "type" J..= ("LineString" :: ST.Text),+    "coordinates" J..= toJSON l]+  toJSON (Polygon p) = J.object [+    "$reql_type$" J..= ("GEOMETRY" :: ST.Text),+    "type" J..= ("Polygon" :: ST.Text),+    "coordinates" J..= toJSON p]+  toJSON (Binary b) = J.object [+    "$reql_type$" J..= ("BINARY" :: ST.Text),+    "data" J..= Char8.unpack (Base64.encode b)]+  ++parseTimeZone :: String -> Maybe TimeZone+parseTimeZone "Z" = Just utc+parseTimeZone tz = minutesToTimeZone <$> case tz of +  ('-':tz') -> negate <$> go tz'+  ('+':tz') -> go tz'+  _ -> go tz+  where+    go tz' =+        let (h, _:m) = break (==':') tz' in+        case (reads h, reads m) of+            ([(hh, "")], [(mm, "")]) -> Just $ hh * 60 + mm+            _ -> Nothing++-- ReQL datums are compared alphabetically by type name. Objects are+-- compared field by field in alphabetical order.+instance Ord Datum where+  compare (Object a) (Object b) =+        compare (sort $ HM.keys a) (sort $ HM.keys b) <>+        mconcat (map (\k -> (a HM.! k) `compare` (b HM.! k) ) (sort $ HM.keys a))+  compare (Array a) (Array b) = compare a b+  compare (String a) (String b) = compare a b+  compare (Number a) (Number b) = compare a b+  compare (Bool a) (Bool b) = compare a b+  compare Null Null = EQ+  compare (Time a) (Time b) = zonedTimeToUTC a `compare` zonedTimeToUTC b+  compare (Point a) (Point b) = compare a b+  compare (Line a) (Line b) = compare a b+  compare (Polygon a) (Polygon b) = compare a b+  compare (Binary a) (Binary b) = compare a b+  compare Array{} _ = LT+  compare _ Array{} = GT+  compare Bool{} _ = LT+  compare _ Bool{} = GT+  compare Null _ = LT+  compare _ Null = GT+  compare Number{} _ = LT+  compare _ Number{} = GT+  compare Object{} _ = LT+  compare _ Object{} = GT+  compare Binary{} _ = LT+  compare _ Binary{} = GT+  compare Polygon{} _ = LT+  compare _ Polygon{} = GT+  compare Line{} _ = LT+  compare _ Line{} = GT+  compare Point{} _ = LT+  compare _ Point{} = GT+  compare Time{} _ = LT+  compare _ Time{} = GT++(.=) :: ToDatum a => ST.Text -> a -> (ST.Text, Datum)+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++(.:?) :: FromDatum a => HM.HashMap ST.Text Datum -> ST.Text -> Parser (Maybe a)+o .:? k = maybe (return Nothing) (fmap Just . parseDatum) $ HM.lookup k o++encode :: ToDatum a => a -> LB.ByteString+encode = J.encode . toDatum++decode :: FromDatum a => LB.ByteString -> Maybe a+decode = resultToMaybe . fromDatum <=< J.decode++eitherDecode :: FromDatum a => LB.ByteString -> Either String a+eitherDecode b = resultToEither . fromDatum =<< J.eitherDecode b++resultToMaybe :: Result a -> Maybe a+resultToMaybe (Success a) = Just a+resultToMaybe (Error _) = Nothing++resultToEither :: Result a -> Either String a+resultToEither (Success a) = Right a+resultToEither (Error s) = Left s++object :: [(ST.Text, Datum)] -> Datum+object = Object . HM.fromList
Database/RethinkDB/Driver.hs view
@@ -1,102 +1,285 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, FlexibleInstances, DefaultSignatures #-}  module Database.RethinkDB.Driver (   run,   run',   Result(..),   runOpts,-  RunOptions(..),+  RunFlag(..),   WriteResponse(..),-  JSON(..)+  Change(..),+  getSingle   ) where -import Data.Aeson (Value(..), FromJSON(..), fromJSON, (.:), (.:?), encode)-import Data.Aeson.Encode (fromValue)-import Data.Text.Lazy (unpack)-import Data.Text.Lazy.Builder (toLazyText)-import qualified Data.Aeson (Result(Error, Success))+import qualified Data.Aeson as J import Control.Monad import Control.Concurrent.MVar (MVar, takeMVar)-import Data.Sequence ((|>)) import Data.Text (Text) import Control.Applicative ((<$>), (<*>))--import Database.RethinkDB.Protobuf.Ql2.Query (Query(..))-import Database.RethinkDB.Protobuf.Ql2.Query.AssocPair (AssocPair(..))-import Database.RethinkDB.Protobuf.Ql2.Term as Term (Term(..))-import Database.RethinkDB.Protobuf.Ql2.Term.TermType (TermType(DATUM))-import Database.RethinkDB.Protobuf.Ql2.Datum as Datum-import Database.RethinkDB.Protobuf.Ql2.Datum.DatumType-import Text.ProtocolBuffers.Basic (uFromString, defaultValue)+import Data.List+import Data.Maybe+import Control.Exception (throwIO)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Data.Time+import qualified Data.Text as ST+import qualified Data.Text.Lazy as LT+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import Data.Int+import Data.Word+import qualified Data.HashMap.Strict as HM+import Data.Ratio+import qualified Data.Vector as V +import Database.RethinkDB.Datum hiding (Result) import Database.RethinkDB.Network import Database.RethinkDB.ReQL  -- | Per-query settings-data RunOptions =+data RunFlag =   UseOutdated |   NoReply |-  SoftDurability Bool+  Durability Durability |+  Profile |+  ArrayLimit Int -applyOption :: RunOptions -> Query -> Query-applyOption UseOutdated q = addQueryOption q "user_outdated" True-applyOption NoReply q = addQueryOption q "noreply" True-applyOption (SoftDurability b) q = addQueryOption q "soft_durability" b+data Durability = Hard | Soft -addQueryOption :: Query -> String -> Bool -> Query-addQueryOption q k v = q {-  global_optargs = global_optargs q |> AssocPair (Just $ uFromString k) (Just boolTrue) }-  where-    boolTrue = defaultValue{-      Term.type' = Just DATUM, datum = Just defaultValue{-         Datum.type' = Just R_BOOL, r_bool = Just v } }+renderOption :: RunFlag -> (Text, Datum)+renderOption UseOutdated = "user_outdated" .= True+renderOption NoReply = "noreply" .= True+renderOption (Durability Soft) = "durability" .= ("soft" :: String)+renderOption (Durability Hard) = "durability" .= ("hard" :: String)+renderOption Profile = "profile" .= True+renderOption (ArrayLimit n) = "array_limit" .= n  -- | Run a query with the given options-runOpts :: (Expr query, Result r) => RethinkDBHandle -> [RunOptions] -> query -> IO r+runOpts :: (Expr query, Result r) => RethinkDBHandle -> [RunFlag] -> query -> IO r runOpts h opts t = do-  let (q, bt) = buildQuery (expr t) 0 (rdbDatabase h)-  let q' = foldr (fmap . applyOption) id opts q-  r <- runQLQuery h q' bt+  let (q, bt) = buildQuery (expr t) 0 (rdbDatabase h) (map renderOption opts)+  r <- runQLQuery h q bt   convertResult r  -- | Run a given query and return a Result run :: (Expr query, Result r) => RethinkDBHandle -> query -> IO r run h = runOpts h [] --- | Run a given query and return a JSON-run' :: Expr query => RethinkDBHandle -> query -> IO [JSON]-run' h t = do-  c <- run h t-  collect c+-- | Run a given query and return a Datum+run' :: Expr query => RethinkDBHandle -> query -> IO Datum+run' = run  -- | Convert the raw query response into useful values class Result r where   convertResult :: MVar Response -> IO r+  default convertResult :: FromDatum a => MVar Response -> IO a+  convertResult = unsafeFromDatum <=< convertResult  instance Result Response where-    convertResult = takeMVar+  convertResult = takeMVar -instance FromJSON a => Result (Cursor a) where-  convertResult r = fmap (fmap $ unsafe . fromJSON) $ makeCursor r-    where-      unsafe (Data.Aeson.Error e) = error e-      unsafe (Data.Aeson.Success a) = a+instance FromDatum a => Result (Cursor a) where+  convertResult r = do+    c <- makeCursor r +    return c { cursorMap = unsafeFromDatum } -instance FromJSON a => Result [a] where+unsafeFromDatum :: FromDatum a => Datum -> IO a+unsafeFromDatum val = case fromDatum val of+  Error e -> throwIO (RethinkDBError ErrorUnexpectedResponse (Datum Null) e [])+  Success a -> return a++instance FromDatum a => Result [a] where   convertResult = collect <=< convertResult -instance FromJSON a => Result (Maybe a) where+instance FromDatum a => Result (Maybe a) where+  convertResult v = do+    r <- takeMVar v+    case r of+      ResponseSingle Null -> return Nothing+      ResponseSingle a -> fmap Just $ unsafeFromDatum a+      ResponseError e -> throwIO e+      ResponseBatch Nothing batch -> fmap Just $ unsafeFromDatum $ toDatum batch+      ResponseBatch (Just _more) batch -> do+        rest <- collect' =<< convertResult v+        fmap Just $ unsafeFromDatum $ toDatum $ batch ++ rest++instance Result Int where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Double where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Bool where+  convertResult = unsafeFromDatum <=< getSingle++instance Result String where+  convertResult = unsafeFromDatum <=< getSingle++instance Result () where+  convertResult m = do+    _ <- takeMVar m+    return ()++instance Result J.Value where+  convertResult = unsafeFromDatum <=< convertResult++instance Result Char where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Float where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Int8 where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Int16 where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Int32 where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Int64 where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Word where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Word8 where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Word16 where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Word32 where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Word64 where+  convertResult = unsafeFromDatum <=< getSingle++instance Result Integer where+  convertResult = unsafeFromDatum <=< getSingle++instance Result LB.ByteString where+  convertResult = unsafeFromDatum <=< getSingle++instance Result SB.ByteString where+  convertResult = unsafeFromDatum <=< getSingle++instance Result LT.Text where+  convertResult = unsafeFromDatum <=< getSingle++instance Result ST.Text where+  convertResult = unsafeFromDatum <=< getSingle++instance Result ZonedTime where+  convertResult = unsafeFromDatum <=< getSingle++instance Result UTCTime where+  convertResult = unsafeFromDatum <=< getSingle++instance (Ord a, FromDatum a) => Result (Set.Set a) where+  convertResult = fmap Set.fromList . convertResult++instance FromDatum a => Result (V.Vector a) where+  convertResult = unsafeFromDatum <=< convertResult++instance (FromDatum a, FromDatum b) => Result (Either a b) where+  convertResult = unsafeFromDatum <=< getSingle++instance FromDatum a => Result (HM.HashMap [Char] a) where+  convertResult = unsafeFromDatum <=< getSingle++instance FromDatum a => Result (HM.HashMap ST.Text a) where+  convertResult = unsafeFromDatum <=< getSingle++instance FromDatum a => Result (Map.Map [Char] a) where+  convertResult = unsafeFromDatum <=< getSingle++instance FromDatum a => Result (Map.Map ST.Text a) where+  convertResult = unsafeFromDatum <=< getSingle++instance Result (Ratio Integer) where+  convertResult = unsafeFromDatum <=< getSingle++nextFail :: FromDatum a => Cursor Datum -> IO a+nextFail c = do+  x <- next c+  case x of+    Nothing -> throwIO $ RethinkDBError ErrorUnexpectedResponse (Datum Null) "Not enough data" []+    Just a -> case fromDatum a of+      Success b -> return b+      Error e -> throwIO $ RethinkDBError ErrorUnexpectedResponse (Datum Null) e []++assertEnd :: Cursor a -> IO ()+assertEnd c = do+  x <- next c+  case x of+    Nothing -> return ()+    Just _ -> throwIO $ RethinkDBError ErrorUnexpectedResponse (Datum Null) "Too much data" []++instance (FromDatum a, FromDatum b) => Result (a, b) where   convertResult r = do     c <- convertResult r-    car <- next c-    case car of-      Nothing -> return Nothing-      Just a -> do-        cadr <- next c-        case cadr of-          Nothing -> return $ Just a-          Just _ -> return Nothing+    a <- nextFail c+    b <- nextFail c+    assertEnd c+    return (a, b) +instance (FromDatum a, FromDatum b, FromDatum c) => Result (a, b, c) where+  convertResult r = do+    c <- convertResult r+    a <- nextFail c+    b <- nextFail c+    c_ <- nextFail c+    assertEnd c+    return (a, b, c_)++instance (FromDatum a, FromDatum b, FromDatum c, FromDatum d) => Result (a, b, c, d) where+  convertResult r = do+    c <- convertResult r+    a <- nextFail c+    b <- nextFail c+    c_ <- nextFail c+    d <- nextFail c+    assertEnd c+    return (a, b, c_, d)++instance (FromDatum a, FromDatum b, FromDatum c, FromDatum d, FromDatum e) => Result (a, b, c, d, e) where+  convertResult r = do+    c <- convertResult r+    a <- nextFail c+    b <- nextFail c+    c_ <- nextFail c+    d <- nextFail c+    e <- nextFail c+    assertEnd c+    return (a, b, c_, d, e)++getSingle :: MVar Response -> IO Datum+getSingle v = do+    r <- takeMVar v+    case r of+      ResponseSingle datum -> return datum+      ResponseError e -> throwIO e+      ResponseBatch Nothing [datum] -> return datum+      ResponseBatch _ batch ->+        throwIO $ RethinkDBError ErrorUnexpectedResponse (Datum Null)+        ("Expected a single datum but got: " ++ show batch) []++instance Result Datum where+  convertResult v = do+    r <- takeMVar v+    case r of+      ResponseSingle datum -> return datum+      ResponseError e -> throwIO e+      ResponseBatch Nothing batch -> return $ toDatum batch+      ResponseBatch (Just _more) batch -> do+        rest <- collect' =<< convertResult v+        return . toDatum $ batch ++ rest++instance Result WriteResponse where+  convertResult = unsafeFromDatum <=< convertResult+ data WriteResponse = WriteResponse {   writeResponseInserted :: Int,   writeResponseDeleted :: Int,@@ -106,12 +289,21 @@   writeResponseErrors :: Int,   writeResponseFirstError :: Maybe Text,   writeResponseGeneratedKeys :: Maybe [Text],-  writeResponseOldVal :: Maybe Value,-  writeResponseNewVal :: Maybe Value-  } deriving Show+  writeResponseChanges :: Maybe [Change]+  } -instance FromJSON WriteResponse where-  parseJSON (Data.Aeson.Object o) =+data Change = Change { oldVal, newVal :: Datum }++instance Show Change where+  show (Change old new) = "{\"old_val\":" ++ show old ++ ",\"new_val\":" ++ show new ++ "}"++instance FromDatum Change where+  parseDatum (Object o) =+    Change <$> o .: "old_val" <*> o .: "new_val"+  parseDatum _ = mzero++instance FromDatum WriteResponse where+  parseDatum (Object o) =     WriteResponse     <$> o .: "inserted"     <*> o .: "deleted"@@ -121,14 +313,25 @@     <*> o .: "errors"     <*> o .:? "first_error"     <*> o .:? "generated_keys"-    <*> o .:? "old_val"-    <*> o .:? "new_val"-  parseJSON _ = mzero--data JSON = JSON Value+    <*> o .:? "changes"+  parseDatum _ = mzero -instance Show JSON where-  show (JSON a) = unpack . toLazyText . fromValue $ a+instance Show WriteResponse where+  show wr = "{" +++            intercalate "," (catMaybes [+              zero "inserted" writeResponseInserted,+              zero "deleted" writeResponseDeleted,+              zero "replaced" writeResponseReplaced,+              zero "unchanged" writeResponseUnchanged,+              zero "skipped" writeResponseSkipped,+              zero "errors" writeResponseErrors,+              nothing "first_error" writeResponseFirstError,+              nothing "generated_keys" writeResponseGeneratedKeys,+              nothing "changes" writeResponseChanges ]) +++            "}"+    where+      go k v = Just $ k ++ ":" ++ show v+      zero k f = if f wr == 0 then Nothing else go k (f wr)+      nothing k f = maybe Nothing (go k) (f wr) -instance FromJSON JSON where-  parseJSON = fmap JSON . parseJSON+-- TODO: profile
Database/RethinkDB/Functions.hs view
@@ -1,761 +1,1039 @@ {-# LANGUAGE FlexibleInstances, OverloadedStrings, GADTs #-} --- TODO: operator fixity---- | Functions from the ReQL (RethinkDB Query Language)--module Database.RethinkDB.Functions where--import Data.Text (Text)-import Control.Monad.State-import Control.Applicative-import Data.Maybe--import Database.RethinkDB.ReQL-import Database.RethinkDB.MapReduce-import Database.RethinkDB.Objects as O--import Database.RethinkDB.Protobuf.Ql2.Term.TermType--import Prelude (($), return, Double, Bool, String)-import qualified Prelude as P--infixl 6 +, --infixl 7 *, /---- | Addition or concatenation------ Use the Num instance, or a qualified operator.------ > >>> run h $ 2 + 5 :: IO (Maybe Int)--- > Just 7--- > >>> run h $ 2 R.+ 5 :: IO (Maybe Int)--- > Just 7--- > >>> run h $ (str "foo") + (str "bar") :: IO (Just String)--- > Just "foobar"-(+) :: (Expr a, Expr b) => a -> b -> ReQL-(+) a b = op ADD (a, b) ()---- | Subtraction------ > >>> run h $ 2 - 5 :: IO (Maybe Int)--- > Just (-3)-(-) :: (Expr a, Expr b) => a -> b -> ReQL-(-) a b = op SUB (a, b) ()---- | Multiplication------ > >>> run h $ 2 * 5 :: IO (Maybe Int)--- > Just 10-(*) :: (Expr a, Expr b) => a -> b -> ReQL-(*) a b = op MUL (a, b) ()---- | Division------ > >>> run h $ 2 R./ 5 :: IO (Maybe Double)--- > Just 0.4-(/) :: (Expr a, Expr b) => a -> b -> ReQL-(/) a b = op DIV (a, b) ()---- | Mod------ > >>> run h $ 5 `mod` 2 :: IO (Maybe Int)--- > Just 1-mod :: (Expr a, Expr b) => a -> b -> ReQL-mod a b = op MOD (a, b) ()--infixr 2 ||-infixr 3 &&---- | Boolean or------ > >>> run h $ True R.|| False :: IO (Maybe Bool)--- > Just True-(||) :: (Expr a, Expr b) => a -> b -> ReQL-a || b = op ANY (a, b) ()---- | Boolean and------ > >>> run h $ True R.&& False :: IO (Maybe Bool)--- > Just False-(&&) :: (Expr a, Expr b) => a -> b -> ReQL-a && b = op ALL (a, b) ()--infix 4 ==, /=---- | Test for equality------ > >>> run h $ obj ["a" := 1] R.== obj ["a" := 1] :: IO (Maybe Bool)--- > Just True-(==) :: (Expr a, Expr b) => a -> b -> ReQL-a == b = op EQ (a, b) ()---- | Test for inequality------ > >>> run h $ 1 R./= False :: IO (Maybe Bool)--- > Just True-(/=) :: (Expr a, Expr b) => a -> b -> ReQL-a /= b = op NE (a, b) ()--infix 4 >, <, <=, >=---- | Greater than------ > >>> run h $ 3 R.> 2 :: IO (Maybe Bool)--- > Just True-(>) :: (Expr a, Expr b) => a -> b -> ReQL-a > b = op GT (a, b) ()---- | Lesser than------ > >>> run h $ (str "a") R.< (str "b") :: IO (Maybe Bool)--- > Just True-(<) :: (Expr a, Expr b) => a -> b -> ReQL-a < b = op LT (a, b) ()---- | Greater than or equal to------ > >>> run h $ [1] R.>= () :: IO (Maybe Bool)--- > Just False-(>=) :: (Expr a, Expr b) => a -> b -> ReQL-a >= b = op GE (a, b) ()---- | Lesser than or equal to------ > >>> run h $ 2 R.<= 2 :: IO (Maybe Bool)--- > Just True-(<=) :: (Expr a, Expr b) => a -> b -> ReQL-a <= b = op LE (a, b) ()---- | Negation------ > >>> run h $ R.not False :: IO (Maybe Bool)--- > Just True--- > >>> run h $ R.not () :: IO (Maybe Bool)--- > Just True-not :: (Expr a) => a -> ReQL-not a = op NOT [a] ()---- * Lists and Streams---- | The size of a sequence or an array.------ Called /count/ in the official drivers------ > >>> run h $ R.length (table "foo") :: IO (Maybe Int)--- > Just 17-length :: (Expr a) => a -> ReQL-length e = op COUNT [e] ()--infixr 5 ++---- | Join two sequences.------ Called /union/ in the official drivers------ > >>> run h $ [1,2,3] R.++ ["a", "b", "c" :: Text] :: IO (Maybe [JSON])--- > Just [1.0,2.0,3.0,"a","b","c"]-(++) :: (Expr a, Expr b) => a -> b -> ReQL-a ++ b = op UNION (a, b) ()---- | Map a function over a sequence------ > >>> run h $ R.map (!"a") [obj ["a" := 1], obj ["a" := 2]] :: IO (Maybe [Int])--- > Just [1,2]-map :: (Expr a, Expr b) => (ReQL -> b) -> a -> ReQL-map f a = op MAP (a, expr P.. f) ()---- | Filter a sequence given a predicate------ > >>> run h $ R.filter (R.< 4) [3, 1, 4, 1, 5, 9, 2, 6] :: IO (Maybe [Int])--- > Just [3,1,1,2]-filter :: (Expr predicate, Expr seq) => predicate -> seq -> ReQL-filter f a = op FILTER (a, f) ()---- | Query all the documents whose value for the given index is in a given range------ > >>> run h $ table "users" # between "id" (Closed $ str "a") (Open $ str "n") :: IO [JSON]--- > [{"post_count":4.0,"name":"bob","id":"b6a9df6a-b92c-46d1-ae43-1d2dd8ec293c"},{"post_count":4.0,"name":"bill","id":"b2908215-1d3c-4ff5-b9ee-1a003fa9690c"}]-between :: (Expr left, Expr right, Expr seq) => Key -> Bound left -> Bound right -> seq -> ReQL-between i a b e =-  op BETWEEN [expr e, expr $ getBound a, expr $ getBound b]-         ["left_bound" := closedOrOpen a, "right_bound" := closedOrOpen b, "index" := i]---- | Append a datum to a sequence------ > >>> run h $ append 3 [1, 2] :: IO (Maybe [Int])--- > Just [1,2,3]-append :: (Expr a, Expr b) => a -> b -> ReQL-append a b = op APPEND (b, a) ()---- | Map a function of a sequence and concat the results------ > >>> run h $ concatMap id [[1, 2], [3], [4, 5]] :: IO (Maybe [Int])--- > Just [1,2,3,4,5]-concatMap :: (Expr a, Expr b) => (ReQL -> b) -> a -> ReQL-concatMap f e = op CONCATMAP (e, expr P.. f) ()---- | SQL-like inner join of two sequences------ > >>> run' h $ innerJoin (\user post -> user!"id" R.== post!"author") (table "users") (table "posts") # mergeLeftRight # without ["id", "author"]--- > [[{"name":"bob","message":"lorem ipsum"},{"name":"bill","message":"hello"},{"name":"bill","message":"hi"}]]-innerJoin :: (Expr a, Expr b, Expr c) => (ReQL -> ReQL -> c) -> a -> b -> ReQL-innerJoin f a b = op INNER_JOIN (a, b, fmap expr P.. f) ()---- | SQL-like outer join of two sequences------ > >>> run' h $ outerJoin (\user post -> user!"id" R.== post!"author") (table "users") (table "posts") # mergeLeftRight # without ["id", "author"]--- > [[{"name":"nancy"},{"name":"bill","message":"hello"},{"name":"bill","message":"hi"},{"name":"bob","message":"lorem ipsum"}]]-outerJoin :: (Expr a, Expr b, Expr c) => (ReQL -> ReQL -> c) -> a -> b -> ReQL-outerJoin f a b = op OUTER_JOIN (a, b, fmap expr P.. f) ()---- | An efficient inner_join that uses a key for the left table and an index for the right table.------ > >>> run' h $ table "posts" # eqJoin "author" (table "users") "id" # mergeLeftRight # without ["id", "author"]--- > [[{"name":"bill","message":"hi"},{"name":"bob","message":"lorem ipsum"},{"name":"bill","message":"hello"}]]-eqJoin :: (Expr right, Expr left) => Key -> right -> Key -> left -> ReQL-eqJoin key right index left = op EQ_JOIN (left, key, right) ["index" := index]---- | Drop elements from the head of a sequence.------ Called /skip/ in the official drivers------ > >>> run h $ R.drop 2 [1, 2, 3, 4] :: IO (Maybe [Int])--- > Just [3,4]-drop :: (Expr a, Expr b) => a -> b -> ReQL-drop a b = op SKIP (b, a) ()---- | Limit the size of a sequence.------ Called /limit/ in the official drivers------ > >>> run h $ R.take 2 [1, 2, 3, 4] :: IO (Maybe [Int])--- > Just [1,2]-take :: (Expr n, Expr seq) => n -> seq -> ReQL-take n s = op LIMIT (s, n) ()---- | Cut out part of a sequence------ > >>> run h $ slice 2 4 [1, 2, 3, 4, 5] :: IO (Maybe [Int])--- > Just [3,4]-slice :: (Expr a, Expr b, Expr c) => a -> b -> c -> ReQL-slice n m s = op SLICE (s, n, m) ()--infixl 9 !!---- | Get the nth value of a sequence or array------ > >>> run h $ [1, 2, 3] !! 0 :: IO (Maybe Int)--- > Just 1-(!!) :: (Expr a) => a -> ReQL -> ReQL-s !! n = op NTH (s, n) ()---- | Reduce a sequence to a single value------ > >>> run h $ reduce (+) 0 [1, 2, 3] :: IO (Maybe Int)--- > Just 6-reduce :: (Expr base, Expr seq, Expr a) => (ReQL -> ReQL -> a) -> base -> seq -> ReQL-reduce f b s = op REDUCE (s, fmap expr P.. f) ["base" := b]---- | Reduce a non-empty sequence to a single value------ > >>> run h $ reduce1 (+) [1, 2, 3] :: IO (Maybe Int)--- > Just 6-reduce1 :: (Expr a, Expr s) => (ReQL -> ReQL -> a) -> s -> ReQL-reduce1 f s = op REDUCE (s, fmap expr P.. f) ()---- | Filter out identical elements of the sequence------ Called /distint/ in the official drivers------ > >>> run h $ nub (table "posts" ! "flag") :: IO (Maybe [String])--- > Just ["pinned", "deleted"]-nub :: (Expr s) => s -> ReQL-nub s = op DISTINCT [s] ()---- | Like map but for write queries------ > >>> run' h $ table "users" # replace (without ["post_count"])--- > >>> run' h $ forEach (table "posts") $ \post -> table "users" # get (post!"author") # update (\user -> obj ["post_count" := (handle 0 (user!"post_count") + 1)])--- > [{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":0.0,"replaced":3.0,"errors":0.0}]-forEach :: (Expr s, Expr a) => s -> (ReQL -> a) -> ReQL-forEach s f = op FOREACH (s, expr P.. f) ()---- | Merge the "left" and "right" attributes of the objects in a sequence.------ Called /zip/ in the official drivers------ > >>> run' h $ table "posts" # eqJoin "author" (table "users") "id" # mergeLeftRight-mergeLeftRight :: (Expr a) => a -> ReQL-mergeLeftRight a = op ZIP [a] ()---- | Ordering specification for orderBy-data Order =-  Asc { orderAttr :: Key } -- ^ Ascending order-  | Desc { orderAttr :: Key } -- ^ Descending order---- | Order a sequence by the given keys------ > >>> run' h $ table "users" # orderBy [Desc "post_count", Asc "name"] # pluck ["name", "post_count"]--- > [[{"post_count":2.0,"name":"bill"},{"post_count":1.0,"name":"bob"},{"name":"nancy"}]]-orderBy :: (Expr s) => [Order] -> s -> ReQL-orderBy o s = ReQL $ do-  s' <- baseReQL (expr s)-  o' <- baseArray $ arr $ P.map buildOrder o-  return $ BaseReQL ORDERBY P.Nothing (s' : o') []-  where-    buildOrder (Asc k) = op ASC [k] ()-    buildOrder (Desc k) = op DESC [k] ()---- | Turn a grouping function and a reduction function into a grouped map reduce operation------ > >>> run' h $ table "posts" # groupBy (!"author") (reduce1 (\a b -> a + "\n" + b) . R.map (!"message"))-    -- > [[{"group":"b2908215-1d3c-4ff5-b9ee-1a003fa9690c","reduction":"hi\nhello"},{"group":"b6a9df6a-b92c-46d1-ae43-1d2dd8ec293c","reduction":"lorem ipsum"}]]--- > >>> run' h $ table "users" # groupBy (!"level") (\users -> let pc = users!"post_count" in [avg pc, R.sum pc])--- > [[{"group":1,"reduction":[1.5,3.0]},{"group":2,"reduction":[0.0,0.0]}]]-groupBy ::-  (Expr group, Expr reduction, Expr seq)-  => (ReQL -> group) -> (ReQL -> reduction) -> seq -> ReQL-groupBy g mr s = ReQL $ do-  (m, r, mf) <- termToMapReduce (expr . mr)-  let gmr = op GROUPED_MAP_REDUCE [expr s, expr $ expr P.. g, expr m, expr r] ()-  baseReQL $ case mf of-    Nothing -> gmr-    Just f -> op MAP [gmr, expr $ \x -> expr $-                      obj ["group" := (x!"group"), "reduction" := f (x!"reduction")]] ()---- | The sum of a sequence------ > >>> run h $ sum [1, 2, 3] :: IO (Maybe Int)--- > Just 6-sum :: (Expr s) => s -> ReQL-sum = reduce ((+) :: ReQL -> ReQL -> ReQL) (num 0)---- | The average of a sequence------ > >>> run h $ avg [1, 2, 3, 4] :: IO (Maybe Double)--- > Just 2.5-avg :: (Expr s) => s -> ReQL-avg = (\x -> (x!!0) / (x!!1)) .-  reduce (\a b -> [(a!!0) + (b!!0), (a!!1) + (b!!1)]) [num 0, num 0] .-  map (\x -> [x, 1])---- * Accessors--infixl 9 !---- | Get a single field from an object------ > >>> run h $ (obj ["foo" := True]) ! "foo" :: IO (Maybe Bool)--- > Just True------ Or a single field from each object in a sequence------ > >>> run h $ [obj ["foo" := True], obj ["foo" := False]] ! "foo" :: IO (Maybe [Bool])--- > Just [True,False]-(!) :: (Expr s) => s -> ReQL -> ReQL-s ! k = op GET_FIELD (s, k) ()---- | Keep only the given attributes------ > >>> run' h $ map obj [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # pluck ["a"]--- > [[{"a":1.0},{"a":2.0},{}]]-pluck :: (Expr o) => [ReQL] -> o -> ReQL-pluck ks e = op PLUCK (cons e $ arr (P.map expr ks)) ()---- | Remove the given attributes from an object------ > >>> run' h $ map obj [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # without ["a"]--- > [[{"b":2.0},{"c":7.0},{"b":4.0}]]-without :: (Expr o) => [ReQL] -> o -> ReQL-without ks e = op WITHOUT (cons e $ arr (P.map expr ks)) ()---- | Test if a sequence contains a given element------ > >>> run' h $ 1 `R.elem` [1,2,3]--- > [true]-elem :: (Expr x, Expr seq) => x -> seq -> ReQL-elem x s = op CONTAINS (s, x) ()---- | Merge two objects together------ > >>> run' h $ merge (obj ["a" := 1, "b" := 1]) (obj ["b" := 2, "c" := 2])--- > [{"a":1.0,"b":2.0,"c":2.0}]-merge :: (Expr a, Expr b) => a -> b -> ReQL-merge a b = op MERGE (a, b) ()---- | Evaluate a JavaScript expression------ > >>> run h $ js "Math.random()" :: IO (Maybe Double)--- > Just 0.9119815775193274--- > >>> run h $ R.map (\x -> js "Math.sin" `apply` [x]) [pi, pi/2] :: IO (Maybe [Double])--- > Just [1.2246063538223773e-16,1.0]-js :: ReQL -> ReQL-js s = op JAVASCRIPT [s] ()---- | Called /branch/ in the official drivers------ > >>> run h $ if' (1 R.< 2) 3 4 :: IO (Maybe Int)--- > Just 3-if' :: (Expr a, Expr b, Expr c) => a -> b -> c -> ReQL-if' a b c = op BRANCH (a, b, c) ()---- | Abort the query with an error------ > >>> run' h $ R.error (str "haha") R./ 2 + 1--- > *** Exception: RethinkDBError {errorCode = runtime error, errorTerm = ADD(DIV(ERROR("haha"), 2.0), 1.0), errorMessage = "haha", errorBacktrace = [0,0]}-error :: (Expr s) => s -> ReQL-error m = op ERROR [m] ()---- | Create a Database reference------ > >>> run' h $ db "test" # info--- > [{"name":"test","type":"DB"}]-db :: Text -> O.Database-db s = O.Database s---- | Create a database on the server------ > >>> run' h $ dbCreate "dev"--- > [{"created":1.0}]-dbCreate :: P.String -> ReQL-dbCreate db_name = op DB_CREATE [str db_name] ()---- | Drop a database------ > >>> run' h $ dbDrop (db "dev")--- > [{"dropped":1.0}]-dbDrop :: Database -> ReQL-dbDrop (O.Database name) = op DB_DROP [name] ()---- | List the databases on the server------ > >>> run h $ dbList :: IO (Maybe [String])--- > Just ["test"]-dbList :: ReQL-dbList = op DB_LIST () ()---- | Create an index on the table from the given function------ > >>> run' h $ table "users" # indexCreate "name" (!"name") def--- > [{"created":1.0}]-indexCreate :: (Expr fun) => P.String -> fun -> IndexCreateOptions -> Table -> ReQL-indexCreate name f opts tbl = op INDEX_CREATE (tbl, str name, f) $ catMaybes [-  ("multi" :=) <$> indexMulti opts]---- | Drop an index------ > >>> run' h $ table "users" # indexDrop "name"--- > [{"dropped":1.0}]-indexDrop :: Key -> Table -> ReQL-indexDrop name tbl = op INDEX_DROP (tbl, name) ()---- | List the indexes on the table------ > >>> run' h $ indexList (table "users")--- > [["name"]]-indexList :: Table -> ReQL-indexList tbl = op INDEX_LIST [tbl] ()---- | Retreive documents by their indexed value------ > >>> run' h $ table "users" # getAll "name" ["bob"]--- > [{"post_count":1.0,"name":"bob","id":"b6a9df6a-b92c-46d1-ae43-1d2dd8ec293c"}]-getAll :: (Expr value) => Key -> [value] -> Table -> ReQL-getAll idx xs tbl = op GET_ALL (expr tbl : P.map expr xs) ["index" := idx]---- | A table------ > >>> (mapM_ print =<<) $ run' h $ table "users"--- > {"post_count":0.0,"name":"nancy","id":"8d674d7a-873c-4c0f-8a4a-32a4bd5bdee8"}--- > {"post_count":1.0,"name":"bob","id":"b6a9df6a-b92c-46d1-ae43-1d2dd8ec293c"}--- > {"post_count":2.0,"name":"bill","id":"b2908215-1d3c-4ff5-b9ee-1a003fa9690c"}-table :: Text -> Table-table n = O.Table Nothing n Nothing---- | Create a table on the server------ > >>> run' h $ tableCreate (table "posts") def--- > >>> run' h $ tableCreate (table "users") def--- > >>> run' h $ tableCreate (Table (db "prod") "bar" (Just "name")) def{ tableDataCenter = Just "cloud", tableCacheSize = Just 10 }-tableCreate :: Table -> TableCreateOptions -> ReQL-tableCreate (O.Table mdb table_name pkey) opts =-  withQuerySettings $ \QuerySettings{ queryDefaultDatabase = ddb } ->-    op TABLE_CREATE (fromMaybe ddb mdb, table_name) $ catMaybes [-      ("datacenter" :=) <$> tableDataCenter opts,-      ("cache_size" :=) <$> tableCacheSize opts,-      ("primary_key" :=) <$> pkey ]---- | Drop a table------ > >>> run' h $ tableDrop (table "bar")--- > [{"dropped":1.0}]-tableDrop :: Table -> ReQL-tableDrop (O.Table mdb table_name _) =-  withQuerySettings $ \QuerySettings{ queryDefaultDatabase = ddb } ->-    op TABLE_DROP (fromMaybe ddb mdb, table_name) ()---- | List the tables in a database------ > >>> run h $ tableList (db "test") :: IO (Maybe [String])--- > Just ["foo","posts","users"]-tableList :: Database -> ReQL-tableList name = op TABLE_LIST [name] ()---- | Get a document by primary key------ > >>> run' h $ table "users" # get "8d674d7a-873c-4c0f-8a4a-32a4bd5bdee8"--- > [{"post_count":0.0,"name":"nancy","id":"8d674d7a-873c-4c0f-8a4a-32a4bd5bdee8"}]-get :: Expr s => ReQL -> s -> ReQL-get k e = op GET (e, k) ()---- | Insert a document or a list of documents into a table------ > >>> Just wr@WriteResponse{} <- run h $ table "users" # insert (map (\x -> obj ["name":=x]) ["bill", "bob", "nancy" :: Text])--- > >>> let Just [bill, bob, nancy] = writeResponseGeneratedKeys wr--- > >>> run' h $ table "posts" # insert (obj ["author" := bill, "message" := str "hi"])--- > >>> run' h $ table "posts" # insert (obj ["author" := bill, "message" := str "hello"])--- > >>> run' h $ table "posts" # insert (obj ["author" := bob, "message" := str "lorem ipsum"])-insert :: (Expr object) => object -> Table -> ReQL-insert a tb = canReturnVals $ op INSERT (tb, a) ()---- | Like insert, but update existing documents with the same primary key------ > >>> run' h $ table "users" # upsert (obj ["id" := "79bfe377-9593-402a-ad47-f94c76c36a51", "name" := "rupert"])--- > [{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":0.0,"replaced":1.0,"errors":0.0}]-upsert :: (Expr table, Expr object) => object -> table -> ReQL-upsert a tb = canReturnVals $ op INSERT (tb, a) ["upsert" := P.True]---- | Add to or modify the contents of a document------ > >>> run' h $ table "users" # getAll "name" [str "bob"] # update (const $ obj ["name" := str "benjamin"])--- > [{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":0.0,"replaced":1.0,"errors":0.0}]-update :: (Expr selection, Expr a) => (ReQL -> a) -> selection -> ReQL-update f s = canNonAtomic $ canReturnVals $ op UPDATE (s, expr . f) ()---- | Replace a document with another------ > >>> run' h $ replace (\bill -> obj ["name" := str "stoyan", "id" := bill!"id"]) . R.filter ((R.== str "bill") . (!"name")) $ table "users"--- > [{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":0.0,"replaced":1.0,"errors":0.0}]-replace :: (Expr selection, Expr a) => (ReQL -> a) -> selection -> ReQL-replace f s = canNonAtomic $ canReturnVals $ op REPLACE (s, expr . f) ()---- | Delete the documents------ > >>> run' h $ delete . getAll "name" [str "bob"] $ table "users"--- > [{"skipped":0.0,"inserted":0.0,"unchanged":0.0,"deleted":1.0,"replaced":0.0,"errors":0.0}]-delete :: (Expr selection) => selection -> ReQL-delete s = canReturnVals $ op DELETE [s] ()---- | Convert a value to a different type------ > >>> run h $ coerceTo "STRING" 1 :: IO (Maybe String)--- > Just "1"-coerceTo :: (Expr x) => ReQL -> x -> ReQL-coerceTo t a = op COERCE_TO (a, t) ()---- | Convert a value to an array------ > >>> run h $ asArray $ obj ["a" := 1, "b" := 2] :: IO (Maybe [(String, Int)])--- > Just [("a",1),("b",2)]-asArray :: Expr x => x -> ReQL-asArray = coerceTo "ARRAY"---- | Convert a value to a string------ > >>> run h $ asString $ obj ["a" := 1, "b" := 2] :: IO (Maybe String)--- > Just "{\n\t\"a\":\t1,\n\t\"b\":\t2\n}"-asString :: Expr x => x -> ReQL-asString = coerceTo "STRING"---- | Convert a value to a number------ > >>> run h $ asNumber (str "34") :: IO (Maybe Int)--- > Just 34-asNumber :: Expr x => x -> ReQL-asNumber = coerceTo "NUMBER"---- | Convert a value to an object------ > >>> run' h $ asObject $ [(str "a",1),("b",2)]--- > [{"a":1.0,"b":2.0}]-asObject :: Expr x => x -> ReQL-asObject = coerceTo "OBJECT"---- | Convert a value to a boolean-asBool :: Expr x => x -> ReQL-asBool = coerceTo "BOOL"---- | Like hasFields followed by pluck------ > >>> run' h $ map obj [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # withFields ["a"]--- > [[{"a":1.0},{"a":2.0}]]-withFields :: Expr seq => [ReQL] -> seq -> ReQL-withFields p s = op WITH_FIELDS (s, p) ()---- | The position in the sequence of the elements that match the predicate------ > >>> run h $ indexesOf (=~ "ba.") [str "foo", "bar", "baz"] :: IO (Maybe [Int])--- > Just [1,2]-indexesOf :: (Expr fun, Expr seq) => fun -> seq -> ReQL-indexesOf f s = op INDEXES_OF (s, f) ()---- | Test if a sequence is empty------ > >>> run h $ isEmpty [1] :: IO (Maybe Bool)--- > Just False-isEmpty :: Expr seq => seq -> ReQL-isEmpty s = op IS_EMPTY [s] ()---- | Select a given number of elements from a sequence with uniform random distribution------ > >>> run h $ sample 3 [0,1,2,3,4,5,6,7,8,9] :: IO (Maybe [Int])--- > Just [4,3,8]-sample :: (Expr n, Expr seq) => n -> seq -> ReQL-sample n s = op SAMPLE (s, n) ()---- | Prepend an element to an array------ > >>> run h $ prepend 1 [2,3] :: IO (Maybe [Int])--- > Just [1,2,3]-prepend :: (Expr datum, Expr array) => datum -> array -> ReQL-prepend d a = op PREPEND (a, d) ()--infixl 9 \\ ------ | Called /difference/ in the official drivers------ > >>> run h $ [1,2,3,4,5] \\ [2,5] :: IO (Maybe [Int])--- > Just [1,3,4]-(\\) :: (Expr a, Expr b) => a -> b -> ReQL-a \\ b = op DIFFERENCE (a, b) ()---- | Insert a datum into an array if it is not yet present------ > >>> run h $ setInsert 3 [1,2,4,4,5] :: IO (Maybe [Int])--- > Just [1,2,4,5,3]-setInsert :: (Expr datum, Expr array) => datum -> array -> ReQL-setInsert d a = op SET_INSERT (a, d) ()---- | The union of two sets------ > >>> run h $ [1,2] `setUnion` [2,3]  :: IO (Maybe [Int])--- > Just [2,3,1]-setUnion :: (Expr a, Expr b) => a -> b -> ReQL-setUnion a b = op SET_UNION (b, a) ()---- | The intersection of two sets------ > >>> run h $ [1,2] `setIntersection` [2,3]  :: IO (Maybe [Int])--- > Just [2]-setIntersection :: (Expr a, Expr b) => a -> b -> ReQL-setIntersection a b = op SET_INTERSECTION (b, a) ()---- | The difference of two sets------ > >>> run h $ [2,3] # setDifference [1,2]  :: IO (Maybe [Int])--- > Just [3]-setDifference :: (Expr set, Expr remove) => remove -> set -> ReQL-setDifference r s = op SET_DIFFERENCE (s, r) ()---- | Test if an object has the given fields------ > >>> run h $ hasFields ["a"] $ obj ["a" := 1] :: IO (Maybe Bool)--- > Just True-hasFields :: (Expr obj) => ReQL -> obj -> ReQL-hasFields p o = op HAS_FIELDS (o, expr p) ()---- | Insert a datum at the given position in an array------ > >>> run h $ insertAt 1 4 [1,2,3] :: IO (Maybe [Int])--- > Just [1,4,2,3]-insertAt :: (Expr n, Expr datum, Expr array) => n -> datum -> array -> ReQL-insertAt n d a = op INSERT_AT (a, n, d) ()---- | Splice an array at a given position inside another array------ > >>> run h $ spliceAt 2 [4,5] [1,2,3] :: IO (Maybe [Int])--- > Just [1,2,4,5,3]-spliceAt :: (Expr n, Expr replace, Expr array) => n -> replace -> array -> ReQL-spliceAt n s a = op SPLICE_AT (a, n, s) ()---- | Delete an element from an array------ > >>> run h $ deleteAt 1 [1,2,3] :: IO (Maybe [Int])--- > Just [1,3]-deleteAt :: (Expr n, Expr array) => n -> array -> ReQL-deleteAt n a = op DELETE_AT (a, n) ()---- | Change an element in an array------ > >>> run h $ changeAt 1 4 [1,2,3] :: IO (Maybe [Int])--- > Just [1,4,3]-changeAt :: (Expr n, Expr datum, Expr array) => n -> datum -> array -> ReQL-changeAt n d a = op CHANGE_AT (a, n, d) ()---- | The list of keys of the given object------ > >>> run h $ keys (obj ["a" := 1, "b" := 2]) :: IO (Maybe [String])--- > Just ["a","b"]-keys :: Expr obj => obj -> ReQL-keys o = op KEYS [o] ()---- | Match a string to a regular expression.------ Called /match/ in the official drivers------ > >>> run' h $ str "foobar" =~ "f(.)+[bc](.+)"--- > [{"groups":[{"start":2.0,"end":3.0,"str":"o"},{"start":4.0,"end":6.0,"str":"ar"}],"start":0.0,"end":6.0,"str":"foobar"}]-(=~) :: (Expr string) => string -> ReQL -> ReQL-s =~ r = op MATCH (s, r) ()---- | Apply a function to a list of arguments.------ Called /do/ in the official drivers------ > >>> run h $ (\x -> x R.* 2) `apply` [4] :: IO (Maybe Int)--- > Just 8-apply :: (Expr fun, Expr arg) => fun -> [arg] -> ReQL-f `apply` as = op FUNCALL (expr f : P.map expr as) ()---- | Catch some expections inside the query.------ Called /default/ in the official drivers------ > >>> run h $ handle 0 $ obj ["a" := 1] ! "b" :: IO (Maybe Int)--- > Just 0--- > >>> run h $ handle (expr . id) $ obj ["a" := 1] ! "b" :: IO (Maybe String)--- > Just "No attribute `b` in object:\n{\n\t\"a\":\t1\n}"-handle :: (Expr handler, Expr reql) => handler -> reql -> ReQL-handle h r = op DEFAULT (r, h) ()---- | A string representing the type of an expression------ > >>> run h $ typeOf 1 :: IO (Maybe String)--- > Just "NUMBER"-typeOf :: Expr a => a -> ReQL-typeOf a = op TYPEOF [a] ()---- | Get information on a given expression. Useful for tables and databases.------ > >>> run' h $ info $ table "foo"--- > [{"primary_key":"id","name":"foo","indexes":[],"type":"TABLE","db":{"name":"test","type":"DB"}}]-info :: Expr a => a -> ReQL-info a = op INFO [a] ()---- | Parse a json string into an object------ > >>> run' h $ json "{a:1}"--- > [{"a":1.0}]-json :: ReQL -> ReQL-json s = op JSON [s] ()---- | Flipped function application-infixl 8 #-(#) :: (Expr a, Expr b) =>  a -> (a -> b) -> ReQL-x # f = expr (f x)--infixr 9 .--- | Specialised function composition-(.) :: (Expr a, Expr b, Expr c) =>  (ReQL -> b) -> (ReQL -> a) -> c -> ReQL-(f . g) x = expr (f (expr (g (expr x))))+-- | ReQL Functions+--+-- ReQL was designed for dynamic languages. Many operations take+-- optional positional and named arguments.+--+-- Optional named arguments can be added using `ex`, for example+-- `upsert = ex insert ["conflict" := "update"]`+--+-- For optional positional arguments this module defines an extra+-- function if the functionality is not available otherwise. For+-- example `argmax` for `max` and `splitOn` for `split` but `skip`+-- instead of `sliceFrom` and `avg . (!k)` instead of `avgOf k`.++module Database.RethinkDB.Functions where++import Data.Text (Text)+import Control.Monad.State+import Control.Applicative+import Data.Maybe+import Data.Default+import Data.Monoid++import Database.RethinkDB.Wire.Term as Term+import Database.RethinkDB.ReQL+import {-# SOURCE #-} Database.RethinkDB.MapReduce+import Database.RethinkDB.Types+import Database.RethinkDB.Datum hiding (Error)++import Prelude (($), (.))+import qualified Prelude as P++-- $setup+--+-- Get the doctests ready+--+-- >>> :load Database.RethinkDB.NoClash+-- >>> import qualified Database.RethinkDB as R+-- >>> default (Datum, ReQL, String, Int, Double)+-- >>> import Prelude+-- >>> import Data.Text (Text)+-- >>> import Data.Maybe+-- >>> import Control.Exception+-- >>> import Database.RethinkDB.Functions ()+-- >>> import Database.RethinkDB ()+-- >>> import Data.List (sort)+-- >>> import System.IO.Unsafe+-- >>> :set -XOverloadedStrings+-- >>> let try' x = (try x `asTypeOf` return (Left (undefined :: SomeException))) >> return ()+-- >>> h' <- unsafeInterleaveIO $ connect "localhost" 28015 def+-- >>> let h = use "doctests" h'++-- $init_doctests+-- >>> try' $ run' h' $ dbCreate "doctests"+-- >>> try' $ run' h $ tableCreate "foo"+-- >>> try' $ run' h $ delete $ table "foo"+-- >>> try' $ run' h $ tableCreate "bar"+-- >>> try' $ run' h $ delete $ table "bar"+-- >>> try' $ run' h $ tableDrop "bar"+-- >>> try' $ run' h $ tableCreate (table "posts")+-- >>> try' $ run' h $ delete $ table "posts"+-- >>> try' $ run' h $ tableCreate (table "users"){ tablePrimaryKey = Just "name" }+-- >>> try' $ run' h $ delete $ table "users"+-- >>> try' $ run' h $ table "users" # indexDrop "occupation"+-- >>> try' $ run' h $ table "users" # indexDrop "location"+-- >>> try' $ run' h $ table "users" # indexDrop "friends"++-- | Create a table on the server+--+-- > >>> run' h $ tableCreate (table "posts") def+-- > [{"created":1}]+-- > >>> run' h $ tableCreate (table "users"){ tablePrimaryKey = Just "name" } def+-- > [{"created":1}]+-- > >>> run' h $ tableCreate (Table (Just "doctests") "bar" (Just "name")) def+-- > [{"created":1}]+-- > >>> run' h $ ex tableCreate ["datacenter":="orion"] (Table (Just "doctests") "bar" (Just "name")) def+-- > [{"created":1}]+tableCreate :: Table -> ReQL+tableCreate (Table mdb table_name pkey) =+  withQuerySettings $ \QuerySettings{ queryDefaultDatabase = ddb } ->+    op' TABLE_CREATE (fromMaybe ddb mdb, table_name) $ catMaybes [+      ("primary_key" :=) <$> pkey ]++-- | Insert a document or a list of documents into a table+--+-- >>> run h $ table "users" # insert (map (\x -> ["name":=x]) ["bill", "bob", "nancy" :: Text]) :: IO WriteResponse+-- {inserted:3}+-- >>> run h $ table "posts" # insert ["author" := str "bill", "message" := str "hi", "id" := 1] :: IO WriteResponse+-- {inserted:1}+-- >>> run h $ table "posts" # insert ["author" := str "bill", "message" := str "hello", "id" := 2, "flag" := str "deleted"] :: IO WriteResponse+-- {inserted:1}+-- >>> run h $ table "posts" # insert ["author" := str "bob", "message" := str "lorem ipsum", "id" := 3, "flag" := str "pinned"] :: IO WriteResponse+-- {inserted:1}+insert :: (Expr object) => object -> Table -> ReQL+insert a tb = op INSERT (tb, a)++-- | Add to or modify the contents of a document+--+-- >>> run h $ table "users" # getAll "name" [str "bob"] # update (const ["occupation" := str "tailor"]) :: IO WriteResponse+-- {replaced:1}+update :: (Expr selection, Expr a) => (ReQL -> a) -> selection -> ReQL+update f s = op UPDATE (s, expr . f)++-- | Replace a document with another+--+-- >>> run h $ replace (\user -> ["name" := user!"name", "occupation" := str "clothier"]) . R.filter ((R.== str "tailor") . (!?"occupation")) $ table "users" :: IO WriteResponse+-- {replaced:1}+replace :: (Expr selection, Expr a) => (ReQL -> a) -> selection -> ReQL+replace f s = op REPLACE (s, expr . f)++-- | Delete the documents+--+-- >>> run h $ delete . getAll "name" [str "bob"] $ table "users" :: IO WriteResponse+-- {deleted:1}+delete :: (Expr selection) => selection -> ReQL+delete s = op Term.DELETE [s]++-- | Like map but for write queries+--+-- >>> _ <- run' h $ table "users" # replace (without ["post_count"])+-- >>> run h $ forEach (table "users") (\user -> table "users" # get (user!"name") # ex update [nonAtomic] (const ["post_count" := R.count (table "posts" # R.filter (\post -> post!"author" R.== user!"name"))])) :: IO WriteResponse+-- {replaced:2}+forEach :: (Expr s, Expr a) => s -> (ReQL -> a) -> ReQL+forEach s f = op FOREACH (s, expr P.. f)++-- | A table+--+-- >>> fmap sort $ run h $ table "users" :: IO [Datum]+-- [{"post_count":2,"name":"bill"},{"post_count":0,"name":"nancy"}]+table :: Text -> Table+table n = Table Nothing n Nothing++-- | Drop a table+--+-- >>> run' h $ tableDrop (table "foo")+-- {"dropped":1}+tableDrop :: Table -> ReQL+tableDrop (Table mdb table_name _) =+  withQuerySettings $ \QuerySettings{ queryDefaultDatabase = ddb } ->+    op TABLE_DROP (fromMaybe ddb mdb, table_name)++-- | List the tables in a database+--+-- >>> fmap sort $ run h $ tableList (db "doctests") :: IO [String]+-- ["places","posts","users"]+tableList :: Database -> ReQL+tableList name = op TABLE_LIST [name]++infixl 6 +, -+infixl 7 *, /++-- | Addition or concatenation+--+-- Use the Num instance, or a qualified operator.+--+-- >>> run h $ 2 + 5+-- 7+-- >>> run h $ str "foo" R.+ str "bar"+-- "foobar"+(+) :: (Expr a, Expr b) => a -> b -> ReQL+(+) a b = op ADD (a, b)++-- | Subtraction+--+-- >>> run h $ 2 - 5+-- -3+(-) :: (Expr a, Expr b) => a -> b -> ReQL+(-) a b = op SUB (a, b)++-- | Multiplication+--+-- >>> run h $ 2 * 5+-- 10+(*) :: (Expr a, Expr b) => a -> b -> ReQL+(*) a b = op MUL (a, b)++-- | Division+--+-- >>> run h $ 2 R./ 5+-- 0.4+(/) :: (Expr a, Expr b) => a -> b -> ReQL+(/) a b = op DIV (a, b)++-- | Mod+--+-- >>> run h $ 5 `mod` 2+-- 1+mod :: (Expr a, Expr b) => a -> b -> ReQL+mod a b = op MOD (a, b)++infixr 2 ||+infixr 3 &&++-- | Boolean or+--+-- >>> run h $ True R.|| False+-- true+(||) :: (Expr a, Expr b) => a -> b -> ReQL+a || b = op ANY (a, b)++-- | Boolean and+--+-- >>> run h $ True R.&& False+-- false+(&&) :: (Expr a, Expr b) => a -> b -> ReQL+a && b = op ALL (a, b)++infix 4 ==, /=++-- | Test for equality+--+-- >>> run h $ ["a" := 1] R.== ["a" := 1]+-- true+(==) :: (Expr a, Expr b) => a -> b -> ReQL+a == b = op EQ (a, b)++-- | Test for inequality+--+-- >>> run h $ 1 R./= False+-- true+(/=) :: (Expr a, Expr b) => a -> b -> ReQL+a /= b = op NE (a, b)++infix 4 >, <, <=, >=++-- | Greater than+--+-- >>> run h $ 3 R.> 2+-- true+(>) :: (Expr a, Expr b) => a -> b -> ReQL+a > b = op GT (a, b)++-- | Lesser than+--+-- >>> run h $ (str "a") R.< (str "b")+-- true+(<) :: (Expr a, Expr b) => a -> b -> ReQL+a < b = op LT (a, b)++-- | Greater than or equal to+--+-- >>> run h $ [1] R.>= Null+-- false+(>=) :: (Expr a, Expr b) => a -> b -> ReQL+a >= b = op GE (a, b)++-- | Lesser than or equal to+--+-- >>> run h $ 2 R.<= 2+-- true+(<=) :: (Expr a, Expr b) => a -> b -> ReQL+a <= b = op LE (a, b)++-- | Negation+--+-- >>> run h $ R.not False+-- true+-- >>> run h $ R.not Null+-- true+not :: (Expr a) => a -> ReQL+not a = op NOT [a]++-- * Lists and Streams++-- | The size of a sequence or an array.+--+-- >>> run h $ count (table "users")+-- 2+count :: (Expr a) => a -> ReQL+count e = op COUNT [e]++-- | Join two sequences.+--+-- >>> run h $ [1,2,3] `union` ["a", "b", "c" :: Text]+-- [1,2,3,"a","b","c"]+union :: (Expr a, Expr b) => a -> b -> ReQL+union a b = op UNION (a, b)++-- | Map a function over a sequence+--+-- >>> run h $ R.map (!"a") [["a" := 1], ["a" := 2]]+-- [1,2]+map :: (Expr a, Expr b) => (ReQL -> b) -> a -> ReQL+map f a = op MAP (a, expr P.. f)++-- | Filter a sequence given a predicate+--+-- >>> run h $ R.filter (R.< 4) [3, 1, 4, 1, 5, 9, 2, 6]+-- [3,1,1,2]+filter :: (Expr predicate, Expr seq) => predicate -> seq -> ReQL+filter f a = op' FILTER (a, f) ["default" := op ERROR ()]++-- | Query all the documents whose value for the given index is in a given range+--+-- >>> run h $ table "users" # between "name" (Closed $ str "a") (Open $ str "c")+-- [{"post_count":2,"name":"bill"}]+between :: (Expr left, Expr right, Expr seq) => Index -> Bound left -> Bound right -> seq -> ReQL+between i a b e =+  op' BETWEEN [expr e, expr $ getBound a, expr $ getBound b] $+  idx P.++ ["left_bound" ?:= closedOrOpen a, "right_bound" ?:= closedOrOpen b]+  where idx = case i of PrimaryKey -> []; Index name -> ["index" := name]++-- | Append a datum to a sequence+--+-- >>> run h $ append 3 [1, 2]+-- [1,2,3]+append :: (Expr a, Expr b) => a -> b -> ReQL+append a b = op APPEND (b, a)++-- | Map a function of a sequence and concat the results+--+-- >>> run h $ concatMap id [[1, 2], [3], [4, 5]]+-- [1,2,3,4,5]+concatMap :: (Expr a, Expr b) => (ReQL -> b) -> a -> ReQL+concatMap f e = op CONCATMAP (e, expr P.. f)++-- | SQL-like inner join of two sequences+--+-- >>> run' h $ innerJoin (\user post -> user!"name" R.== post!"author") (table "users") (table "posts") # R.zip # orderBy [asc "id"] # pluck ["name", "message"]+-- [{"name":"bill","message":"hi"},{"name":"bill","message":"hello"}]+innerJoin :: (Expr a, Expr b, Expr c) => (ReQL -> ReQL -> c) -> a -> b -> ReQL+innerJoin f a b = op INNER_JOIN (a, b, fmap expr P.. f)++-- | SQL-like outer join of two sequences+--+-- >>> run' h $ outerJoin (\user post -> user!"name" R.== post!"author") (table "users") (table "posts") # R.zip # orderBy [asc "id", asc "name"] # pluck ["name", "message"]+-- [{"name":"nancy"},{"name":"bill","message":"hi"},{"name":"bill","message":"hello"}]+outerJoin :: (Expr a, Expr b, Expr c) => (ReQL -> ReQL -> c) -> a -> b -> ReQL+outerJoin f a b = op OUTER_JOIN (a, b, fmap expr P.. f)++-- | An efficient inner_join that uses a key for the left table and an index for the right table.+--+-- >>> run' h $ table "posts" # eqJoin "author" (table "users") "name" # R.zip # orderBy [asc "id"] # pluck ["name", "message"]+-- [{"name":"bill","message":"hi"},{"name":"bill","message":"hello"}]+eqJoin :: (Expr fun, Expr right, Expr left) => fun -> right -> Index -> left -> ReQL+eqJoin key right (Index idx) left = op' EQ_JOIN (left, key, right) ["index" := idx]+eqJoin key right PrimaryKey left = op EQ_JOIN (left, key, right)++-- | Drop elements from the head of a sequence.+--+-- >>> run h $ skip 2 [1, 2, 3, 4]+-- [3,4]+skip :: (Expr n, Expr seq) => n -> seq -> ReQL+skip a b = op SKIP (b, a)++-- | Limit the size of a sequence.+--+-- >>> run h $ limit 2 [1, 2, 3, 4]+-- [1,2]+limit :: (Expr n, Expr seq) => n -> seq -> ReQL+limit n s = op LIMIT (s, n)++-- | Cut out part of a sequence+--+-- >>> run h $ slice 2 4 [1, 2, 3, 4, 5]+-- [3,4]+slice :: (Expr a, Expr b, Expr c) => a -> b -> c -> ReQL+slice n m s = op SLICE (s, n, m)++-- | Reduce a sequence to a single value+--+-- >>> run h $ reduce0 (+) 0 [1, 2, 3]+-- 6+reduce0 :: (Expr base, Expr seq, Expr a) => (ReQL -> ReQL -> a) -> base -> seq -> ReQL+reduce0 f b s = op REDUCE (s `union` [b], fmap expr P.. f)++-- | Reduce a non-empty sequence to a single value+--+-- >>> run h $ reduce (+) [1, 2, 3]+-- 6+reduce :: (Expr a, Expr s) => (ReQL -> ReQL -> a) -> s -> ReQL+reduce f s = op REDUCE (s, fmap expr P.. f)++-- | Filter out identical elements of the sequence+--+-- >>> fmap sort $ run h $ distinct (table "posts" ! "flag") :: IO [String]+-- ["deleted","pinned"]+distinct :: (Expr s) => s -> ReQL+distinct s = op DISTINCT [s]++-- | Merge the "left" and "right" attributes of the objects in a sequence.+--+-- >>> fmap sort $ run h $ table "posts" # eqJoin "author" (table "users") "name" # R.zip :: IO [Datum]+-- [{"post_count":2,"flag":"deleted","name":"bill","author":"bill","id":2,"message":"hello"},{"post_count":2,"name":"bill","author":"bill","id":1,"message":"hi"}]+zip :: (Expr a) => a -> ReQL+zip a = op ZIP [a]++-- | Order a sequence by the given keys+--+-- >>> run' h $ table "users" # orderBy [desc "post_count", asc "name"] # pluck ["name", "post_count"]+-- [{"post_count":2,"name":"bill"},{"post_count":0,"name":"nancy"}]+--+-- >>> run' h $ table "users" # ex orderBy ["index":="name"] [] # pluck ["name"]+-- [{"name":"bill"},{"name":"nancy"}]+orderBy :: (Expr s) => [ReQL] -> s -> ReQL+orderBy o s = op ORDERBY (expr s : P.map expr o)++-- | Ascending order+asc :: ReQL -> ReQL+asc f = op ASC [f]++-- | Descending order+desc :: ReQL -> ReQL+desc f = op DESC [f]++-- | Turn a grouping function and a reduction function into a grouped map reduce operation+--+-- >>> run' h $ table "posts" # group (!"author") (reduce (\a b -> a + "\n" + b) . R.map (!"message"))+-- [{"group":"bill","reduction":"hi\nhello"},{"group":"bob","reduction":"lorem ipsum"}]+-- >>> run' h $ table "users" # group ((!0) . splitOn "" . (!"name")) (\users -> let pc = users!"post_count" in [avg pc, R.sum pc])+-- [{"group":"b","reduction":[2,2]},{"group":"n","reduction":[0,0]}]+group ::+  (Expr group, Expr reduction, Expr seq)+  => (ReQL -> group) -> (ReQL -> reduction) -> seq -> ReQL+group g f s = ReQL $ do+  mr <- termToMapReduce (expr . f)+  runReQL $ op UNGROUP [mr $ op GROUP (expr s, expr . g)]++-- | Rewrite multiple reductions into a single map/reduce operation+mapReduce :: (Expr reduction, Expr seq) => (ReQL -> reduction) -> seq -> ReQL+mapReduce f s = ReQL $ do+  mr <- termToMapReduce (expr . f)+  runReQL $ mr (expr s)++-- | The sum of a sequence+--+-- >>> run h $ sum [1, 2, 3]+-- 6+sum :: (Expr s) => s -> ReQL+sum s = op SUM [s]++-- | The average of a sequence+--+-- >>> run h $ avg [1, 2, 3, 4]+-- 2.5+avg :: (Expr s) => s -> ReQL+avg s = op AVG [s]++-- | Minimum value+min :: Expr s => s -> ReQL+min s = op MIN [s]++-- | Value that minimizes the function+argmin :: (Expr s, Expr a) => (ReQL -> a) -> s -> ReQL+argmin f s = op MIN (s, expr . f)++-- | Minimum value+max :: Expr s => s -> ReQL+max s = op MAX [s]++-- | Value that maximizes the function+argmax :: (Expr s, Expr a) => (ReQL -> a) -> s -> ReQL+argmax f s = op MAX (s, expr . f)++-- * Accessors++infixl 9 !++-- | Get a single field from an object or an element of an array+--+-- >>> run h $ ["foo" := True] ! "foo"+-- true+--+-- >>> run h $ [1, 2, 3] ! 0+-- 1+--+-- Or a single field from each object in a sequence+--+-- >>> run h $ [["foo" := True], ["foo" := False]] ! "foo"+-- [true,false]+(!) :: (Expr s) => s -> ReQL -> ReQL+s ! k = op BRACKET (s, k)++-- | Get a single field, or null if not present+--+-- >>> run' h $ empty !? "foo"+-- null+(!?) :: (Expr s) => s -> ReQL -> ReQL+s !? k = P.flip apply [expr s, k] $ \s' k' -> op DEFAULT (op BRACKET (s', k'), Null)++-- | Keep only the given attributes+--+-- >>> run' h $ [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # pluck ["a"]+-- [{"a":1},{"a":2},{}]+pluck :: (Expr o) => [ReQL] -> o -> ReQL+pluck ks e = op PLUCK (cons e $ arr (P.map expr ks))++-- | Remove the given attributes from an object+--+-- >>> run' h $ [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # without ["a"]+-- [{"b":2},{"c":7},{"b":4}]+without :: (Expr o) => [ReQL] -> o -> ReQL+without ks e = op WITHOUT (cons e $ arr (P.map expr ks))++-- | Test if a sequence contains a given element+--+-- >>> run' h $ [1,2,3] # contains 1+-- true+contains :: (Expr x, Expr seq) => x -> seq -> ReQL+contains x s = op CONTAINS (s, x)++-- | Merge two objects together+--+-- >>> run' h $ merge ["a" := 1, "b" := 1] ["b" := 1, "c" := 2]+-- {"a":1,"b":1,"c":2}+merge :: (Expr a, Expr b) => a -> b -> ReQL+merge a b = op MERGE (b, a)++-- | Literal objects, in a merge or update, are not processed recursively.+--+-- >>> run' h $ ["a" := ["b" := 1]] # merge ["a" := literal ["c" := 2]]+-- {"a":{"c":2}}+literal :: Expr a => a -> ReQL+literal a = op LITERAL [a]++-- | Remove fields when doing a merge or update+--+-- >>> run' h $ ["a" := ["b" := 1]] # merge ["a" := remove]+-- {}+remove :: ReQL+remove = op LITERAL ()++-- | Evaluate a JavaScript expression+--+-- >>> run' h $ js "Math.PI"+-- 3.141592653589793+-- >>> let r_sin x = js "Math.sin" `apply` [x]+-- >>> run h $ R.map r_sin [pi, pi/2]+-- [1.2246063538223773e-16,1]+js :: ReQL -> ReQL+js s = op JAVASCRIPT [s]++-- | Server-side if+--+-- >>> run h $ branch (1 R.< 2) 3 4+-- 3+branch :: (Expr a, Expr b, Expr c) => a -> b -> c -> ReQL+branch a b c = op BRANCH (a, b, c)++-- | Abort the query with an error+--+-- >>> run' h $ R.error (str "haha") R./ 2 + 1+-- *** Exception: RethinkDB: Runtime error: "haha"+--   in add(div({- HERE -} error("haha"), 2), 1)+error :: (Expr s) => s -> ReQL+error m = op ERROR [m]++-- | Create a Database reference+--+-- >>> run' h $ db "test" # info+-- {"name":"test","type":"DB"}+db :: Text -> Database+db = Database++-- | Create a database on the server+--+-- >>> run' h $ dbCreate "dev"+-- {"created":1}+dbCreate :: P.String -> ReQL+dbCreate db_name = op DB_CREATE [str db_name]++-- | Drop a database+--+-- >>> run' h $ dbDrop (db "dev")+-- {"dropped":1}+dbDrop :: Database -> ReQL+dbDrop (Database name) = op DB_DROP [name]++-- | List the databases on the server+--+-- >>> _ <- run' h $ dbList+dbList :: ReQL+dbList = op DB_LIST ()++-- | Create an index on the table from the given function+--+-- >>> run' h $ table "users" # indexCreate "occupation" (!"occupation")+-- {"created":1}+-- >>> run' h $ table "users" # ex indexCreate ["multi":=True] "friends" (!"friends")+-- {"created":1}+-- >>> run' h $ table "users" # ex indexCreate ["geo":=True] "location" (!"location")+-- {"created":1}+indexCreate :: (Expr fun) => P.String -> fun -> Table -> ReQL+indexCreate name f tbl = op INDEX_CREATE (tbl, str name, f)++-- | Get the status of the given indexes+--+-- > run' h $ table "users" # indexStatus []+indexStatus :: Expr table => [ReQL] -> table -> ReQL+indexStatus ixes tbl = op INDEX_STATUS (tbl, ixes)++-- | Wait for an index to be built+--+-- > run' h $ table "users" # indexWait []+indexWait :: Expr table => [ReQL] -> table -> ReQL+indexWait ixes tbl = op INDEX_STATUS (tbl, ixes)++indexRename :: Expr table => ReQL -> ReQL -> table -> ReQL+indexRename from to tbl = op INDEX_RENAME (tbl, from, to)++-- | Ensures that writes on a given table are written to permanent storage+--+-- >>> run' h $ sync (table "users")+-- {"synced":1}+sync :: Expr table => table -> ReQL+sync tbl = op SYNC [tbl]++-- | List the indexes on the table+--+-- >>> run' h $ indexList (table "users")+-- ["friends","location","occupation"]+indexList :: Table -> ReQL+indexList tbl = op INDEX_LIST [tbl]++-- | Drop an index+--+-- >>> run' h $ table "users" # indexDrop "occupation"+-- {"dropped":1}+indexDrop :: Key -> Table -> ReQL+indexDrop name tbl = op INDEX_DROP (tbl, name)++-- | Retreive documents by their indexed value+--+-- >>> run' h $ table "users" # getAll PrimaryKey [str "bill"]+-- [{"post_count":2,"name":"bill"}]+getAll :: (Expr values) => Index -> values -> Table -> ReQL+getAll idx xs tbl =+  op' GET_ALL (tbl, op ARGS [xs]) $+  case idx of+    Index i -> ["index" := i]+    PrimaryKey -> []++-- | Get a document by primary key+--+-- >>> run' h $ table "users" # get "nancy"+-- {"post_count":0,"name":"nancy"}+get :: Expr s => ReQL -> s -> ReQL+get k e = op Term.GET (e, k)++-- | Convert a value to a different type+--+-- >>> run h $ coerceTo "STRING" 1+-- "1"+coerceTo :: (Expr x) => ReQL -> x -> ReQL+coerceTo t a = op COERCE_TO (a, t)++-- | Convert a value to an array+--+-- >>> run h $ asArray $ ["a" := 1, "b" := 2] :: IO [(String, Int)]+-- [("a",1),("b",2)]+asArray :: Expr x => x -> ReQL+asArray = coerceTo "ARRAY"++-- | Convert a value to a string+--+-- >>> run h $ asString $ ["a" := 1, "b" := 2]+-- "{\n\t\"a\":\t1,\n\t\"b\":\t2\n}"+asString :: Expr x => x -> ReQL+asString = coerceTo "STRING"++-- | Convert a value to a number+--+-- >>> run h $ asNumber (str "34")+-- 34+asNumber :: Expr x => x -> ReQL+asNumber = coerceTo "NUMBER"++-- | Convert a value to an object+--+-- >>> run' h $ asObject $ [(str "a",1),("b",2)]+-- {"a":1,"b":2}+asObject :: Expr x => x -> ReQL+asObject = coerceTo "OBJECT"++-- | Convert a value to a boolean+asBool :: Expr x => x -> ReQL+asBool = coerceTo "BOOL"++-- | Like hasFields followed by pluck+--+-- >>> run' h $ [["a" := 1, "b" := 2], ["a" := 2, "c" := 7], ["b" := 4]] # withFields ["a"]+-- [{"a":1},{"a":2}]+withFields :: Expr seq => [ReQL] -> seq -> ReQL+withFields p s = op WITH_FIELDS (s, p)++-- | The position in the sequence of the elements that match the predicate+--+-- >>> run h $ indexesOf (match "ba.") [str "foo", "bar", "baz"]+-- [1,2]+indexesOf :: (Expr fun, Expr seq) => fun -> seq -> ReQL+indexesOf f s = op INDEXES_OF (s, f)++-- | Test if a sequence is empty+--+-- >>> run h $ isEmpty [1]+-- false+isEmpty :: Expr seq => seq -> ReQL+isEmpty s = op IS_EMPTY [s]++-- | Select a given number of elements from a sequence with uniform random distribution+--+-- >>> _ <- run' h $ sample 3 [0,1,2,3,4,5,6,7,8,9]+sample :: (Expr n, Expr seq) => n -> seq -> ReQL+sample n s = op SAMPLE (s, n)++-- | Prepend an element to an array+--+-- >>> run h $ prepend 1 [2,3]+-- [1,2,3]+prepend :: (Expr datum, Expr array) => datum -> array -> ReQL+prepend d a = op PREPEND (a, d)++-- | The different of two lists+--+-- >>> run h $ [1,2,3,4,5] # difference [2,5] +-- [1,3,4]+difference :: (Expr a, Expr b) => a -> b -> ReQL+difference a b = op DIFFERENCE (b, a)++-- | Insert a datum into an array if it is not yet present+--+-- >>> run h $ setInsert 3 [1,2,4,4,5]+-- [1,2,4,5,3]+setInsert :: (Expr datum, Expr array) => datum -> array -> ReQL+setInsert d a = op SET_INSERT (a, d)++-- | The union of two sets+--+-- >>> run h $ [1,2] `setUnion` [2,3]+-- [2,3,1]+setUnion :: (Expr a, Expr b) => a -> b -> ReQL+setUnion a b = op SET_UNION (b, a)++-- | The intersection of two sets+--+-- >>> run h $ [1,2] `setIntersection` [2,3]+-- [2]+setIntersection :: (Expr a, Expr b) => a -> b -> ReQL+setIntersection a b = op SET_INTERSECTION (b, a)++-- | The difference of two sets+--+-- >>> run h $ [2,3] # setDifference [1,2]+-- [3]+setDifference :: (Expr set, Expr remove) => remove -> set -> ReQL+setDifference r s = op SET_DIFFERENCE (s, r)++-- | Test if an object has the given fields+--+-- >>> run h $ hasFields "a" $ ["a" := 1]+-- true+hasFields :: (Expr obj) => ReQL -> obj -> ReQL+hasFields p o = op HAS_FIELDS (o, expr p)++-- | Insert a datum at the given position in an array+--+-- >>> run h $ insertAt 1 4 [1,2,3]+-- [1,4,2,3]+insertAt :: (Expr n, Expr datum, Expr array) => n -> datum -> array -> ReQL+insertAt n d a = op INSERT_AT (a, n, d)++-- | Splice an array at a given position inside another array+--+-- >>> run h $ spliceAt 2 [4,5] [1,2,3]+-- [1,2,4,5,3]+spliceAt :: (Expr n, Expr replace, Expr array) => n -> replace -> array -> ReQL+spliceAt n s a = op SPLICE_AT (a, n, s)++-- | Delete an element from an array+--+-- >>> run h $ deleteAt 1 [1,2,3]+-- [1,3]+deleteAt :: (Expr n, Expr array) => n -> array -> ReQL+deleteAt n a = op DELETE_AT (a, n)++-- | Change an element in an array+--+-- >>> run h $ changeAt 1 4 [1,2,3]+-- [1,4,3]+changeAt :: (Expr n, Expr datum, Expr array) => n -> datum -> array -> ReQL+changeAt n d a = op CHANGE_AT (a, n, d)++-- | The list of keys of the given object+--+-- >>> run h $ keys ["a" := 1, "b" := 2]+-- ["a","b"]+keys :: Expr object => object -> ReQL+keys o = op KEYS [o]++-- | Match a string to a regular expression.+--+-- >>> run' h $ str "foobar" # match "f(.)+[bc](.+)"+-- {"groups":[{"start":2,"end":3,"str":"o"},{"start":4,"end":6,"str":"ar"}],"start":0,"end":6,"str":"foobar"}+match :: (Expr string) => ReQL -> string -> ReQL+match r s = op MATCH (s, r)++-- | Apply a function to a list of arguments.+--+-- Called /do/ in the official drivers+--+-- >>> run h $ (\x -> x R.* 2) `apply` [4]+-- 8+apply :: (Expr fun, Expr arg) => fun -> [arg] -> ReQL+f `apply` as = op FUNCALL (expr f : P.map expr as)++-- | Catch some expections inside the query.+--+-- Called /default/ in the official drivers+--+-- >>> run h $ R.handle (const 0) $ ["a" := 1] ! "b"+-- 0+-- >>> run h $ R.handle (expr . id) $ ["a" := 1] ! "b"+-- "No attribute `b` in object:\n{\n\t\"a\":\t1\n}"+handle :: (Expr instead, Expr reql) => (ReQL -> instead) -> reql -> ReQL+handle h r = op DEFAULT (r, expr . h)++-- | A string representing the type of an expression+--+-- >>> run h $ typeOf 1+-- "NUMBER"+typeOf :: Expr a => a -> ReQL+typeOf a = op TYPEOF [a]++-- | Get information on a given expression. Useful for tables and databases.+--+-- >>> run h $ info $ table "users"+-- {"primary_key":"name","name":"users","indexes":["friends","location"],"type":"TABLE","db":{"name":"doctests","type":"DB"}}+info :: Expr a => a -> ReQL+info a = op INFO [a]++-- | Parse a json string into an object+--+-- >>> run' h $ json "{\"a\":1}"+-- {"a":1}+json :: ReQL -> ReQL+json s = op Term.JSON [s]++-- | Flipped function application+infixl 8 #+(#) :: (Expr a, Expr b) =>  a -> (a -> b) -> ReQL+x # f = expr (f x)++-- | Convert to upper case+--+-- >>> run h $ upcase (str "Foo")+-- "FOO"+upcase :: Expr str => str -> ReQL+upcase s = op UPCASE [s]++-- | Convert to lower case+--+-- >>> run h $ downcase (str "Foo")+-- "foo"+downcase :: Expr str => str -> ReQL+downcase s = op DOWNCASE [s]++-- | Split a string on whitespace characters+--+-- >>> run' h $ split (str "foo bar")+-- ["foo","bar"]+split :: Expr str => str -> ReQL+split s = op SPLIT [s]++-- | Split a string on a given delimiter+--+-- >>> run' h $ str "foo, bar" # splitOn ","+-- ["foo"," bar"]+--+-- >>> run' h $ str "foo" # splitOn ""+-- ["f","o","o"]+splitOn :: Expr str => ReQL -> str -> ReQL+splitOn sep s = op SPLIT [expr s, sep]++-- | Split a string up to a given number of times+--+-- >>> run' h $ str "a:b:c:d" # splitMax ":" 2+-- ["a","b","c:d"]+splitMax :: Expr str => ReQL -> ReQL -> str -> ReQL+splitMax sep n s = op SPLIT [expr s, sep, n]++-- | A random float between 0 and 1+--+-- >>> run' h $ (\x -> x R.< 1 R.&& x R.>= 0) `apply` [random]+-- true+random :: ReQL+random = op RANDOM ()++-- | A random number between 0 and n+--+-- >>> run' h $ (\x -> x R.< 10 R.&& x R.>= 0) `apply` [randomTo 10]+-- true+randomTo :: ReQL -> ReQL+randomTo n = op RANDOM [n]++-- | A random number between 0 and n+--+-- >>> run' h $ (\x -> x R.< 10 R.&& x R.>= 5) `apply` [randomFromTo 5 10]+-- true+randomFromTo :: ReQL -> ReQL -> ReQL+randomFromTo n m = op RANDOM [n, m]++data HttpOptions = HttpOptions {+  httpTimeout :: Maybe P.Int,+  httpReattempts :: Maybe P.Int,+  httpRedirects :: Maybe P.Int,+  httpVerify :: Maybe P.Bool,+  httpResultFormat :: Maybe HttpResultFormat,+  httpMethod :: Maybe HttpMethod,+  httpAuth :: Maybe [Attribute Dynamic],+  httpParams :: Maybe [Attribute Dynamic],+  httpHeader :: Maybe [Attribute Dynamic],+  httpData :: Maybe ReQL,+  httpPage :: Maybe PaginationStrategy,+  httpPageLimit :: Maybe P.Int+  }++data HttpResultFormat =+  FormatAuto | FormatJSON | FormatJSONP | FormatBinary++instance Expr HttpResultFormat where+  expr FormatAuto = "auto"+  expr FormatJSON = "json"+  expr FormatJSONP = "jsonp"+  expr FormatBinary = "binary"++data HttpMethod = GET | POST | PUT | PATCH | DELETE | HEAD+                deriving P.Show++instance Expr HttpMethod where+  expr = str P.. P.show++data PaginationStrategy =+  LinkNext |+  PaginationFunction (ReQL -> ReQL)++instance Expr PaginationStrategy where+  expr LinkNext = "link-next"+  expr (PaginationFunction f) = expr f++instance Default HttpOptions where+  def = HttpOptions {+    httpTimeout = Nothing,+    httpReattempts  = Nothing,+    httpRedirects = Nothing,+    httpVerify = Nothing,+    httpResultFormat = Nothing,+    httpMethod = Nothing,+    httpAuth = Nothing,+    httpParams = Nothing,+    httpHeader = Nothing,+    httpData = Nothing,+    httpPage = Nothing,+    httpPageLimit = Nothing+    }++-- | Retrieve data from the specified URL over HTTP+--+-- >>> _ <- run' h $ http "http://httpbin.org/get" def{ httpParams = Just ["foo" := 1] }+-- >>> _ <- run' h $ http "http://httpbin.org/put" def{ httpMethod = Just PUT, httpData = Just $ expr ["foo" := "bar"] }+http :: Expr url => url -> HttpOptions -> ReQL+http url opts = op' HTTP [url] $ render opts+  where+    render ho = +      let+        go :: Expr x => (HttpOptions -> Maybe x) -> Text -> [Attribute Static]+        go f s = maybe [] (\x -> [s := x]) (f ho)+      in mconcat [+        go httpTimeout "timeout",+        go httpReattempts "reattempts",+        go httpRedirects "redirects",+        go httpVerify "verify",+        go httpResultFormat "result_format",+        go httpMethod "method",+        go httpAuth "auth",+        go httpParams "params",+        go httpHeader "header",+        go httpData "data",+        go httpPage "page",+        go httpPageLimit "page_limit"+        ]++-- | Splice a list of values into an argument list+args :: Expr array => array -> ReQL+args a = op ARGS [a]++-- | Return an infinite stream of objects representing changes to a table+--+-- >>> cursor <- run h $ table "posts" # changes :: IO (Cursor Datum)+-- >>> run h $ table "posts" # insert ["author" := "bill", "message" := "bye", "id" := 4] :: IO WriteResponse+-- {inserted:1}+-- >>> next cursor+-- Just {"new_val":{"author":"bill","id":4,"message":"bye"},"old_val":null}+changes :: Expr seq => seq -> ReQL+changes s = op CHANGES [s]++-- | Optional argument for returning an array of objects describing the changes made+--+-- >>> run h $ table "users" # ex insert [returnChanges] ["name" := "sabrina"] :: IO WriteResponse+-- {inserted:1,changes:[{"old_val":null,"new_val":{"name":"sabrina"}}]}+returnChanges :: Attribute a+returnChanges = "return_changes" := P.True++data Durability = Hard | Soft++instance Expr Durability where+  expr Hard = "hard"+  expr Soft = "soft"++-- | Optional argument for soft durability writes+durability :: Durability -> Attribute a+durability d = "durability" := d++-- | Optional argument for non-atomic writes+--+-- >>> run' h $ table "users" # get "sabrina" # update (merge ["lucky_number" := random])+-- *** Exception: RethinkDB: Runtime error: "Could not prove function deterministic.  Maybe you want to use the non_atomic flag?"+--   in+--     {- HERE -}+--     update(+--       get(table(db("doctests"), "users"), "sabrina"),+--       (\b -> merge(b, {lucky_number: random()})))+-- >>> run h $ table "users" # get "sabrina" # ex update [nonAtomic] (merge ["lucky_number" := random]) :: IO WriteResponse+-- {replaced:1}+nonAtomic :: Attribute a+nonAtomic = "non_atomic" := P.True++data ConflictResolution = Error | Replace | Update++instance Expr ConflictResolution where+  expr Error = "error"+  expr Replace = "replace"+  expr Update = "update"++conflict :: ConflictResolution -> Attribute a+conflict cr = "conflict" := cr++uuid :: ReQL+uuid = op UUID ()
+ Database/RethinkDB/Functions.hs-boot view
@@ -0,0 +1,4 @@+module Database.RethinkDB.Functions where+import {-# SOURCE #-} Database.RethinkDB.ReQL+js :: ReQL -> ReQL+apply :: (Expr fun, Expr arg) => fun -> [arg] -> ReQL
+ Database/RethinkDB/Geospatial.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}++module Database.RethinkDB.Geospatial where++import Database.RethinkDB.ReQL+import Database.RethinkDB.Types+import Database.RethinkDB.Wire.Term++-- $setup+--+-- Get the doctests ready+--+-- >>> :set -XOverloadedStrings+-- >>> :load Database.RethinkDB.NoClash+-- >>> import qualified Database.RethinkDB as R+-- >>> import Control.Exception+-- >>> let try' x = (try x `asTypeOf` return (Left (undefined :: SomeException))) >> return ()+-- >>> h <- fmap (use "doctests") $ connect "localhost" 28015 def+-- >>> try' $ run' h $ dbCreate "doctests"+-- >>> try' $ run' h $ tableCreate "places"+-- >>> try' $ run' h $ table "places" # insert ["location" := point (-120) 60]+-- >>> try' $ run' h $ table "places" # insert ["location" := point (-122) 43]+-- >>> try' $ run' h $ table "places" # insert ["location" := point (-91) 44, "area" := polygon [[-124,30],[-113,54],[-80,44]]]+-- >>> try' $ run' h $ table "places" # ex indexCreate ["geo":=True] "location" (!"location")+-- >>> try' $ run' h $ table "places" # ex indexCreate ["geo":=True] "geo" (!"area")++-- | Convert a line object into a polygon+--+-- >>> run' h $ fill $ line [[-122,37], [-120,39], [-121,38]]+-- Polygon<[[-122,37],[-120,39],[-121,38],[-122,37]]>++fill :: Expr line => line -> ReQL+fill l = op FILL [l]++-- | Convert a GeoJSON object into a RethinkDB geometry object+--+-- >>> run' h $ geoJSON ["type" := "Point", "coordinates" := [-45,80]]+-- Point<[-45,80]>++geoJSON :: Expr geojson => geojson -> ReQL+geoJSON g = op GEOJSON [g]++-- | Convert a RethinkDB geometry object into a GeoJSON object+--+-- >>> run' h $ toGeoJSON $ point (-122.423246) 37.779388+-- {"coordinates":[-122.423246,37.779388],"type":"Point"}+toGeoJSON :: Expr geo => geo -> ReQL+toGeoJSON g = op TO_GEOJSON [g]++-- | Search a geospatial index for intersecting objects+--+-- >>> run' h $ table "places" # getIntersecting (point (-122) 37) (Index "geo")+-- []+getIntersecting :: (Expr geo, Expr table) => geo -> Index -> table -> ReQL+getIntersecting g i t = op' GET_INTERSECTING (t, g) $ idx+  where idx = case i of+          PrimaryKey -> []+          Index n -> ["index" := n]++-- | Query a geospatial index for the nearest matches+--+-- >>> run' h $ table "places" # getNearest (point (-122) 37) (Index "location")+-- []+-- >>> run' h $ table "places" # ex getNearest [maxResults 5, maxDist 10, unit Kilometer] (point (-122) 37) (Index "location")+-- []+getNearest :: (Expr point, Expr table) => point -> Index -> table -> ReQL+getNearest p i t = op' GET_NEAREST (t, p) idx+  where idx = case i of+          PrimaryKey -> []+          Index n -> ["index" := n]++-- | Test whether a geometry object includes another+--+-- >>> run' h $ circle (point (-122) 37) 5000 # includes (point (-120) 48)+-- false+includes :: (Expr area, Expr geo) => geo -> area -> ReQL+includes g a = op INCLUDES (a, g)++-- | Test if two geometry objects intersects+--+-- >>> run' h $ intersects (line [[-122,37],[-120,48]]) (line [[-120,49],[-122,48]])+-- false+intersects :: (Expr a, Expr b) => a -> b -> ReQL+intersects a b = op INTERSECTS (b, a)++-- | Create a line object+--+-- >>> run' h $ line [[-73,45],[-122,37]]+-- Line<[-73,45],[-122,37]>+line :: Expr points => points -> ReQL+line p = op LINE [op ARGS [p]]++-- | Create a point objects+--+-- >>> run' h $ point (-73) 40+-- Point<[-73,40]>+point :: (Expr longitude, Expr latitude) => longitude -> latitude -> ReQL+point lon lat = op POINT (lon, lat)++-- | Create a polygon object+--+-- >>> run' h $ polygon [[-73,45],[-122,37],[-73,40]]+-- Polygon<[[-73,45],[-122,37],[-73,40],[-73,45]]>+polygon :: Expr points => points -> ReQL+polygon p = op POLYGON [op ARGS [p]]++-- | Punch a hole in a polygon+--+-- >>> run' h $ (polygon [[-73,45],[-122,37],[-73,40]]) # polygonSub (polygon [[-73.2,40.1],[-73.2,40.2],[-73.3,40.1]])+-- Polygon<[[-73,45],[-122,37],[-73,40],[-73,45]],[[-73.2,40.1],[-73.2,40.2],[-73.3,40.1],[-73.2,40.1]]>+polygonSub :: (Expr polygon, Expr hole) => hole -> polygon -> ReQL+polygonSub h p = op POLYGON_SUB (p, h)++-- | Create a polygon approximating a circle+--+-- >>> run' h $ ex circle [numVertices 6, unit Kilometer] (point (-73) 40) 100+-- Polygon<[[-73,39.099310036015424],[-74.00751390838496,39.54527799206398],[-74.02083610406069,40.445812561599965],[-73,40.900549591978255],[-71.97916389593931,40.445812561599965],[-71.99248609161504,39.54527799206398],[-73,39.099310036015424]]>+circle :: (Expr point, Expr radius) => point -> radius -> ReQL+circle p r = op CIRCLE (p, r)++-- | Distance between a point and another geometry object+--+-- >>> run' h $ distance (point (-73) 40) (point (-122) 37)+-- 4233453.467303547+-- >>> run' h $ ex distance [unit Mile] (point (-73) 40) (point (-122) 37)+-- 2630.54602825968+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++-- | Optional argument for getNearest, circle and distance+unit :: Unit -> Attribute a+unit u = "unit" := u++-- | Optional argument for circle+numVertices :: ReQL -> Attribute a+numVertices n = "num_vertices" := n++data Unit = Meter | Kilometer | Mile | NauticalMile | Foot++instance Expr Unit where+  expr Meter = "m"+  expr Kilometer = "km"+  expr Mile = "mi"+  expr NauticalMile = "nm"+  expr Foot = "ft"
Database/RethinkDB/MapReduce.hs view
@@ -1,137 +1,355 @@ {-# LANGUAGE OverloadedStrings, PatternGuards #-} -module Database.RethinkDB.MapReduce where+module Database.RethinkDB.MapReduce where -- (termToMapReduce) where  import Control.Monad.State import Control.Monad.Writer import qualified Data.Text as T import Data.Maybe--import Database.RethinkDB.Protobuf.Ql2.Term.TermType-import qualified Database.RethinkDB.Protobuf.Ql2.Datum as Datum+import Data.Foldable (toList) +import Database.RethinkDB.Wire.Term import Database.RethinkDB.ReQL-import Database.RethinkDB.Objects+import Database.RethinkDB.Types -termToMapReduce ::-  (ReQL -> ReQL) -> State QuerySettings (ReQL -> ReQL, ReQL -> ReQL -> ReQL, Maybe (ReQL -> ReQL))+import qualified Database.RethinkDB.Functions as R+import Database.RethinkDB.NoClash hiding (get, collect, args)+import Database.RethinkDB.Datum++-- | Takes a function that takes a sequence as an argument, and+-- returns a function that only uses that sequence once, by merging+-- the map and reduce operations. This is used by groupBy.+termToMapReduce :: (ReQL -> ReQL) -> State QuerySettings (ReQL -> ReQL) termToMapReduce f = do+  +  -- A variable is introduced to represent the sequence that f+  -- is being performed on. This variable is no longer present+  -- in the return value   v <- newVarId-  body <- baseReQL $ f (op VAR [v] ())-  return . toReduce $ toMapReduce v body--toReduce :: MapReduce -> (ReQL -> ReQL, ReQL -> ReQL -> ReQL, Maybe (ReQL -> ReQL))-toReduce (None t) = (\_ -> expr (), \_ _ -> expr (), Just $ const t)-toReduce (Map m) = ((\x -> expr [x]) . m, unionReduce, Nothing)-toReduce (MapReduce m r f) = (m, r, f)--unionReduce :: ReQL -> ReQL -> ReQL-unionReduce a b = op UNION (a, b) ()+  body <- runReQL $ f (op VAR [v])+  +  return . applyChain $ toMapReduce v body -sameVar :: Int -> BaseArray -> Bool-sameVar x [BaseReQL DATUM (Just (Datum.Datum{ Datum.r_num = Just y })) _ _] =-  fromIntegral x == y+-- | Compares the two representations of a variable+sameVar :: Int -> [Term] -> Bool+sameVar x [Datum d] | Success y <- fromDatum d = x == y sameVar _ _ = False -notNone :: MapReduce -> Bool-notNone None{} = False-notNone _ = True+-- | notNone checks that it is a map/reduce and not a constant+notConst :: Chain -> Bool+notConst None{} = False+notConst SingletonArray{} = False+notConst _ = True -wrap :: BaseReQL -> ReQL+-- | Helper function for casting up from Term into ReQL+wrap :: Term -> ReQL wrap = ReQL . return -toFun1 :: ReQL -> (ReQL -> ReQL)-toFun1 f a = op FUNCALL (f, a) ()+-- | Build a single argument function from a constant ReQL expression+toFun1 :: Term -> (ReQL -> ReQL)+toFun1 f a = op FUNCALL (wrap f, a) -toFun2 :: ReQL -> (ReQL -> ReQL -> ReQL)-toFun2 f a b = op FUNCALL (f, a, b) ()+-- | Build a two argument function from a constant ReQL expression+toFun2 :: Term -> (ReQL -> ReQL -> ReQL)+toFun2 f a b = op FUNCALL (wrap f, a, b) -toMapReduce :: Int -> BaseReQL -> MapReduce-toMapReduce _ t@(BaseReQL DATUM _ _ _) = None $ wrap t-toMapReduce v (BaseReQL VAR _ w _) | sameVar v w = Map id-toMapReduce v t@(BaseReQL type' _ args optargs) = let-    args' = map (toMapReduce v) args-    optargs' = map (\(BaseAttribute k vv) -> (k, toMapReduce v vv)) optargs-    count = length $ filter notNone $ args' ++ map snd optargs'-    rebuild = (if count == 1 then rebuild0 else rebuildx) type' args' optargs'-  in if count == 0 then None $ wrap t-     else if not $ count == 1-          then rebuild else-              case (type', args', optargs') of-                (MAP, [Map m, None f], []) -> Map (toFun1 f . m)-                (REDUCE, [Map m, None f], _) | Just mbase <- optargsToBase optargs ->-                  MapReduce m (toFun2 f) (fmap (toFun2 f) mbase)-                (COUNT, [Map _], []) ->-                  MapReduce (const (num 1)) (\a b -> op ADD (a, b) ()) Nothing-                (tt, (Map m : _), _) | tt `elem` mappableTypes ->-                  (Map ((\x -> op tt (expr x : map expr (tail args)) (noRecurse : map baseAttrToAttr optargs)) . m))-                _ -> rebuild+-- | Represents a map/reduce operation split into its map and reduce parts+data MRF = MRF {+      _mrfMapFun :: MapFun,+      _mrfReduceFun :: ReQL -> ReQL -> ReQL,+      _mrfBase :: Maybe ReQL,+      _mrfFinally :: ReQL -> ReQL } -optargsToBase :: [BaseAttribute] -> Maybe (Maybe ReQL)-optargsToBase [] = Just Nothing-optargsToBase [BaseAttribute "base" b] = Just (Just $ ReQL $ return b)-optargsToBase _ = Nothing+-- | A Chain of ReQL expressions that might be transformed into+-- a map/reduce operation+data Chain =+  +  -- | A constant, not really a map/reduce operation+  None ReQL |+  +  -- | Just a map+  Map [Map] |+  +  -- | map/reduce operations represented as parts+  MapReduceChain [Map] Reduce |+  +  -- | A rewritten map/reduce+  MapReduce MRF |+  +  -- | Special cases for reduce with base+  SingletonArray ReQL |+  AddBase ReQL Chain -baseAttrToAttr :: BaseAttribute -> Attribute-baseAttrToAttr (BaseAttribute k v) = k := v+-- | A built-in map operation+data Map =+  BuiltInMap TermType [ReQL] [OptArg] MapFun -noRecurse :: Attribute-noRecurse = "_NO_RECURSE_" := True+data MapFun =+  MapFun (ReQL -> ReQL) |+  ConcatMapFun (ReQL -> ReQL) -mappableTypes :: [TermType]-mappableTypes = [GET_FIELD, PLUCK, WITHOUT, MERGE, HAS_FIELDS]+data Reduce =+  BuiltInReduce TermType [ReQL] [OptArg] MRF -data MapReduce =-    None ReQL |-    Map (ReQL -> ReQL) |-    MapReduce (ReQL -> ReQL) (ReQL -> ReQL -> ReQL) (Maybe (ReQL -> ReQL))+-- | Convert a Chain back into a ReQL function+applyChain :: Chain -> (ReQL -> ReQL)+applyChain (None t) x = op FUNCALL (t, x)+applyChain (Map maps) s = applyMaps maps s+applyChain (MapReduceChain maps red) s =+  applyReduce red $ applyMaps maps s+applyChain (MapReduce mrf) s = applyMRF mrf s+applyChain (SingletonArray x) s = op FUNCALL (op MAKE_ARRAY [x], s)+applyChain (AddBase b c) s = applyChain c s `union` [b] -rebuild0 :: TermType -> [MapReduce] -> [(T.Text, MapReduce)] -> MapReduce-rebuild0 ttype args optargs = MapReduce maps reduce finals where-  (finally2, [mr]) = extract Nothing ttype args optargs-  (maps, reduce, finally1) = toReduce mr-  finals = Just $ maybe finally2 (finally2 .) finally1+-- | Convert an MRF into a ReQL function+applyMRF :: MRF -> ReQL -> ReQL+applyMRF (MRF m r Nothing f) s = f `apply` [reduce r (applyMapFun m s)]+applyMRF (MRF m r (Just base) f) s =+  f $+  apply (\x -> branch (isEmpty x) base (x R.! 0)) . return $+  reduce (\a b -> [a R.! 0 `r` b R.! 0]) $+  R.map (\x -> [x]) $+  applyMapFun m s -rebuildx :: TermType -> [MapReduce] -> [(Key, MapReduce)] -> MapReduce-rebuildx ttype args optargs = MapReduce maps reduces finallys where-  (finally, mrs) = extract (Just 0) ttype args optargs-  index = zip ([0..] :: [Int])-  triplets = map toReduce mrs-  maps x = expr $ map (($ x) . fst3) triplets-  reduces a b = expr $ map (uncurry $ mkReduce a b) . index $ map snd3 triplets-  finallys = let fs = map thrd3 triplets in-    if all isNothing fs-       then Just finally-       else Just $ \x -> finally $ expr $ map (uncurry $ mkFinally x) . index $-                         map (fromMaybe id) fs-  mkReduce a b i f = f (op NTH (a, i) ()) (op NTH (b, i) ())-  mkFinally x i f = f (op NTH (x, i) ())+applyMaps :: [Map] -> ReQL -> ReQL+applyMaps maps s = foldr applyMap s maps -fst3 :: (a,b,c) -> a-fst3 (a,_,_) = a+applyMap :: Map -> ReQL -> ReQL+applyMap (BuiltInMap tt a oa _) s = op' tt (s : a) oa -snd3 :: (a,b,c) -> b-snd3 (_,b,_) = b+applyMapFun :: MapFun -> ReQL -> ReQL +applyMapFun (MapFun f) = R.map f+applyMapFun (ConcatMapFun f) = R.concatMap f -thrd3 :: (a,b,c) -> c-thrd3 (_,_,c) = c +applyReduce :: Reduce -> ReQL -> ReQL+applyReduce (BuiltInReduce tt a oa _) s = op' tt (s : a) oa++chainToMRF :: Chain -> Either ReQL MRF+chainToMRF (None t) = Left t+chainToMRF (Map maps) = Right $ maps `thenMRF` collect+chainToMRF (MapReduceChain maps red) = Right $ maps `thenReduce` red+chainToMRF (MapReduce mrf) = Right $ mrf+chainToMRF (SingletonArray x) = Left $ op MAKE_ARRAY [x]+chainToMRF (AddBase b c) = fmap (`thenFinally` \x -> op UNION [b, x]) $ chainToMRF c++thenFinally :: MRF -> (ReQL -> ReQL) -> MRF+thenFinally (MRF m r b f1) f2 = MRF m r b $ f2 . f1++thenMRF :: [Map] -> MRF -> MRF+thenMRF maps (MRF m r b f) =+  MRF (m `composeMapFun` composeMaps maps) r b f++composeMaps :: [Map] -> MapFun+composeMaps = foldr composeMapFun (MapFun id) . map getMapFun+  where getMapFun (BuiltInMap _ _ _ mf) = mf++composeMapFun :: MapFun -> MapFun -> MapFun+composeMapFun (MapFun       f) (MapFun       g) = MapFun (f . g)+composeMapFun (ConcatMapFun f) (MapFun       g) = ConcatMapFun (f . g)+composeMapFun (MapFun       f) (ConcatMapFun g) = ConcatMapFun (R.map f . g)+composeMapFun (ConcatMapFun f) (ConcatMapFun g) = ConcatMapFun (R.concatMap f . g)++thenReduce :: [Map] -> Reduce -> MRF+thenReduce maps (BuiltInReduce _ _ _ mrf) = maps `thenMRF` mrf++collect :: MRF+collect = MRF (MapFun $ \x -> expr [x]) union (Just (expr ())) id++-- | Rewrites the term in the second argument to merge all uses of the+-- variable whose id is given in the first argument.+toMapReduce :: Int -> Term -> Chain++toMapReduce v (Note _ t) = toMapReduce v t -- TODO: keep notes++-- Singletons are singled out+toMapReduce _ (Datum (Array a))+  | [datum] <- toList a =+    SingletonArray . wrap $ Datum datum++-- A datum stays constant+toMapReduce _ t@(Datum _) = None $ wrap t++-- The presence of the variable +toMapReduce v (Term VAR w _) | sameVar v w = Map []++-- An arbitrary term+toMapReduce v t@(Term type' args optargs) = let+  +  -- Recursively convert all arguments+  args' = map (toMapReduce v) args+  optargs' = map (\(TermAttribute k vv) -> (k, toMapReduce v vv)) optargs+  +  -- Count how many of the arguments have been rewritten+  nb = length $ filter notConst $ args' ++ map snd optargs'+  +  -- Rewrite the current term. rewrite1 is optimised for+  -- the single count case+  rewrite = MapReduce $+            (if nb == 1 then rewrite1 else rewritex) type' args' optargs'+  +  in case nb of+    -- Special case for singleton arrays+    0 | Just sing <- singleton type' args' optargs -> SingletonArray sing+    +    -- Special case for snoc+    1 | UNION <- type', [x, SingletonArray s] <- args', [] <- optargs'+      -> AddBase s x++    -- Don't rewrite if there is nothing to rewrite+    0 -> None $ wrap t+    +    -- Don't rewrite an operation that can be chained+    1 | (arg1 : _) <- args', notConst arg1 -> do+      fromMaybe rewrite $ mrChain type' arg1 (tail args) optargs+         +    -- Default to rewriting the term+    _ -> rewrite++singleton :: TermType -> [Chain] -> [TermAttribute] -> Maybe ReQL+singleton MAKE_ARRAY [None el] [] = Just el+singleton _ _ _ = Nothing++-- | Chain a ReQL command onto a MapReduce operation+mrChain :: TermType -> Chain -> [Term] -> [TermAttribute] -> Maybe Chain++mrChain REDUCE (AddBase base (Map maps)) [f] [] =+  Just $+  MapReduceChain maps $+  BuiltInReduce REDUCE [wrap f] [] $+  MRF (MapFun id) (toFun2 f) (Just base) id++-- | A built-in map+mrChain tt (Map maps) args optargs+    | Just mrf <- mapMRF tt args optargs =+       Just . Map . (: maps) $+            BuiltInMap tt (map wrap args) (map baseAttrToOptArg optargs) mrf++-- | A built-in reduction+mrChain tt (Map maps) args optargs+    | Just mrf <- reduceMRF tt args optargs =+        Just . MapReduceChain maps $+             BuiltInReduce tt (map wrap args) (map baseAttrToOptArg optargs) mrf++mrChain _ _ _ _ = Nothing++-- | Convert some builtin operations into a map+mapMRF :: TermType -> [Term] -> [TermAttribute]+            -> Maybe MapFun+mapMRF MAP [f] [] = Just . MapFun $ toFun1 f+mapMRF PLUCK ks [] =+  Just . MapFun $ \s -> op' PLUCK (s : map wrap ks) [noRecurse]+mapMRF WITHOUT ks [] =+    Just . MapFun $ \s -> op' WITHOUT (s : map wrap ks) [noRecurse]+mapMRF MERGE [b] [] =+  Just . MapFun $ \s -> op' MERGE [s,  wrap b] [noRecurse]+mapMRF CONCATMAP [f] [] = Just . ConcatMapFun $ toFun1 f+mapMRF FILTER [f] [] =+  Just . ConcatMapFun $ \x -> branch (toFun1 f x # handle (const False)) x ()+mapMRF FILTER [f] [TermAttribute "default" defval] =+    Just . ConcatMapFun $ \x -> branch (toFun1 f x # handle (const defval)) x ()+mapMRF GET_FIELD [attr] [] =+  Just . ConcatMapFun $ \x ->+  branch (op' HAS_FIELDS (x, wrap attr) [noRecurse])+  [op' GET_FIELD (x, attr) [noRecurse]] ()+mapMRF HAS_FIELDS sel [] =+  Just . ConcatMapFun $ \x ->+  branch (op' HAS_FIELDS (x : map wrap sel) [noRecurse]) [x] ()+mapMRF WITH_FIELDS sel [] =+  Just . ConcatMapFun $ \x ->+  branch (op' HAS_FIELDS (x : map wrap sel) [noRecurse])+  [op' PLUCK (x : map wrap sel) [noRecurse]] ()+mapMRF _ _ _ = Nothing++-- | Convert some of the built-in operations into a map/reduce+--+-- TODO: these have not been tested+reduceMRF :: TermType -> [Term] -> [TermAttribute]+            -> Maybe MRF+reduceMRF REDUCE [f] [] = Just $ MRF (MapFun id) (toFun2 f) Nothing id+reduceMRF COUNT [] [] = Just $ MRF (MapFun $ const (num 1)) (\a b -> op ADD (a, b)) (Just 0) id+reduceMRF AVG [] [] =+    Just $ MRF (MapFun $ \x -> expr [x, 1])+             (\a b -> expr [a R.! 0 R.+ b R.! 0, a R.! 1 R.+ b R.! 1])+             Nothing+             (\x -> x R.! 0 R./ x R.! 1)+reduceMRF SUM [] [] = Just $ MRF (MapFun id) (R.+) (Just 0) id+reduceMRF SUM [sel] [] = Just $ MRF (MapFun $ toFun1 sel) (R.+) (Just 0) id+reduceMRF MIN [] [] = Just $ MRF (MapFun id) (\a b -> branch (a R.< b) a b) Nothing id+reduceMRF MIN [sel] [] =+    Just $ MRF (MapFun $ \x -> expr [x, toFun1 sel x])+             (\a b -> branch (a R.! 1 R.< b R.! 1) a b)+             Nothing+             (R.! 0)+reduceMRF MAX [] [] = Just $ MRF (MapFun id) (\a b -> branch (a R.> b) a b) Nothing id+reduceMRF MAX [sel] [] =+    Just $ MRF (MapFun $ \x -> expr [x, toFun1 sel x])+             (\a b -> branch (a R.! 1 R.> b R.! 1) a b)+             Nothing+             (R.! 0)+reduceMRF DISTINCT [] [] = Just $ MRF (MapFun $ \a -> expr [a]) (\a b -> distinct (a `union` b)) (Just (expr ())) id+reduceMRF _ _ _ = Nothing++-- | Convert from one representation to the other+baseAttrToOptArg :: TermAttribute -> OptArg+baseAttrToOptArg (TermAttribute k v) = k := v++-- | This undocumented optional argument circumvents stream+-- polymorphism on some operations+noRecurse :: OptArg+noRecurse = "_NO_RECURSE_" := True++-- | Rewrite a command into a map/reduce.+--+-- This is a special case for when only one of the arguments+-- is itself a map/reduce+rewrite1 :: TermType -> [Chain] -> [(T.Text, Chain)] -> MRF+rewrite1 ttype args optargs = MRF maps red mbase finals where+  (finally2, [mr]) = extract Nothing ttype args optargs+  MRF maps red mbase fin1 = mr+  finals = finally2 . fin1++-- | Rewrite a command that combines the result of multiple map/reduce+-- operations into a single map/reduce operation+rewritex :: TermType -> [Chain] -> [(Key, Chain)] -> MRF+rewritex ttype args optargs = MRF maps reduces Nothing finallys where+  (finally, mrs) = extract (Just 0) ttype args optargs+  index = zip $ map expr ([0..] :: [Int])+  maps = MapFun $ \x -> expr $ map (($ x) . getMapFun) mrs+  reduces a b = expr $ map (uncurry $ mkReduce a b) . index $ map getReduceFun mrs+  finallys = let fs = map getFinallyFun mrs in+       \x -> finally . expr . map (uncurry $ mkFinally x) $ index fs+  mkReduce a b i f = f (a!i) (b!i)+  mkFinally x i f = f (x!i)+  getMapFun (MRF (MapFun f) _ _ _) = f+  getMapFun (MRF (ConcatMapFun f) _ _ _) = f+  getReduceFun (MRF (MapFun _) f _ _) = f+  getReduceFun (MRF (ConcatMapFun _) f _ _) =+    \a b -> flip apply [a `union` b] $ \l ->+      branch (isEmpty l) () [reduce f l]+  getFinallyFun (MRF (MapFun _) _ _ f) = f+  getFinallyFun (MRF (ConcatMapFun _) _ mbase f) =+    f . maybe (R.! 0) (\base s ->+                        flip apply [s] $ handle (const base) $ s R.! 0) mbase++-- | Extract the inner map/reduce objects, also returning a function+-- which, given the result of all the map/reduce operations, returns+-- the result of the given command extract ::-  Maybe Int -> TermType -> [MapReduce] -> [(Key, MapReduce)]-  -> (ReQL -> ReQL, [MapReduce])+  Maybe Int -> TermType -> [Chain] -> [(Key, Chain)]+  -> (ReQL -> ReQL, [MRF]) extract st tt args optargs = fst $ flip runState st $ runWriterT $ do   args' <- sequence $ map extractOne args   optargvs' <- sequence $ map extractOne (map snd optargs)   let optargks = map fst optargs-  return $ \v -> op tt (map ($ v) args') (zipWith (:=) optargks $ map ($ v) optargvs')--extractOne :: MapReduce -> WriterT [MapReduce] (State (Maybe Int)) (ReQL -> ReQL)-extractOne (None term) = return $ const term-extractOne mr = do-  tell [mr]-  st <- get-  case st of-    Nothing -> return id-    Just n -> do-      put $ Just $ n + 1-      return $ \v -> op NTH (v, n) ()+  return $ \v -> op' tt (map ($ v) args') (zipWith (:=) optargks $ map ($ v) optargvs')+    where+      extractOne chain = either (return . const) go $ chainToMRF chain+      go mrf = do+        tell [mrf]+        st' <- get+        case st' of+          Nothing -> return id+          Just n -> do+            put $ Just $ n + 1+            return $ \v -> v ! expr n
+ Database/RethinkDB/MapReduce.hs-boot view
@@ -0,0 +1,4 @@+module Database.RethinkDB.MapReduce (termToMapReduce) where+import Control.Monad.State+import Database.RethinkDB.ReQL+termToMapReduce :: (ReQL -> ReQL) -> State QuerySettings (ReQL -> ReQL)
Database/RethinkDB/Network.hs view
@@ -1,94 +1,104 @@-{-# LANGUAGE RecordWildCards, OverloadedStrings, DeriveDataTypeable, NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards, OverloadedStrings, DeriveDataTypeable, NamedFieldPuns, PatternGuards #-} +-- TODO: the code sends an extra query after getting SUCCESS_ATOM when doing e.g. (expr 1)+ module Database.RethinkDB.Network (   RethinkDBHandle(..),   connect,   close,   use,   runQLQuery,-  Cursor,+  Cursor(..),   makeCursor,   next,+  nextBatch,   collect,+  collect',   nextResponse,   Response(..),-  SuccessCode(..),   ErrorCode(..),   RethinkDBError(..),   RethinkDBConnectionError(..),+  More,+  noReplyWait,+  each   ) where -import Control.Monad (when, forever)+import Control.Monad (when, forever, forM_) import Data.Typeable (Typeable) import Network (HostName, connectTo, PortID(PortNumber))-import System.IO (Handle, hClose, hIsEOF)-import Data.ByteString.Lazy (pack, unpack, hPut, hGet, ByteString)+import System.IO (Handle, hClose, hIsEOF, hSetBuffering, BufferMode(..))+import Data.ByteString.Lazy (hPut, hGet, ByteString) import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.UTF8 as BS (fromString)-import qualified Data.Text as T import Control.Concurrent (   writeChan, MVar, Chan, modifyMVar, takeMVar, forkIO, readChan,   myThreadId, newMVar, ThreadId, newChan, killThread,   newEmptyMVar, putMVar, mkWeakMVar)-import Data.Bits (shiftL, (.|.), shiftR)-import Data.Monoid ((<>))-import Data.Foldable hiding (forM_)+import Data.Monoid((<>)) import Control.Exception (catch, Exception, throwIO, SomeException(..))-import Data.Aeson (toJSON, object, (.=), Value(Null, Bool)) import Data.IORef (IORef, newIORef, atomicModifyIORef', readIORef, writeIORef) import Data.Map (Map) import qualified Data.Map as M-import Data.Maybe (fromMaybe, listToMaybe)+import Data.Maybe (fromMaybe, listToMaybe, isNothing) import Control.Monad.Fix (fix)-import Data.Int (Int64) import System.IO.Unsafe (unsafeInterleaveIO) import System.Mem.Weak (finalize)--import Text.ProtocolBuffers.Basic (uToString)-import Text.ProtocolBuffers (messagePut, defaultValue, messageGet)--import Database.RethinkDB.Protobuf.Ql2.Query as Query-import Database.RethinkDB.Protobuf.Ql2.Query.QueryType-import qualified Database.RethinkDB.Protobuf.Ql2.Response as Ql2-import Database.RethinkDB.Protobuf.Ql2.Response.ResponseType-import Database.RethinkDB.Protobuf.Ql2.Datum as Datum-import Database.RethinkDB.Protobuf.Ql2.Datum.DatumType-import Database.RethinkDB.Protobuf.Ql2.Datum.AssocPair-import Database.RethinkDB.Protobuf.Ql2.VersionDummy.Version+import Data.Binary.Get (runGet, getWord32le, getWord64le)+import Data.Binary.Put (runPut, putWord32le, putWord64le, putLazyByteString)+import Data.Word (Word64, Word32)+import qualified Data.HashMap.Strict as HM -import Database.RethinkDB.Objects as O+import Database.RethinkDB.Wire+import Database.RethinkDB.Wire.Response+import Database.RethinkDB.Wire.Query+import Database.RethinkDB.Wire.VersionDummy as Protocol+import Database.RethinkDB.Types+import Database.RethinkDB.Datum import Database.RethinkDB.ReQL (-  BaseReQL, Backtrace, convertBacktrace)+  Term, Backtrace, convertBacktrace, WireQuery(..),+  WireBacktrace(..), Term(..), Frame(..),+  TermAttribute(..))+import Data.Foldable (toList) -type Token = Int64+-- $setup+--+-- Get the doctests ready+--+-- >>> import qualified Database.RethinkDB as R+-- >>> import Database.RethinkDB.NoClash+-- >>> h' <- unsafeInterleaveIO $ connect "localhost" 28015 def+-- >>> let h = use "doctests" h' +type Token = Word64+ -- | A connection to the database server data RethinkDBHandle = RethinkDBHandle {   rdbHandle :: Handle,   rdbWriteLock :: MVar (Maybe SomeException),   rdbToken :: IORef Token, -- ^ The next token to use   rdbDatabase :: Database,  -- ^ The default database-  rdbWait :: IORef (Map Token (Chan Response, BaseReQL, IO ())),+  rdbWait :: IORef (Map Token (Chan Response, Term, IO ())),   rdbThread :: ThreadId   }  data Cursor a = Cursor {   cursorMBox :: MVar Response,-  cursorBuffer :: MVar (Either RethinkDBError ([O.Datum], Bool)),-  cursorMap :: O.Datum -> a }+  cursorBuffer :: MVar (Either RethinkDBError ([Datum], Bool)),+  cursorMap :: Datum -> IO a }  instance Functor Cursor where-  fmap f Cursor{ .. } = Cursor { cursorMap = f . cursorMap, .. }+  fmap f Cursor{ .. } = Cursor { cursorMap = fmap f . cursorMap, .. }  instance Show RethinkDBHandle where   show RethinkDBHandle{ rdbHandle } = "RethinkDB Connection " ++ show rdbHandle -newToken :: RethinkDBHandle -> IO Int64+newToken :: RethinkDBHandle -> IO Token newToken RethinkDBHandle{rdbToken} =   atomicModifyIORef' rdbToken $ \x -> (x+1, x)  data RethinkDBConnectionError =-  RethinkDBConnectionError ByteString+  RethinkDBConnectionError String   deriving (Show, Typeable) instance Exception RethinkDBConnectionError @@ -100,13 +110,16 @@  connect :: HostName -> Integer -> Maybe String -> IO RethinkDBHandle connect host port mauth = do-  h <- connectTo host (PortNumber (fromInteger port))-  hPut h magicNumber   let auth = B.fromChunks . return . BS.fromString $ fromMaybe "" mauth-  hPut h $ packUInt (fromIntegral $ B.length auth)-  hPut h auth+  h <- connectTo host (PortNumber (fromInteger port))+  hSetBuffering h NoBuffering+  hPut h $ runPut $ do+    putWord32le magicNumber+    putWord32le (fromIntegral $ B.length auth)+    putLazyByteString auth+    putWord32le $ fromIntegral $ toWire Protocol.JSON   res <- hGetNullTerminatedString h-  when (res /= "SUCCESS") $ throwIO (RethinkDBConnectionError res)+  when (res /= "SUCCESS") $ throwIO (RethinkDBConnectionError $ show res)   r <- newIORef 1   let db' = Database "test"   wlock <- newMVar Nothing@@ -124,24 +137,8 @@       if c == B.pack [0] then return acc else         go (acc <> c) -magicNumber :: ByteString-magicNumber = packUInt $ fromEnum V0_2---- | Convert a 4-byte byestring to an int-unpackUInt :: ByteString -> Maybe Int-unpackUInt s = case unpack s of-  [a,b,c,d] -> Just $-               fromIntegral a .|.-               fromIntegral b `shiftL` 8 .|.-               fromIntegral c `shiftL` 16 .|.-               fromIntegral d `shiftL` 24-  _ -> Nothing---- | Convert an int to a 4-byte bytestring-packUInt :: Int -> B.ByteString-packUInt n = pack $ map fromIntegral $-               [n `mod` 256, (n `shiftR` 8) `mod` 256,-                (n `shiftR` 16) `mod` 256, (n `shiftR` 24) `mod` 256]+magicNumber :: Word32+magicNumber = fromIntegral $ toWire V0_3  withHandle :: RethinkDBHandle -> (Handle -> IO a) -> IO a withHandle RethinkDBHandle{ rdbHandle, rdbWriteLock } f =@@ -154,19 +151,45 @@  data RethinkDBError = RethinkDBError {   errorCode :: ErrorCode,-  errorTerm :: BaseReQL,+  errorTerm :: Term,   errorMessage :: String,   errorBacktrace :: Backtrace-  } deriving (Typeable, Show)+  } deriving (Typeable)  instance Exception RethinkDBError --- | The raw response to a query-data Response = ErrorResponse {-  errorResponse :: RethinkDBError-  } | SuccessResponse {-  successCode :: SuccessCode,-  successDatums :: [O.Datum]+instance Show RethinkDBError where+  show (RethinkDBError code term message backtrace) =+    show code ++ ": " ++ show message ++ "\n" +++    indent ("in " ++ show (annotate backtrace term))+    where+      indent = (\x -> case x of [] -> []; _ -> init x) . unlines . map ("  "++) . lines +      annotate :: Backtrace -> Term -> Term+      annotate (x : xs) t | Just new <- inside x t (annotate xs) = new+      annotate _ t = Note "HERE" t+      inside (FramePos n) (Term tt a oa) f+        | n < length a = Just $ Term tt (take n a ++ [f (a!!n)] ++ drop (n+1) a) oa+      inside (FrameOpt k) (Term tt a oa) f+        | Just (before, v, after) <- extract k oa =+          Just $ Term tt a $ before ++ [TermAttribute k (f v)] ++ after+      inside _ _ _ = Nothing+      extract _ [] = Nothing+      extract k (TermAttribute kk v : xs) | k == kk = Just ([], v, xs)+      extract k (x:xs) =+        case extract k xs of+          Nothing -> Nothing+          Just (a,b,c) -> Just (x:a,b,c)++-- | The response to a query+data Response =+  ResponseError RethinkDBError |+  ResponseSingle Datum |+  ResponseBatch (Maybe More) [Datum]++data More = More {+  _moreFeed :: Bool,+  _moreHandle :: RethinkDBHandle, +  _moreToken :: Token   }  data ErrorCode =@@ -176,51 +199,74 @@   ErrorUnexpectedResponse  instance Show ErrorCode where-  show ErrorBrokenClient = "broken client error"-  show ErrorBadQuery = "malformed query error"-  show ErrorRuntime = "runtime error"-  show ErrorUnexpectedResponse = "unexpected response"--data SuccessCode =-  SuccessPartial RethinkDBHandle Int64 |-  Success-  deriving Show+  show ErrorBrokenClient = "RethinkDB: Broken client error"+  show ErrorBadQuery = "RethinkDB: Malformed query error"+  show ErrorRuntime = "RethinkDB: Runtime error"+  show ErrorUnexpectedResponse = "RethinkDB: Unexpected response"  instance Show Response where-  show (ErrorResponse RethinkDBError {..}) =+  show (ResponseError RethinkDBError {..}) =     show errorCode ++ ": " ++     show errorMessage ++ " (" ++     show errorBacktrace ++ ")"-  show SuccessResponse {..} = show successCode ++ ": " ++ show successDatums+  show (ResponseSingle datum) = show datum+  show (ResponseBatch _more batch) = show batch -convertResponse :: RethinkDBHandle -> BaseReQL -> Int64 -> Ql2.Response -> Response-convertResponse h q t Ql2.Response{ .. } = case type' of-  Just SUCCESS_ATOM -> SuccessResponse Success (map convertDatum r)-  Just SUCCESS_PARTIAL -> SuccessResponse (SuccessPartial h t) (map convertDatum r)-  Just SUCCESS_SEQUENCE -> SuccessResponse Success (map convertDatum r)-  Just CLIENT_ERROR -> ErrorResponse $ RethinkDBError ErrorBrokenClient q e bt-  Just COMPILE_ERROR -> ErrorResponse $ RethinkDBError ErrorBadQuery q e bt-  Just RUNTIME_ERROR -> ErrorResponse $ RethinkDBError ErrorRuntime q e bt-  Nothing -> ErrorResponse $ RethinkDBError ErrorUnexpectedResponse q e bt-  where-    bt = maybe [] convertBacktrace backtrace-    r = toList response-    e = maybe "" uToString $ r_str =<< listToMaybe (toList response)-        -- TODO: nicer backtrace+newtype WireResponse = WireResponse { _responseDatum :: Datum } -runQLQuery :: RethinkDBHandle -> Query -> BaseReQL -> IO (MVar Response)+convertResponse :: RethinkDBHandle -> Term -> Token -> WireResponse -> Response+convertResponse h q t (WireResponse (Object o)) = let+  type_    = o .? "t" >>= fromWire+  results :: Maybe [Datum]+  results  = o .? "r"+  bt       = o .? "b" --> maybe [] (convertBacktrace . WireBacktrace)+  -- _profile = o .? "p" -- TODO+  atom :: Maybe Datum+  atom     = case results of Just [single] -> Just single; _ -> Nothing+  m .? k   = HM.lookup k m >>= resultToMaybe . fromDatum+  (-->) = flip ($)+  e = fromMaybe "" $ resultToMaybe . fromDatum =<< listToMaybe =<< results+  _ <!< Nothing = ResponseError $ RethinkDBError ErrorUnexpectedResponse q e bt+  f <!< (Just a) = f a+  in case type_ of+  Just SUCCESS_ATOM -> ResponseSingle <!< atom+  Just SUCCESS_PARTIAL -> ResponseBatch (Just $ More False h t) <!< results+  Just SUCCESS_FEED -> ResponseBatch (Just $ More True h t) <!< results+  Just SUCCESS_SEQUENCE -> ResponseBatch Nothing <!< results+  Just CLIENT_ERROR -> ResponseError $ RethinkDBError ErrorBrokenClient q e bt+  Just COMPILE_ERROR -> ResponseError $ RethinkDBError ErrorBadQuery q e bt+  Just RUNTIME_ERROR -> ResponseError $ RethinkDBError ErrorRuntime q e bt+  Just WAIT_COMPLETE -> ResponseSingle (toDatum True)+  Nothing -> ResponseError $ RethinkDBError ErrorUnexpectedResponse q e bt++convertResponse _ q _ (WireResponse json) =+  ResponseError $+  RethinkDBError ErrorUnexpectedResponse q ("Response is not a JSON object: " ++ show json) []++runQLQuery :: RethinkDBHandle -> WireQuery -> Term -> IO (MVar Response) runQLQuery h query term = do   tok <- newToken h-  mbox <- addMBox h tok term-  sendQLQuery h query{ Query.token = Just tok }+  let noReply = isNoReplyQuery query+  mbox <- if noReply+          then newEmptyMVar+          else addMBox h tok term+  sendQLQuery h tok query+  when noReply $ putMVar mbox $ ResponseSingle $ Null   return mbox -addMBox :: RethinkDBHandle -> Token -> BaseReQL -> IO (MVar Response)+isNoReplyQuery :: WireQuery -> Bool+isNoReplyQuery (WireQuery (Array v)) |+  [_type, _term, (Object optargs)] <- toList v,+  Just (Bool True) <- HM.lookup "noreply" optargs =+    True+isNoReplyQuery _ = False++addMBox :: RethinkDBHandle -> Token -> Term -> IO (MVar Response) addMBox h tok term = do   chan <- newChan   mbox <- newEmptyMVar   weak <- mkWeakMVar mbox $ do-    closeToken h tok+    closeToken h tok -- TODO: don't close if already closed     atomicModifyIORef' (rdbWait h) $ \mboxes ->       (M.delete tok mboxes, ())   atomicModifyIORef' (rdbWait h) $ \mboxes ->@@ -233,11 +279,14 @@       loop   return mbox -sendQLQuery :: RethinkDBHandle -> Query -> IO ()-sendQLQuery h query = do-  let queryS = messagePut query-  withHandle h $ \s ->-    hPut s $ packUInt (fromIntegral $ B.length queryS) <> queryS+sendQLQuery :: RethinkDBHandle -> Token -> WireQuery -> IO ()+sendQLQuery h tok query = do+  let queryS = encode $ queryJSON query+  withHandle h $ \s -> do+    hPut s $ runPut $ do+      putWord64le tok+      putWord32le (fromIntegral $ B.length queryS)+      putLazyByteString queryS   data RethinkDBReadError =   RethinkDBReadError SomeException@@ -256,21 +305,24 @@  readSingleResponse :: RethinkDBHandle -> IO () readSingleResponse h = do+  tokenString <- hGet (rdbHandle h) 8+  when (B.length tokenString /= 8) $+    throwIO $ RethinkDBConnectionError "RethinkDB connection closed unexpectedly"+  let token = runGet getWord64le tokenString   header <- hGet (rdbHandle h) 4-  replyLength <--    maybe (fail "Connection closed by remote server")-    return (unpackUInt header)-  rawResponse <- hGet (rdbHandle h) replyLength-  let parsedResponse = messageGet rawResponse+  when (B.length header /= 4) $+    throwIO $ RethinkDBConnectionError "RethinkDB connection closed unexpectedly"+  let replyLength = runGet getWord32le header+  rawResponse <- hGet (rdbHandle h) (fromIntegral replyLength)+  let parsedResponse = eitherDecode rawResponse   case parsedResponse of-    Left errMsg -> fail errMsg-    Right (response, rest)-      | B.null rest -> dispatch (Ql2.token response) response-      | otherwise -> fail "readSingleResponse: invalid reply length"+    Left errMsg -> do+      -- TODO: don't give up on the connection, only share the error message with the MVar+      fail errMsg+    Right response -> dispatch token $ WireResponse response    where-  dispatch Nothing _ = return ()-  dispatch (Just tok) response = do+  dispatch tok response = do     mboxes <- readIORef $ rdbWait h     case M.lookup tok mboxes of       Nothing -> return ()@@ -280,52 +332,41 @@         when (isLastResponse convertedResponse) $ closetok  isLastResponse :: Response -> Bool-isLastResponse ErrorResponse{} = True-isLastResponse SuccessResponse{ successCode = Success } = True-isLastResponse SuccessResponse{ successCode = SuccessPartial{} } = False-+isLastResponse ResponseError{} = True+isLastResponse ResponseSingle{} = True+isLastResponse (ResponseBatch (Just _) _) = False+isLastResponse (ResponseBatch Nothing _) = True+  -- | Set the default database -- -- The new handle is an alias for the old one. Calling close on either one -- will close both.-use :: RethinkDBHandle -> Database -> RethinkDBHandle-use h db' = h { rdbDatabase = db' }+use :: Database -> RethinkDBHandle -> RethinkDBHandle+use db' h = h { rdbDatabase = db' }  -- | Close an open connection close :: RethinkDBHandle -> IO ()-close RethinkDBHandle{ rdbHandle, rdbThread } = do+close h@RethinkDBHandle{ rdbHandle, rdbThread } = do+  noReplyWait h   killThread rdbThread   hClose rdbHandle -convertDatum :: Datum.Datum -> O.Datum-convertDatum Datum { type' = Just R_NULL } = Null-convertDatum Datum { type' = Just R_BOOL, r_bool = Just b } = Bool b-convertDatum Datum { type' = Just R_ARRAY, r_array = a } = toJSON (map convertDatum $ toList a)-convertDatum Datum { type' = Just R_OBJECT, r_object = o } =-  object $ Prelude.concatMap pair $ toList o-    where-      pair (AssocPair (Just k) (Just v))  = [(T.pack $ uToString $ k) .= convertDatum v]-      pair _ = []-convertDatum Datum { type' = Just R_STR, r_str = Just s } = toJSON (uToString s)-convertDatum Datum { type' = Just R_NUM, r_num = Just n } = toJSON n-convertDatum d = error ("Invalid Datum: " ++ show d)- closeToken :: RethinkDBHandle -> Token -> IO () closeToken h tok = do-  let query = defaultValue { Query.type' = Just STOP, Query.token = Just tok}-  sendQLQuery h query+  let query = WireQuery $ toDatum [toWire STOP]+  sendQLQuery h tok query  nextResponse :: Response -> IO ()-nextResponse SuccessResponse { successCode = SuccessPartial h tok } = do-  let query = defaultValue { Query.type' = Just CONTINUE, Query.token = Just tok}-  sendQLQuery h query+nextResponse (ResponseBatch (Just (More _ h tok)) _) = do+  let query = WireQuery $ toDatum [toWire CONTINUE]+  sendQLQuery h tok query nextResponse _ = return () -makeCursor :: MVar Response -> IO (Cursor O.Datum)+makeCursor :: MVar Response -> IO (Cursor Datum) makeCursor cursorMBox = do   cursorBuffer <- newMVar (Right ([], False))   return Cursor{..}-  where cursorMap = id+  where cursorMap = return . id  -- | Get the next value from a cursor next :: Cursor a -> IO (Maybe a)@@ -333,23 +374,66 @@   case mbuffer of     Left err -> throwIO err     Right ([], True) -> return (Right ([], True), Nothing)-    Right (x:xs, end) -> return $ (Right (xs, end), Just (cursorMap x))+    Right (x:xs, end) -> do x' <- cursorMap x; return $ (Right (xs, end), Just x')     Right ([], False) -> cursorFetchBatch c >>= loop -cursorFetchBatch :: Cursor a -> IO (Either RethinkDBError ([O.Datum], Bool))+-- | Get the next batch from a cursor+nextBatch :: Cursor a -> IO [a]+nextBatch c@Cursor{ .. } = modifyMVar cursorBuffer $ fix $ \loop mbuffer ->+  case mbuffer of+    Left err -> throwIO err+    Right ([], True) -> return (Right ([], True), [])+    Right (xs@(_:_), end) -> do+      xs' <- mapM cursorMap xs+      return $ (Right ([], end), xs')+    Right ([], False) -> cursorFetchBatch c >>= loop++cursorFetchBatch :: Cursor a -> IO (Either RethinkDBError ([Datum], Bool)) cursorFetchBatch c = do   response <- takeMVar (cursorMBox c)   case response of-    ErrorResponse e -> return $ Left e-    SuccessResponse Success datums -> return $ Right (datums, True)-    SuccessResponse SuccessPartial{} datums -> return $ Right (datums, False)+    ResponseError e -> return $ Left e+    ResponseBatch more datums -> return $ Right (datums, isNothing more)+    ResponseSingle (Array a) -> return $ Right (toList a, True)+    ResponseSingle _ ->+      return $ Left $ RethinkDBError ErrorUnexpectedResponse (Datum Null)+      "Expected a stream or an array but got a datum" []  -- | A lazy stream of all the elements in the cursor collect :: Cursor a -> IO [a] collect c = fix $ \loop -> do-    n <- next c-    case n of-      Nothing -> return []-      Just x -> do-        xs <- unsafeInterleaveIO $ loop-        return $ x : xs+    b <- nextBatch c+    case b of+      [] -> return []+      xs -> do+        ys <- unsafeInterleaveIO $ loop+        return $ xs ++ ys++-- | A strict version of collect+collect' :: Cursor a -> IO [a]+collect' c = fix $ \loop -> do+    b <- nextBatch c+    case b of+      [] -> return []+      xs -> do+        ys <- loop+        return $ xs ++ ys++-- | Wait for NoReply queries to complete on the server+--+-- >>> () <- runOpts h [NoReply] $ table "users" # get "bob" # update (\row -> merge row ["occupation" := "teacher"])+-- >>> noReplyWait h+noReplyWait :: RethinkDBHandle -> IO ()+noReplyWait h = do+  m <- runQLQuery h (WireQuery $ toDatum [toWire NOREPLY_WAIT]) (Datum Null)+  _ <- takeMVar m+  return ()++each :: Cursor a -> (a -> IO b) -> IO ()+each cursor f = do+  batch <- nextBatch cursor+  if null batch+    then return ()+    else do+      forM_ batch f+      each cursor f
Database/RethinkDB/NoClash.hs view
@@ -3,15 +3,12 @@  module Database.RethinkDB.NoClash (   module Database.RethinkDB,-  -- module Prelude, module Data.Time -- Uncomment to let GHC detect clashes+  -- module Prelude -- Uncomment to let GHC detect clashes   ) where --- Uncomment imports to let GHC detect clashes---import Data.Time- import Database.RethinkDB hiding (-  UTCTime, ZonedTime,   (*), (+), (-), (/),-  sum, (++), (.), map, mod, (!!), concatMap, drop, length, take, (&&),+  sum, map, mod, concatMap, (&&),   not, (||), (/=), (<), (<=), (>), (>=), error, (==), filter,-  elem)+  max, min,+  zip)
− Database/RethinkDB/Objects.hs 
@@ -1,54 +0,0 @@-module Database.RethinkDB.Objects (-  Database(..),-  TableCreateOptions(..),-  IndexCreateOptions(..),-  Table(..),-  Datum,-  Key-  ) where--import Data.Default (def, Default)-import Data.Int (Int64)-import Data.Text as Text-import Data.Aeson (Value)--type Key = Text---- | A database, referenced by name-data Database = Database {-  databaseName :: Text-  } deriving (Eq, Ord)--instance Show Database where-  show (Database d) = show d---- | Options used to create a table-data TableCreateOptions = TableCreateOptions {-  tableDataCenter :: Maybe Text,-  tableCacheSize :: Maybe Int64-  }--instance Default TableCreateOptions where-  def = TableCreateOptions Nothing Nothing---- | Options used to create an index-data IndexCreateOptions = IndexCreateOptions {-  indexMulti :: Maybe Bool-  }--instance Default IndexCreateOptions where-  def = IndexCreateOptions Nothing---- | A table description-data Table = Table {-  tableDatabase :: Maybe Database, -- ^ when Nothing, use the connection's database-  tableName :: Text,-  tablePrimaryKey :: Maybe Key-  } deriving (Eq, Ord)--instance Show Table where-  show (Table db' nam mkey) =-    maybe "" (\(Database d) -> Text.unpack d++".") db' ++ Text.unpack nam ++-    maybe "" (\k -> "[" ++ show k ++ "]") mkey--type Datum = Value
− Database/RethinkDB/Protobuf/Ql2.hs 
@@ -1,21 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2 (protoInfo, fileDescriptorProto) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import Text.DescriptorProtos.FileDescriptorProto (FileDescriptorProto)-import Text.ProtocolBuffers.Reflections (ProtoInfo)-import qualified Text.ProtocolBuffers.WireMessage as P' (wireGet,getFromBS)- -protoInfo :: ProtoInfo-protoInfo- = Prelude'.read-    "ProtoInfo {protoMod = ProtoName {protobufName = FIName \".Ql2\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [], baseName = MName \"Ql2\"}, protoFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2.hs\"], protoSource = \"ql2.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.VersionDummy\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"VersionDummy\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"VersionDummy.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Query\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Query\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Query.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Query.QueryType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Query\"], baseName = MName \"QueryType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.query\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"query\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.token\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"token\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.OBSOLETE_noreply\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"oBSOLETE_noreply\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just \"false\", hsDefault = Just (HsDef'Bool False)},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.global_optargs\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"global_optargs\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Query.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Query\"], baseName = MName \"AssocPair\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Query.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Query\"], baseName = MName \"AssocPair\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Query\",\"AssocPair.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.AssocPair.key\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\",MName \"AssocPair\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.AssocPair.val\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\",MName \"AssocPair\"], baseName' = FName \"val\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Frame\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Frame\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Frame.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Frame.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Frame\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Frame.FrameType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Frame\"], baseName = MName \"FrameType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Frame.pos\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Frame\"], baseName' = FName \"pos\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Frame.opt\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Frame\"], baseName' = FName \"opt\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Backtrace\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Backtrace\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Backtrace.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Backtrace.frames\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Backtrace\"], baseName' = FName \"frames\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Frame\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Frame\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Response\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Response\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Response.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Response.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Response\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Response.ResponseType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Response\"], baseName = MName \"ResponseType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Response.token\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Response\"], baseName' = FName \"token\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Response.response\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Response\"], baseName' = FName \"response\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Response.backtrace\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Response\"], baseName' = FName \"backtrace\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Backtrace\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Backtrace\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Datum.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum.DatumType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Datum\"], baseName = MName \"DatumType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_bool\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_bool\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_num\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_num\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 25}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_str\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_str\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_array\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_array\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_object\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_object\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Datum\"], baseName = MName \"AssocPair\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [(FieldId {getFieldId = 10000},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 20000})], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Datum.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Datum\"], baseName = MName \"AssocPair\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Datum\",\"AssocPair.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.AssocPair.key\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\",MName \"AssocPair\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.AssocPair.val\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\",MName \"AssocPair\"], baseName' = FName \"val\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Term.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term.TermType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Term\"], baseName = MName \"TermType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.datum\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\"], baseName' = FName \"datum\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.args\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\"], baseName' = FName \"args\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.optargs\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\"], baseName' = FName \"optargs\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Term\"], baseName = MName \"AssocPair\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [(FieldId {getFieldId = 10000},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 20000})], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Term.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Term\"], baseName = MName \"AssocPair\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Term\",\"AssocPair.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.AssocPair.key\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\",MName \"AssocPair\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.AssocPair.val\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\",MName \"AssocPair\"], baseName' = FName \"val\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}], enums = [EnumInfo {enumName = ProtoName {protobufName = FIName \".Ql2.VersionDummy.Version\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"VersionDummy\"], baseName = MName \"Version\"}, enumFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"VersionDummy\",\"Version.hs\"], enumValues = [(EnumCode {getEnumCode = 1063369270},\"V0_1\"),(EnumCode {getEnumCode = 1915781601},\"V0_2\")]},EnumInfo {enumName = ProtoName {protobufName = FIName \".Ql2.Query.QueryType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Query\"], baseName = MName \"QueryType\"}, enumFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Query\",\"QueryType.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"START\"),(EnumCode {getEnumCode = 2},\"CONTINUE\"),(EnumCode {getEnumCode = 3},\"STOP\")]},EnumInfo {enumName = ProtoName {protobufName = FIName \".Ql2.Frame.FrameType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Frame\"], baseName = MName \"FrameType\"}, enumFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Frame\",\"FrameType.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"POS\"),(EnumCode {getEnumCode = 2},\"OPT\")]},EnumInfo {enumName = ProtoName {protobufName = FIName \".Ql2.Response.ResponseType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Response\"], baseName = MName \"ResponseType\"}, enumFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Response\",\"ResponseType.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"SUCCESS_ATOM\"),(EnumCode {getEnumCode = 2},\"SUCCESS_SEQUENCE\"),(EnumCode {getEnumCode = 3},\"SUCCESS_PARTIAL\"),(EnumCode {getEnumCode = 16},\"CLIENT_ERROR\"),(EnumCode {getEnumCode = 17},\"COMPILE_ERROR\"),(EnumCode {getEnumCode = 18},\"RUNTIME_ERROR\")]},EnumInfo {enumName = ProtoName {protobufName = FIName \".Ql2.Datum.DatumType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Datum\"], baseName = MName \"DatumType\"}, enumFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Datum\",\"DatumType.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"R_NULL\"),(EnumCode {getEnumCode = 2},\"R_BOOL\"),(EnumCode {getEnumCode = 3},\"R_NUM\"),(EnumCode {getEnumCode = 4},\"R_STR\"),(EnumCode {getEnumCode = 5},\"R_ARRAY\"),(EnumCode {getEnumCode = 6},\"R_OBJECT\")]},EnumInfo {enumName = ProtoName {protobufName = FIName \".Ql2.Term.TermType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Term\"], baseName = MName \"TermType\"}, enumFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Term\",\"TermType.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"DATUM\"),(EnumCode {getEnumCode = 2},\"MAKE_ARRAY\"),(EnumCode {getEnumCode = 3},\"MAKE_OBJ\"),(EnumCode {getEnumCode = 10},\"VAR\"),(EnumCode {getEnumCode = 11},\"JAVASCRIPT\"),(EnumCode {getEnumCode = 12},\"ERROR\"),(EnumCode {getEnumCode = 13},\"IMPLICIT_VAR\"),(EnumCode {getEnumCode = 14},\"DB\"),(EnumCode {getEnumCode = 15},\"TABLE\"),(EnumCode {getEnumCode = 16},\"GET\"),(EnumCode {getEnumCode = 78},\"GET_ALL\"),(EnumCode {getEnumCode = 17},\"EQ\"),(EnumCode {getEnumCode = 18},\"NE\"),(EnumCode {getEnumCode = 19},\"LT\"),(EnumCode {getEnumCode = 20},\"LE\"),(EnumCode {getEnumCode = 21},\"GT\"),(EnumCode {getEnumCode = 22},\"GE\"),(EnumCode {getEnumCode = 23},\"NOT\"),(EnumCode {getEnumCode = 24},\"ADD\"),(EnumCode {getEnumCode = 25},\"SUB\"),(EnumCode {getEnumCode = 26},\"MUL\"),(EnumCode {getEnumCode = 27},\"DIV\"),(EnumCode {getEnumCode = 28},\"MOD\"),(EnumCode {getEnumCode = 29},\"APPEND\"),(EnumCode {getEnumCode = 80},\"PREPEND\"),(EnumCode {getEnumCode = 95},\"DIFFERENCE\"),(EnumCode {getEnumCode = 88},\"SET_INSERT\"),(EnumCode {getEnumCode = 89},\"SET_INTERSECTION\"),(EnumCode {getEnumCode = 90},\"SET_UNION\"),(EnumCode {getEnumCode = 91},\"SET_DIFFERENCE\"),(EnumCode {getEnumCode = 30},\"SLICE\"),(EnumCode {getEnumCode = 70},\"SKIP\"),(EnumCode {getEnumCode = 71},\"LIMIT\"),(EnumCode {getEnumCode = 87},\"INDEXES_OF\"),(EnumCode {getEnumCode = 93},\"CONTAINS\"),(EnumCode {getEnumCode = 31},\"GET_FIELD\"),(EnumCode {getEnumCode = 94},\"KEYS\"),(EnumCode {getEnumCode = 32},\"HAS_FIELDS\"),(EnumCode {getEnumCode = 96},\"WITH_FIELDS\"),(EnumCode {getEnumCode = 33},\"PLUCK\"),(EnumCode {getEnumCode = 34},\"WITHOUT\"),(EnumCode {getEnumCode = 35},\"MERGE\"),(EnumCode {getEnumCode = 36},\"BETWEEN\"),(EnumCode {getEnumCode = 37},\"REDUCE\"),(EnumCode {getEnumCode = 38},\"MAP\"),(EnumCode {getEnumCode = 39},\"FILTER\"),(EnumCode {getEnumCode = 40},\"CONCATMAP\"),(EnumCode {getEnumCode = 41},\"ORDERBY\"),(EnumCode {getEnumCode = 42},\"DISTINCT\"),(EnumCode {getEnumCode = 43},\"COUNT\"),(EnumCode {getEnumCode = 86},\"IS_EMPTY\"),(EnumCode {getEnumCode = 44},\"UNION\"),(EnumCode {getEnumCode = 45},\"NTH\"),(EnumCode {getEnumCode = 46},\"GROUPED_MAP_REDUCE\"),(EnumCode {getEnumCode = 47},\"GROUPBY\"),(EnumCode {getEnumCode = 48},\"INNER_JOIN\"),(EnumCode {getEnumCode = 49},\"OUTER_JOIN\"),(EnumCode {getEnumCode = 50},\"EQ_JOIN\"),(EnumCode {getEnumCode = 72},\"ZIP\"),(EnumCode {getEnumCode = 82},\"INSERT_AT\"),(EnumCode {getEnumCode = 83},\"DELETE_AT\"),(EnumCode {getEnumCode = 84},\"CHANGE_AT\"),(EnumCode {getEnumCode = 85},\"SPLICE_AT\"),(EnumCode {getEnumCode = 51},\"COERCE_TO\"),(EnumCode {getEnumCode = 52},\"TYPEOF\"),(EnumCode {getEnumCode = 53},\"UPDATE\"),(EnumCode {getEnumCode = 54},\"DELETE\"),(EnumCode {getEnumCode = 55},\"REPLACE\"),(EnumCode {getEnumCode = 56},\"INSERT\"),(EnumCode {getEnumCode = 57},\"DB_CREATE\"),(EnumCode {getEnumCode = 58},\"DB_DROP\"),(EnumCode {getEnumCode = 59},\"DB_LIST\"),(EnumCode {getEnumCode = 60},\"TABLE_CREATE\"),(EnumCode {getEnumCode = 61},\"TABLE_DROP\"),(EnumCode {getEnumCode = 62},\"TABLE_LIST\"),(EnumCode {getEnumCode = 75},\"INDEX_CREATE\"),(EnumCode {getEnumCode = 76},\"INDEX_DROP\"),(EnumCode {getEnumCode = 77},\"INDEX_LIST\"),(EnumCode {getEnumCode = 64},\"FUNCALL\"),(EnumCode {getEnumCode = 65},\"BRANCH\"),(EnumCode {getEnumCode = 66},\"ANY\"),(EnumCode {getEnumCode = 67},\"ALL\"),(EnumCode {getEnumCode = 68},\"FOREACH\"),(EnumCode {getEnumCode = 69},\"FUNC\"),(EnumCode {getEnumCode = 73},\"ASC\"),(EnumCode {getEnumCode = 74},\"DESC\"),(EnumCode {getEnumCode = 79},\"INFO\"),(EnumCode {getEnumCode = 97},\"MATCH\"),(EnumCode {getEnumCode = 81},\"SAMPLE\"),(EnumCode {getEnumCode = 92},\"DEFAULT\"),(EnumCode {getEnumCode = 98},\"JSON\"),(EnumCode {getEnumCode = 99},\"ISO8601\"),(EnumCode {getEnumCode = 100},\"TO_ISO8601\"),(EnumCode {getEnumCode = 101},\"EPOCH_TIME\"),(EnumCode {getEnumCode = 102},\"TO_EPOCH_TIME\"),(EnumCode {getEnumCode = 103},\"NOW\"),(EnumCode {getEnumCode = 104},\"IN_TIMEZONE\"),(EnumCode {getEnumCode = 105},\"DURING\"),(EnumCode {getEnumCode = 106},\"DATE\"),(EnumCode {getEnumCode = 126},\"TIME_OF_DAY\"),(EnumCode {getEnumCode = 127},\"TIMEZONE\"),(EnumCode {getEnumCode = 128},\"YEAR\"),(EnumCode {getEnumCode = 129},\"MONTH\"),(EnumCode {getEnumCode = 130},\"DAY\"),(EnumCode {getEnumCode = 131},\"DAY_OF_WEEK\"),(EnumCode {getEnumCode = 132},\"DAY_OF_YEAR\"),(EnumCode {getEnumCode = 133},\"HOURS\"),(EnumCode {getEnumCode = 134},\"MINUTES\"),(EnumCode {getEnumCode = 135},\"SECONDS\"),(EnumCode {getEnumCode = 136},\"TIME\"),(EnumCode {getEnumCode = 107},\"MONDAY\"),(EnumCode {getEnumCode = 108},\"TUESDAY\"),(EnumCode {getEnumCode = 109},\"WEDNESDAY\"),(EnumCode {getEnumCode = 110},\"THURSDAY\"),(EnumCode {getEnumCode = 111},\"FRIDAY\"),(EnumCode {getEnumCode = 112},\"SATURDAY\"),(EnumCode {getEnumCode = 113},\"SUNDAY\"),(EnumCode {getEnumCode = 114},\"JANUARY\"),(EnumCode {getEnumCode = 115},\"FEBRUARY\"),(EnumCode {getEnumCode = 116},\"MARCH\"),(EnumCode {getEnumCode = 117},\"APRIL\"),(EnumCode {getEnumCode = 118},\"MAY\"),(EnumCode {getEnumCode = 119},\"JUNE\"),(EnumCode {getEnumCode = 120},\"JULY\"),(EnumCode {getEnumCode = 121},\"AUGUST\"),(EnumCode {getEnumCode = 122},\"SEPTEMBER\"),(EnumCode {getEnumCode = 123},\"OCTOBER\"),(EnumCode {getEnumCode = 124},\"NOVEMBER\"),(EnumCode {getEnumCode = 125},\"DECEMBER\"),(EnumCode {getEnumCode = 137},\"LITERAL\")]}], knownKeyMap = fromList []}"- -fileDescriptorProto :: FileDescriptorProto-fileDescriptorProto- = P'.getFromBS (P'.wireGet 11)-    (P'.pack-      "\230\SYN\n\tql2.proto\"5\n\fVersionDummy\"%\n\aVersion\DC2\f\n\EOTV0_1\DLE\182\244\134\251\ETX\DC2\f\n\EOTV0_2\DLE\225\131\194\145\a\"\133\STX\n\ENQQuery\DC2\"\n\EOTtype\CAN\SOH \SOH(\SO2\DC4.Ql2.Query.QueryType\DC2\CAN\n\ENQquery\CAN\STX \SOH(\v2\t.Ql2.Term\DC2\r\n\ENQtoken\CAN\ETX \SOH(\ETX\DC2\US\n\DLEOBSOLETE_noreply\CAN\EOT \SOH(\b:\ENQfalse\DC2,\n\SOglobal_optargs\CAN\ACK \ETX(\v2\DC4.Ql2.Query.AssocPair\SUB0\n\tAssocPair\DC2\v\n\ETXkey\CAN\SOH \SOH(\t\DC2\SYN\n\ETXval\CAN\STX \SOH(\v2\t.Ql2.Term\".\n\tQueryType\DC2\t\n\ENQSTART\DLE\SOH\DC2\f\n\bCONTINUE\DLE\STX\DC2\b\n\EOTSTOP\DLE\ETX\"d\n\ENQFrame\DC2\"\n\EOTtype\CAN\SOH \SOH(\SO2\DC4.Ql2.Frame.FrameType\DC2\v\n\ETXpos\CAN\STX \SOH(\ETX\DC2\v\n\ETXopt\CAN\ETX \SOH(\t\"\GS\n\tFrameType\DC2\a\n\ETXPOS\DLE\SOH\DC2\a\n\ETXOPT\DLE\STX\"'\n\tBacktrace\DC2\SUB\n\ACKframes\CAN\SOH \ETX(\v2\n.Ql2.Frame\"\138\STX\n\bResponse\DC2(\n\EOTtype\CAN\SOH \SOH(\SO2\SUB.Ql2.Response.ResponseType\DC2\r\n\ENQtoken\CAN\STX \SOH(\ETX\DC2\FS\n\bresponse\CAN\ETX \ETX(\v2\n.Ql2.Datum\DC2!\n\tbacktrace\CAN\EOT \SOH(\v2\SO.Ql2.Backtrace\"\131\SOH\n\fResponseType\DC2\DLE\n\fSUCCESS_ATOM\DLE\SOH\DC2\DC4\n\DLESUCCESS_SEQUENCE\DLE\STX\DC2\DC3\n\SISUCCESS_PARTIAL\DLE\ETX\DC2\DLE\n\fCLIENT_ERROR\DLE\DLE\DC2\DC1\n\rCOMPILE_ERROR\DLE\DC1\DC2\DC1\n\rRUNTIME_ERROR\DLE\DC2\"\176\STX\n\ENQDatum\DC2\"\n\EOTtype\CAN\SOH \SOH(\SO2\DC4.Ql2.Datum.DatumType\DC2\SO\n\ACKr_bool\CAN\STX \SOH(\b\DC2\r\n\ENQr_num\CAN\ETX \SOH(\SOH\DC2\r\n\ENQr_str\CAN\EOT \SOH(\t\DC2\ESC\n\ar_array\CAN\ENQ \ETX(\v2\n.Ql2.Datum\DC2&\n\br_object\CAN\ACK \ETX(\v2\DC4.Ql2.Datum.AssocPair\SUB1\n\tAssocPair\DC2\v\n\ETXkey\CAN\SOH \SOH(\t\DC2\ETB\n\ETXval\CAN\STX \SOH(\v2\n.Ql2.Datum\"T\n\tDatumType\DC2\n\n\ACKR_NULL\DLE\SOH\DC2\n\n\ACKR_BOOL\DLE\STX\DC2\t\n\ENQR_NUM\DLE\ETX\DC2\t\n\ENQR_STR\DLE\EOT\DC2\v\n\aR_ARRAY\DLE\ENQ\DC2\f\n\bR_OBJECT\DLE\ACK*\a\b\144N\DLE\161\156\SOH\"\202\SO\n\EOTTerm\DC2 \n\EOTtype\CAN\SOH \SOH(\SO2\DC2.Ql2.Term.TermType\DC2\EM\n\ENQdatum\CAN\STX \SOH(\v2\n.Ql2.Datum\DC2\ETB\n\EOTargs\CAN\ETX \ETX(\v2\t.Ql2.Term\DC2$\n\aoptargs\CAN\EOT \ETX(\v2\DC3.Ql2.Term.AssocPair\SUB0\n\tAssocPair\DC2\v\n\ETXkey\CAN\SOH \SOH(\t\DC2\SYN\n\ETXval\CAN\STX \SOH(\v2\t.Ql2.Term\"\138\r\n\bTermType\DC2\t\n\ENQDATUM\DLE\SOH\DC2\SO\n\nMAKE_ARRAY\DLE\STX\DC2\f\n\bMAKE_OBJ\DLE\ETX\DC2\a\n\ETXVAR\DLE\n\DC2\SO\n\nJAVASCRIPT\DLE\v\DC2\t\n\ENQERROR\DLE\f\DC2\DLE\n\fIMPLICIT_VAR\DLE\r\DC2\ACK\n\STXDB\DLE\SO\DC2\t\n\ENQTABLE\DLE\SI\DC2\a\n\ETXGET\DLE\DLE\DC2\v\n\aGET_ALL\DLEN\DC2\ACK\n\STXEQ\DLE\DC1\DC2\ACK\n\STXNE\DLE\DC2\DC2\ACK\n\STXLT\DLE\DC3\DC2\ACK\n\STXLE\DLE\DC4\DC2\ACK\n\STXGT\DLE\NAK\DC2\ACK\n\STXGE\DLE\SYN\DC2\a\n\ETXNOT\DLE\ETB\DC2\a\n\ETXADD\DLE\CAN\DC2\a\n\ETXSUB\DLE\EM\DC2\a\n\ETXMUL\DLE\SUB\DC2\a\n\ETXDIV\DLE\ESC\DC2\a\n\ETXMOD\DLE\FS\DC2\n\n\ACKAPPEND\DLE\GS\DC2\v\n\aPREPEND\DLEP\DC2\SO\n\nDIFFERENCE\DLE_\DC2\SO\n\nSET_INSERT\DLEX\DC2\DC4\n\DLESET_INTERSECTION\DLEY\DC2\r\n\tSET_UNION\DLEZ\DC2\DC2\n\SOSET_DIFFERENCE\DLE[\DC2\t\n\ENQSLICE\DLE\RS\DC2\b\n\EOTSKIP\DLEF\DC2\t\n\ENQLIMIT\DLEG\DC2\SO\n\nINDEXES_OF\DLEW\DC2\f\n\bCONTAINS\DLE]\DC2\r\n\tGET_FIELD\DLE\US\DC2\b\n\EOTKEYS\DLE^\DC2\SO\n\nHAS_FIELDS\DLE \DC2\SI\n\vWITH_FIELDS\DLE`\DC2\t\n\ENQPLUCK\DLE!\DC2\v\n\aWITHOUT\DLE\"\DC2\t\n\ENQMERGE\DLE#\DC2\v\n\aBETWEEN\DLE$\DC2\n\n\ACKREDUCE\DLE%\DC2\a\n\ETXMAP\DLE&\DC2\n\n\ACKFILTER\DLE'\DC2\r\n\tCONCATMAP\DLE(\DC2\v\n\aORDERBY\DLE)\DC2\f\n\bDISTINCT\DLE*\DC2\t\n\ENQCOUNT\DLE+\DC2\f\n\bIS_EMPTY\DLEV\DC2\t\n\ENQUNION\DLE,\DC2\a\n\ETXNTH\DLE-\DC2\SYN\n\DC2GROUPED_MAP_REDUCE\DLE.\DC2\v\n\aGROUPBY\DLE/\DC2\SO\n\nINNER_JOIN\DLE0\DC2\SO\n\nOUTER_JOIN\DLE1\DC2\v\n\aEQ_JOIN\DLE2\DC2\a\n\ETXZIP\DLEH\DC2\r\n\tINSERT_AT\DLER\DC2\r\n\tDELETE_AT\DLES\DC2\r\n\tCHANGE_AT\DLET\DC2\r\n\tSPLICE_AT\DLEU\DC2\r\n\tCOERCE_TO\DLE3\DC2\n\n\ACKTYPEOF\DLE4\DC2\n\n\ACKUPDATE\DLE5\DC2\n\n\ACKDELETE\DLE6\DC2\v\n\aREPLACE\DLE7\DC2\n\n\ACKINSERT\DLE8\DC2\r\n\tDB_CREATE\DLE9\DC2\v\n\aDB_DROP\DLE:\DC2\v\n\aDB_LIST\DLE;\DC2\DLE\n\fTABLE_CREATE\DLE<\DC2\SO\n\nTABLE_DROP\DLE=\DC2\SO\n\nTABLE_LIST\DLE>\DC2\DLE\n\fINDEX_CREATE\DLEK\DC2\SO\n\nINDEX_DROP\DLEL\DC2\SO\n\nINDEX_LIST\DLEM\DC2\v\n\aFUNCALL\DLE@\DC2\n\n\ACKBRANCH\DLEA\DC2\a\n\ETXANY\DLEB\DC2\a\n\ETXALL\DLEC\DC2\v\n\aFOREACH\DLED\DC2\b\n\EOTFUNC\DLEE\DC2\a\n\ETXASC\DLEI\DC2\b\n\EOTDESC\DLEJ\DC2\b\n\EOTINFO\DLEO\DC2\t\n\ENQMATCH\DLEa\DC2\n\n\ACKSAMPLE\DLEQ\DC2\v\n\aDEFAULT\DLE\\\DC2\b\n\EOTJSON\DLEb\DC2\v\n\aISO8601\DLEc\DC2\SO\n\nTO_ISO8601\DLEd\DC2\SO\n\nEPOCH_TIME\DLEe\DC2\DC1\n\rTO_EPOCH_TIME\DLEf\DC2\a\n\ETXNOW\DLEg\DC2\SI\n\vIN_TIMEZONE\DLEh\DC2\n\n\ACKDURING\DLEi\DC2\b\n\EOTDATE\DLEj\DC2\SI\n\vTIME_OF_DAY\DLE~\DC2\f\n\bTIMEZONE\DLE\DEL\DC2\t\n\EOTYEAR\DLE\128\SOH\DC2\n\n\ENQMONTH\DLE\129\SOH\DC2\b\n\ETXDAY\DLE\130\SOH\DC2\DLE\n\vDAY_OF_WEEK\DLE\131\SOH\DC2\DLE\n\vDAY_OF_YEAR\DLE\132\SOH\DC2\n\n\ENQHOURS\DLE\133\SOH\DC2\f\n\aMINUTES\DLE\134\SOH\DC2\f\n\aSECONDS\DLE\135\SOH\DC2\t\n\EOTTIME\DLE\136\SOH\DC2\n\n\ACKMONDAY\DLEk\DC2\v\n\aTUESDAY\DLEl\DC2\r\n\tWEDNESDAY\DLEm\DC2\f\n\bTHURSDAY\DLEn\DC2\n\n\ACKFRIDAY\DLEo\DC2\f\n\bSATURDAY\DLEp\DC2\n\n\ACKSUNDAY\DLEq\DC2\v\n\aJANUARY\DLEr\DC2\f\n\bFEBRUARY\DLEs\DC2\t\n\ENQMARCH\DLEt\DC2\t\n\ENQAPRIL\DLEu\DC2\a\n\ETXMAY\DLEv\DC2\b\n\EOTJUNE\DLEw\DC2\b\n\EOTJULY\DLEx\DC2\n\n\ACKAUGUST\DLEy\DC2\r\n\tSEPTEMBER\DLEz\DC2\v\n\aOCTOBER\DLE{\DC2\f\n\bNOVEMBER\DLE|\DC2\f\n\bDECEMBER\DLE}\DC2\f\n\aLITERAL\DLE\137\SOH*\a\b\144N\DLE\161\156\SOH")
− Database/RethinkDB/Protobuf/Ql2/Backtrace.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Backtrace (Backtrace(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Database.RethinkDB.Protobuf.Ql2.Frame as Ql2 (Frame)- -data Backtrace = Backtrace{frames :: !(P'.Seq Ql2.Frame)}-               deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable Backtrace where-  mergeAppend (Backtrace x'1) (Backtrace y'1) = Backtrace (P'.mergeAppend x'1 y'1)- -instance P'.Default Backtrace where-  defaultValue = Backtrace P'.defaultValue- -instance P'.Wire Backtrace where-  wireSize ft' self'@(Backtrace x'1)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = (P'.wireSizeRep 1 11 x'1)-  wirePut ft' self'@(Backtrace x'1)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutRep 10 11 x'1-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             10 -> Prelude'.fmap (\ !new'Field -> old'Self{frames = P'.append (frames old'Self) new'Field}) (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> Backtrace) Backtrace where-  getVal m' f' = f' m'- -instance P'.GPB Backtrace- -instance P'.ReflectDescriptor Backtrace where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Backtrace\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Backtrace\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Backtrace.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Backtrace.frames\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Backtrace\"], baseName' = FName \"frames\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Frame\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Frame\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Datum.hs 
@@ -1,88 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Datum (Datum(..)) where-import Prelude ((+), (/), (==), (<=), (&&))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import {-# SOURCE #-} qualified Database.RethinkDB.Protobuf.Ql2.Datum.AssocPair as Ql2.Datum (AssocPair)-import qualified Database.RethinkDB.Protobuf.Ql2.Datum.DatumType as Ql2.Datum (DatumType)- -data Datum = Datum{type' :: !(P'.Maybe Ql2.Datum.DatumType), r_bool :: !(P'.Maybe P'.Bool), r_num :: !(P'.Maybe P'.Double),-                   r_str :: !(P'.Maybe P'.Utf8), r_array :: !(P'.Seq Datum), r_object :: !(P'.Seq Ql2.Datum.AssocPair),-                   ext'field :: !P'.ExtField}-           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.ExtendMessage Datum where-  getExtField = ext'field-  putExtField e'f msg = msg{ext'field = e'f}-  validExtRanges msg = P'.extRanges (P'.reflectDescriptorInfo msg)- -instance P'.Mergeable Datum where-  mergeAppend (Datum x'1 x'2 x'3 x'4 x'5 x'6 x'7) (Datum y'1 y'2 y'3 y'4 y'5 y'6 y'7)-   = Datum (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)-      (P'.mergeAppend x'5 y'5)-      (P'.mergeAppend x'6 y'6)-      (P'.mergeAppend x'7 y'7)- -instance P'.Default Datum where-  defaultValue-   = Datum P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue- -instance P'.Wire Datum where-  wireSize ft' self'@(Datum x'1 x'2 x'3 x'4 x'5 x'6 x'7)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size-         = (P'.wireSizeOpt 1 14 x'1 + P'.wireSizeOpt 1 8 x'2 + P'.wireSizeOpt 1 1 x'3 + P'.wireSizeOpt 1 9 x'4 +-             P'.wireSizeRep 1 11 x'5-             + P'.wireSizeRep 1 11 x'6-             + P'.wireSizeExtField x'7)-  wirePut ft' self'@(Datum x'1 x'2 x'3 x'4 x'5 x'6 x'7)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutOpt 8 14 x'1-             P'.wirePutOpt 16 8 x'2-             P'.wirePutOpt 25 1 x'3-             P'.wirePutOpt 34 9 x'4-             P'.wirePutRep 42 11 x'5-             P'.wirePutRep 50 11 x'6-             P'.wirePutExtField x'7-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             8 -> Prelude'.fmap (\ !new'Field -> old'Self{type' = Prelude'.Just new'Field}) (P'.wireGet 14)-             16 -> Prelude'.fmap (\ !new'Field -> old'Self{r_bool = Prelude'.Just new'Field}) (P'.wireGet 8)-             25 -> Prelude'.fmap (\ !new'Field -> old'Self{r_num = Prelude'.Just new'Field}) (P'.wireGet 1)-             34 -> Prelude'.fmap (\ !new'Field -> old'Self{r_str = Prelude'.Just new'Field}) (P'.wireGet 9)-             42 -> Prelude'.fmap (\ !new'Field -> old'Self{r_array = P'.append (r_array old'Self) new'Field}) (P'.wireGet 11)-             50 -> Prelude'.fmap (\ !new'Field -> old'Self{r_object = P'.append (r_object old'Self) new'Field}) (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in-                   if Prelude'.or [10000 <= field'Number && field'Number <= 18999, field'Number == 20000] then-                    P'.loadExtension field'Number wire'Type old'Self else P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> Datum) Datum where-  getVal m' f' = f' m'- -instance P'.GPB Datum- -instance P'.ReflectDescriptor Datum where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 16, 25, 34, 42, 50])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Datum.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum.DatumType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Datum\"], baseName = MName \"DatumType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_bool\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_bool\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_num\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_num\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 25}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 1}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_str\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_str\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_array\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_array\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 42}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.r_object\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\"], baseName' = FName \"r_object\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Datum\"], baseName = MName \"AssocPair\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [(FieldId {getFieldId = 10000},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 20000})], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Datum/AssocPair.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Datum.AssocPair (AssocPair(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Database.RethinkDB.Protobuf.Ql2.Datum as Ql2 (Datum)- -data AssocPair = AssocPair{key :: !(P'.Maybe P'.Utf8), val :: !(P'.Maybe Ql2.Datum)}-               deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable AssocPair where-  mergeAppend (AssocPair x'1 x'2) (AssocPair y'1 y'2) = AssocPair (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)- -instance P'.Default AssocPair where-  defaultValue = AssocPair P'.defaultValue P'.defaultValue- -instance P'.Wire AssocPair where-  wireSize ft' self'@(AssocPair x'1 x'2)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 11 x'2)-  wirePut ft' self'@(AssocPair x'1 x'2)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutOpt 10 9 x'1-             P'.wirePutOpt 18 11 x'2-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             10 -> Prelude'.fmap (\ !new'Field -> old'Self{key = Prelude'.Just new'Field}) (P'.wireGet 9)-             18 -> Prelude'.fmap (\ !new'Field -> old'Self{val = P'.mergeAppend (val old'Self) (Prelude'.Just new'Field)})-                    (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> AssocPair) AssocPair where-  getVal m' f' = f' m'- -instance P'.GPB AssocPair- -instance P'.ReflectDescriptor AssocPair where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 18])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Datum.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Datum\"], baseName = MName \"AssocPair\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Datum\",\"AssocPair.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.AssocPair.key\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\",MName \"AssocPair\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Datum.AssocPair.val\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Datum\",MName \"AssocPair\"], baseName' = FName \"val\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Datum/AssocPair.hs-boot 
@@ -1,30 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Datum.AssocPair (AssocPair) where-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data AssocPair- -instance P'.MessageAPI msg' (msg' -> AssocPair) AssocPair- -instance Prelude'.Show AssocPair- -instance Prelude'.Eq AssocPair- -instance Prelude'.Ord AssocPair- -instance Prelude'.Typeable AssocPair- -instance Prelude'.Data AssocPair- -instance P'.Mergeable AssocPair- -instance P'.Default AssocPair- -instance P'.Wire AssocPair- -instance P'.GPB AssocPair- -instance P'.ReflectDescriptor AssocPair
− Database/RethinkDB/Protobuf/Ql2/Datum/DatumType.hs 
@@ -1,78 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Datum.DatumType (DatumType(..)) where-import Prelude ((+), (/), (.))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data DatumType = R_NULL-               | R_BOOL-               | R_NUM-               | R_STR-               | R_ARRAY-               | R_OBJECT-               deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable DatumType- -instance Prelude'.Bounded DatumType where-  minBound = R_NULL-  maxBound = R_OBJECT- -instance P'.Default DatumType where-  defaultValue = R_NULL- -toMaybe'Enum :: Prelude'.Int -> P'.Maybe DatumType-toMaybe'Enum 1 = Prelude'.Just R_NULL-toMaybe'Enum 2 = Prelude'.Just R_BOOL-toMaybe'Enum 3 = Prelude'.Just R_NUM-toMaybe'Enum 4 = Prelude'.Just R_STR-toMaybe'Enum 5 = Prelude'.Just R_ARRAY-toMaybe'Enum 6 = Prelude'.Just R_OBJECT-toMaybe'Enum _ = Prelude'.Nothing- -instance Prelude'.Enum DatumType where-  fromEnum R_NULL = 1-  fromEnum R_BOOL = 2-  fromEnum R_NUM = 3-  fromEnum R_STR = 4-  fromEnum R_ARRAY = 5-  fromEnum R_OBJECT = 6-  toEnum-   = P'.fromMaybe (Prelude'.error "hprotoc generated code: toEnum failure for type Database.RethinkDB.Protobuf.Ql2.Datum.DatumType")-      . toMaybe'Enum-  succ R_NULL = R_BOOL-  succ R_BOOL = R_NUM-  succ R_NUM = R_STR-  succ R_STR = R_ARRAY-  succ R_ARRAY = R_OBJECT-  succ _ = Prelude'.error "hprotoc generated code: succ failure for type Database.RethinkDB.Protobuf.Ql2.Datum.DatumType"-  pred R_BOOL = R_NULL-  pred R_NUM = R_BOOL-  pred R_STR = R_NUM-  pred R_ARRAY = R_STR-  pred R_OBJECT = R_ARRAY-  pred _ = Prelude'.error "hprotoc generated code: pred failure for type Database.RethinkDB.Protobuf.Ql2.Datum.DatumType"- -instance P'.Wire DatumType where-  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)-  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)-  wireGet 14 = P'.wireGetEnum toMaybe'Enum-  wireGet ft' = P'.wireGetErr ft'-  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum-  wireGetPacked ft' = P'.wireGetErr ft'- -instance P'.GPB DatumType- -instance P'.MessageAPI msg' (msg' -> DatumType) DatumType where-  getVal m' f' = f' m'- -instance P'.ReflectEnum DatumType where-  reflectEnum-   = [(1, "R_NULL", R_NULL), (2, "R_BOOL", R_BOOL), (3, "R_NUM", R_NUM), (4, "R_STR", R_STR), (5, "R_ARRAY", R_ARRAY),-      (6, "R_OBJECT", R_OBJECT)]-  reflectEnumInfo _-   = P'.EnumInfo (P'.makePNF (P'.pack ".Ql2.Datum.DatumType") ["Database", "RethinkDB", "Protobuf"] ["Ql2", "Datum"] "DatumType")-      ["Database", "RethinkDB", "Protobuf", "Ql2", "Datum", "DatumType.hs"]-      [(1, "R_NULL"), (2, "R_BOOL"), (3, "R_NUM"), (4, "R_STR"), (5, "R_ARRAY"), (6, "R_OBJECT")]
− Database/RethinkDB/Protobuf/Ql2/Frame.hs 
@@ -1,63 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Frame (Frame(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Database.RethinkDB.Protobuf.Ql2.Frame.FrameType as Ql2.Frame (FrameType)- -data Frame = Frame{type' :: !(P'.Maybe Ql2.Frame.FrameType), pos :: !(P'.Maybe P'.Int64), opt :: !(P'.Maybe P'.Utf8)}-           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable Frame where-  mergeAppend (Frame x'1 x'2 x'3) (Frame y'1 y'2 y'3)-   = Frame (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)- -instance P'.Default Frame where-  defaultValue = Frame P'.defaultValue P'.defaultValue P'.defaultValue- -instance P'.Wire Frame where-  wireSize ft' self'@(Frame x'1 x'2 x'3)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = (P'.wireSizeOpt 1 14 x'1 + P'.wireSizeOpt 1 3 x'2 + P'.wireSizeOpt 1 9 x'3)-  wirePut ft' self'@(Frame x'1 x'2 x'3)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutOpt 8 14 x'1-             P'.wirePutOpt 16 3 x'2-             P'.wirePutOpt 26 9 x'3-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             8 -> Prelude'.fmap (\ !new'Field -> old'Self{type' = Prelude'.Just new'Field}) (P'.wireGet 14)-             16 -> Prelude'.fmap (\ !new'Field -> old'Self{pos = Prelude'.Just new'Field}) (P'.wireGet 3)-             26 -> Prelude'.fmap (\ !new'Field -> old'Self{opt = Prelude'.Just new'Field}) (P'.wireGet 9)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> Frame) Frame where-  getVal m' f' = f' m'- -instance P'.GPB Frame- -instance P'.ReflectDescriptor Frame where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 16, 26])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Frame\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Frame\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Frame.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Frame.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Frame\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Frame.FrameType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Frame\"], baseName = MName \"FrameType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Frame.pos\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Frame\"], baseName' = FName \"pos\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Frame.opt\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Frame\"], baseName' = FName \"opt\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Frame/FrameType.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Frame.FrameType (FrameType(..)) where-import Prelude ((+), (/), (.))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data FrameType = POS-               | OPT-               deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable FrameType- -instance Prelude'.Bounded FrameType where-  minBound = POS-  maxBound = OPT- -instance P'.Default FrameType where-  defaultValue = POS- -toMaybe'Enum :: Prelude'.Int -> P'.Maybe FrameType-toMaybe'Enum 1 = Prelude'.Just POS-toMaybe'Enum 2 = Prelude'.Just OPT-toMaybe'Enum _ = Prelude'.Nothing- -instance Prelude'.Enum FrameType where-  fromEnum POS = 1-  fromEnum OPT = 2-  toEnum-   = P'.fromMaybe (Prelude'.error "hprotoc generated code: toEnum failure for type Database.RethinkDB.Protobuf.Ql2.Frame.FrameType")-      . toMaybe'Enum-  succ POS = OPT-  succ _ = Prelude'.error "hprotoc generated code: succ failure for type Database.RethinkDB.Protobuf.Ql2.Frame.FrameType"-  pred OPT = POS-  pred _ = Prelude'.error "hprotoc generated code: pred failure for type Database.RethinkDB.Protobuf.Ql2.Frame.FrameType"- -instance P'.Wire FrameType where-  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)-  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)-  wireGet 14 = P'.wireGetEnum toMaybe'Enum-  wireGet ft' = P'.wireGetErr ft'-  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum-  wireGetPacked ft' = P'.wireGetErr ft'- -instance P'.GPB FrameType- -instance P'.MessageAPI msg' (msg' -> FrameType) FrameType where-  getVal m' f' = f' m'- -instance P'.ReflectEnum FrameType where-  reflectEnum = [(1, "POS", POS), (2, "OPT", OPT)]-  reflectEnumInfo _-   = P'.EnumInfo (P'.makePNF (P'.pack ".Ql2.Frame.FrameType") ["Database", "RethinkDB", "Protobuf"] ["Ql2", "Frame"] "FrameType")-      ["Database", "RethinkDB", "Protobuf", "Ql2", "Frame", "FrameType.hs"]-      [(1, "POS"), (2, "OPT")]
− Database/RethinkDB/Protobuf/Ql2/Query.hs 
@@ -1,75 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Query (Query(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Database.RethinkDB.Protobuf.Ql2.Query.AssocPair as Ql2.Query (AssocPair)-import qualified Database.RethinkDB.Protobuf.Ql2.Query.QueryType as Ql2.Query (QueryType)-import qualified Database.RethinkDB.Protobuf.Ql2.Term as Ql2 (Term)- -data Query = Query{type' :: !(P'.Maybe Ql2.Query.QueryType), query :: !(P'.Maybe Ql2.Term), token :: !(P'.Maybe P'.Int64),-                   oBSOLETE_noreply :: !(P'.Maybe P'.Bool), global_optargs :: !(P'.Seq Ql2.Query.AssocPair)}-           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable Query where-  mergeAppend (Query x'1 x'2 x'3 x'4 x'5) (Query y'1 y'2 y'3 y'4 y'5)-   = Query (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)-      (P'.mergeAppend x'5 y'5)- -instance P'.Default Query where-  defaultValue = Query P'.defaultValue P'.defaultValue P'.defaultValue (Prelude'.Just Prelude'.False) P'.defaultValue- -instance P'.Wire Query where-  wireSize ft' self'@(Query x'1 x'2 x'3 x'4 x'5)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size-         = (P'.wireSizeOpt 1 14 x'1 + P'.wireSizeOpt 1 11 x'2 + P'.wireSizeOpt 1 3 x'3 + P'.wireSizeOpt 1 8 x'4 +-             P'.wireSizeRep 1 11 x'5)-  wirePut ft' self'@(Query x'1 x'2 x'3 x'4 x'5)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutOpt 8 14 x'1-             P'.wirePutOpt 18 11 x'2-             P'.wirePutOpt 24 3 x'3-             P'.wirePutOpt 32 8 x'4-             P'.wirePutRep 50 11 x'5-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             8 -> Prelude'.fmap (\ !new'Field -> old'Self{type' = Prelude'.Just new'Field}) (P'.wireGet 14)-             18 -> Prelude'.fmap (\ !new'Field -> old'Self{query = P'.mergeAppend (query old'Self) (Prelude'.Just new'Field)})-                    (P'.wireGet 11)-             24 -> Prelude'.fmap (\ !new'Field -> old'Self{token = Prelude'.Just new'Field}) (P'.wireGet 3)-             32 -> Prelude'.fmap (\ !new'Field -> old'Self{oBSOLETE_noreply = Prelude'.Just new'Field}) (P'.wireGet 8)-             50 -> Prelude'.fmap (\ !new'Field -> old'Self{global_optargs = P'.append (global_optargs old'Self) new'Field})-                    (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> Query) Query where-  getVal m' f' = f' m'- -instance P'.GPB Query- -instance P'.ReflectDescriptor Query where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 18, 24, 32, 50])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Query\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Query\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Query.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Query.QueryType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Query\"], baseName = MName \"QueryType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.query\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"query\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.token\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"token\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 24}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.OBSOLETE_noreply\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"oBSOLETE_noreply\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 32}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Just \"false\", hsDefault = Just (HsDef'Bool False)},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.global_optargs\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\"], baseName' = FName \"global_optargs\"}, fieldNumber = FieldId {getFieldId = 6}, wireTag = WireTag {getWireTag = 50}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Query.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Query\"], baseName = MName \"AssocPair\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Query/AssocPair.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Query.AssocPair (AssocPair(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Database.RethinkDB.Protobuf.Ql2.Term as Ql2 (Term)- -data AssocPair = AssocPair{key :: !(P'.Maybe P'.Utf8), val :: !(P'.Maybe Ql2.Term)}-               deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable AssocPair where-  mergeAppend (AssocPair x'1 x'2) (AssocPair y'1 y'2) = AssocPair (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)- -instance P'.Default AssocPair where-  defaultValue = AssocPair P'.defaultValue P'.defaultValue- -instance P'.Wire AssocPair where-  wireSize ft' self'@(AssocPair x'1 x'2)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 11 x'2)-  wirePut ft' self'@(AssocPair x'1 x'2)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutOpt 10 9 x'1-             P'.wirePutOpt 18 11 x'2-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             10 -> Prelude'.fmap (\ !new'Field -> old'Self{key = Prelude'.Just new'Field}) (P'.wireGet 9)-             18 -> Prelude'.fmap (\ !new'Field -> old'Self{val = P'.mergeAppend (val old'Self) (Prelude'.Just new'Field)})-                    (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> AssocPair) AssocPair where-  getVal m' f' = f' m'- -instance P'.GPB AssocPair- -instance P'.ReflectDescriptor AssocPair where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 18])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Query.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Query\"], baseName = MName \"AssocPair\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Query\",\"AssocPair.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.AssocPair.key\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\",MName \"AssocPair\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Query.AssocPair.val\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Query\",MName \"AssocPair\"], baseName' = FName \"val\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Query/QueryType.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Query.QueryType (QueryType(..)) where-import Prelude ((+), (/), (.))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data QueryType = START-               | CONTINUE-               | STOP-               deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable QueryType- -instance Prelude'.Bounded QueryType where-  minBound = START-  maxBound = STOP- -instance P'.Default QueryType where-  defaultValue = START- -toMaybe'Enum :: Prelude'.Int -> P'.Maybe QueryType-toMaybe'Enum 1 = Prelude'.Just START-toMaybe'Enum 2 = Prelude'.Just CONTINUE-toMaybe'Enum 3 = Prelude'.Just STOP-toMaybe'Enum _ = Prelude'.Nothing- -instance Prelude'.Enum QueryType where-  fromEnum START = 1-  fromEnum CONTINUE = 2-  fromEnum STOP = 3-  toEnum-   = P'.fromMaybe (Prelude'.error "hprotoc generated code: toEnum failure for type Database.RethinkDB.Protobuf.Ql2.Query.QueryType")-      . toMaybe'Enum-  succ START = CONTINUE-  succ CONTINUE = STOP-  succ _ = Prelude'.error "hprotoc generated code: succ failure for type Database.RethinkDB.Protobuf.Ql2.Query.QueryType"-  pred CONTINUE = START-  pred STOP = CONTINUE-  pred _ = Prelude'.error "hprotoc generated code: pred failure for type Database.RethinkDB.Protobuf.Ql2.Query.QueryType"- -instance P'.Wire QueryType where-  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)-  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)-  wireGet 14 = P'.wireGetEnum toMaybe'Enum-  wireGet ft' = P'.wireGetErr ft'-  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum-  wireGetPacked ft' = P'.wireGetErr ft'- -instance P'.GPB QueryType- -instance P'.MessageAPI msg' (msg' -> QueryType) QueryType where-  getVal m' f' = f' m'- -instance P'.ReflectEnum QueryType where-  reflectEnum = [(1, "START", START), (2, "CONTINUE", CONTINUE), (3, "STOP", STOP)]-  reflectEnumInfo _-   = P'.EnumInfo (P'.makePNF (P'.pack ".Ql2.Query.QueryType") ["Database", "RethinkDB", "Protobuf"] ["Ql2", "Query"] "QueryType")-      ["Database", "RethinkDB", "Protobuf", "Ql2", "Query", "QueryType.hs"]-      [(1, "START"), (2, "CONTINUE"), (3, "STOP")]
− Database/RethinkDB/Protobuf/Ql2/Response.hs 
@@ -1,70 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Response (Response(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Database.RethinkDB.Protobuf.Ql2.Backtrace as Ql2 (Backtrace)-import qualified Database.RethinkDB.Protobuf.Ql2.Datum as Ql2 (Datum)-import qualified Database.RethinkDB.Protobuf.Ql2.Response.ResponseType as Ql2.Response (ResponseType)- -data Response = Response{type' :: !(P'.Maybe Ql2.Response.ResponseType), token :: !(P'.Maybe P'.Int64),-                         response :: !(P'.Seq Ql2.Datum), backtrace :: !(P'.Maybe Ql2.Backtrace)}-              deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable Response where-  mergeAppend (Response x'1 x'2 x'3 x'4) (Response y'1 y'2 y'3 y'4)-   = Response (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)- -instance P'.Default Response where-  defaultValue = Response P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue- -instance P'.Wire Response where-  wireSize ft' self'@(Response x'1 x'2 x'3 x'4)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = (P'.wireSizeOpt 1 14 x'1 + P'.wireSizeOpt 1 3 x'2 + P'.wireSizeRep 1 11 x'3 + P'.wireSizeOpt 1 11 x'4)-  wirePut ft' self'@(Response x'1 x'2 x'3 x'4)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutOpt 8 14 x'1-             P'.wirePutOpt 16 3 x'2-             P'.wirePutRep 26 11 x'3-             P'.wirePutOpt 34 11 x'4-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             8 -> Prelude'.fmap (\ !new'Field -> old'Self{type' = Prelude'.Just new'Field}) (P'.wireGet 14)-             16 -> Prelude'.fmap (\ !new'Field -> old'Self{token = Prelude'.Just new'Field}) (P'.wireGet 3)-             26 -> Prelude'.fmap (\ !new'Field -> old'Self{response = P'.append (response old'Self) new'Field}) (P'.wireGet 11)-             34 -> Prelude'.fmap-                    (\ !new'Field -> old'Self{backtrace = P'.mergeAppend (backtrace old'Self) (Prelude'.Just new'Field)})-                    (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> Response) Response where-  getVal m' f' = f' m'- -instance P'.GPB Response- -instance P'.ReflectDescriptor Response where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 16, 26, 34])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Response\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Response\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Response.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Response.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Response\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Response.ResponseType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Response\"], baseName = MName \"ResponseType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Response.token\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Response\"], baseName' = FName \"token\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 16}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 3}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Response.response\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Response\"], baseName' = FName \"response\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Response.backtrace\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Response\"], baseName' = FName \"backtrace\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Backtrace\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Backtrace\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Response/ResponseType.hs 
@@ -1,81 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Response.ResponseType (ResponseType(..)) where-import Prelude ((+), (/), (.))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data ResponseType = SUCCESS_ATOM-                  | SUCCESS_SEQUENCE-                  | SUCCESS_PARTIAL-                  | CLIENT_ERROR-                  | COMPILE_ERROR-                  | RUNTIME_ERROR-                  deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable ResponseType- -instance Prelude'.Bounded ResponseType where-  minBound = SUCCESS_ATOM-  maxBound = RUNTIME_ERROR- -instance P'.Default ResponseType where-  defaultValue = SUCCESS_ATOM- -toMaybe'Enum :: Prelude'.Int -> P'.Maybe ResponseType-toMaybe'Enum 1 = Prelude'.Just SUCCESS_ATOM-toMaybe'Enum 2 = Prelude'.Just SUCCESS_SEQUENCE-toMaybe'Enum 3 = Prelude'.Just SUCCESS_PARTIAL-toMaybe'Enum 16 = Prelude'.Just CLIENT_ERROR-toMaybe'Enum 17 = Prelude'.Just COMPILE_ERROR-toMaybe'Enum 18 = Prelude'.Just RUNTIME_ERROR-toMaybe'Enum _ = Prelude'.Nothing- -instance Prelude'.Enum ResponseType where-  fromEnum SUCCESS_ATOM = 1-  fromEnum SUCCESS_SEQUENCE = 2-  fromEnum SUCCESS_PARTIAL = 3-  fromEnum CLIENT_ERROR = 16-  fromEnum COMPILE_ERROR = 17-  fromEnum RUNTIME_ERROR = 18-  toEnum-   = P'.fromMaybe-      (Prelude'.error "hprotoc generated code: toEnum failure for type Database.RethinkDB.Protobuf.Ql2.Response.ResponseType")-      . toMaybe'Enum-  succ SUCCESS_ATOM = SUCCESS_SEQUENCE-  succ SUCCESS_SEQUENCE = SUCCESS_PARTIAL-  succ SUCCESS_PARTIAL = CLIENT_ERROR-  succ CLIENT_ERROR = COMPILE_ERROR-  succ COMPILE_ERROR = RUNTIME_ERROR-  succ _ = Prelude'.error "hprotoc generated code: succ failure for type Database.RethinkDB.Protobuf.Ql2.Response.ResponseType"-  pred SUCCESS_SEQUENCE = SUCCESS_ATOM-  pred SUCCESS_PARTIAL = SUCCESS_SEQUENCE-  pred CLIENT_ERROR = SUCCESS_PARTIAL-  pred COMPILE_ERROR = CLIENT_ERROR-  pred RUNTIME_ERROR = COMPILE_ERROR-  pred _ = Prelude'.error "hprotoc generated code: pred failure for type Database.RethinkDB.Protobuf.Ql2.Response.ResponseType"- -instance P'.Wire ResponseType where-  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)-  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)-  wireGet 14 = P'.wireGetEnum toMaybe'Enum-  wireGet ft' = P'.wireGetErr ft'-  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum-  wireGetPacked ft' = P'.wireGetErr ft'- -instance P'.GPB ResponseType- -instance P'.MessageAPI msg' (msg' -> ResponseType) ResponseType where-  getVal m' f' = f' m'- -instance P'.ReflectEnum ResponseType where-  reflectEnum-   = [(1, "SUCCESS_ATOM", SUCCESS_ATOM), (2, "SUCCESS_SEQUENCE", SUCCESS_SEQUENCE), (3, "SUCCESS_PARTIAL", SUCCESS_PARTIAL),-      (16, "CLIENT_ERROR", CLIENT_ERROR), (17, "COMPILE_ERROR", COMPILE_ERROR), (18, "RUNTIME_ERROR", RUNTIME_ERROR)]-  reflectEnumInfo _-   = P'.EnumInfo-      (P'.makePNF (P'.pack ".Ql2.Response.ResponseType") ["Database", "RethinkDB", "Protobuf"] ["Ql2", "Response"] "ResponseType")-      ["Database", "RethinkDB", "Protobuf", "Ql2", "Response", "ResponseType.hs"]-      [(1, "SUCCESS_ATOM"), (2, "SUCCESS_SEQUENCE"), (3, "SUCCESS_PARTIAL"), (16, "CLIENT_ERROR"), (17, "COMPILE_ERROR"),-       (18, "RUNTIME_ERROR")]
− Database/RethinkDB/Protobuf/Ql2/Term.hs 
@@ -1,80 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Term (Term(..)) where-import Prelude ((+), (/), (==), (<=), (&&))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Database.RethinkDB.Protobuf.Ql2.Datum as Ql2 (Datum)-import {-# SOURCE #-} qualified Database.RethinkDB.Protobuf.Ql2.Term.AssocPair as Ql2.Term (AssocPair)-import qualified Database.RethinkDB.Protobuf.Ql2.Term.TermType as Ql2.Term (TermType)- -data Term = Term{type' :: !(P'.Maybe Ql2.Term.TermType), datum :: !(P'.Maybe Ql2.Datum), args :: !(P'.Seq Term),-                 optargs :: !(P'.Seq Ql2.Term.AssocPair), ext'field :: !P'.ExtField}-          deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.ExtendMessage Term where-  getExtField = ext'field-  putExtField e'f msg = msg{ext'field = e'f}-  validExtRanges msg = P'.extRanges (P'.reflectDescriptorInfo msg)- -instance P'.Mergeable Term where-  mergeAppend (Term x'1 x'2 x'3 x'4 x'5) (Term y'1 y'2 y'3 y'4 y'5)-   = Term (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)-      (P'.mergeAppend x'5 y'5)- -instance P'.Default Term where-  defaultValue = Term P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue- -instance P'.Wire Term where-  wireSize ft' self'@(Term x'1 x'2 x'3 x'4 x'5)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size-         = (P'.wireSizeOpt 1 14 x'1 + P'.wireSizeOpt 1 11 x'2 + P'.wireSizeRep 1 11 x'3 + P'.wireSizeRep 1 11 x'4 +-             P'.wireSizeExtField x'5)-  wirePut ft' self'@(Term x'1 x'2 x'3 x'4 x'5)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutOpt 8 14 x'1-             P'.wirePutOpt 18 11 x'2-             P'.wirePutRep 26 11 x'3-             P'.wirePutRep 34 11 x'4-             P'.wirePutExtField x'5-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             8 -> Prelude'.fmap (\ !new'Field -> old'Self{type' = Prelude'.Just new'Field}) (P'.wireGet 14)-             18 -> Prelude'.fmap (\ !new'Field -> old'Self{datum = P'.mergeAppend (datum old'Self) (Prelude'.Just new'Field)})-                    (P'.wireGet 11)-             26 -> Prelude'.fmap (\ !new'Field -> old'Self{args = P'.append (args old'Self) new'Field}) (P'.wireGet 11)-             34 -> Prelude'.fmap (\ !new'Field -> old'Self{optargs = P'.append (optargs old'Self) new'Field}) (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in-                   if Prelude'.or [10000 <= field'Number && field'Number <= 18999, field'Number == 20000] then-                    P'.loadExtension field'Number wire'Type old'Self else P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> Term) Term where-  getVal m' f' = f' m'- -instance P'.GPB Term- -instance P'.ReflectDescriptor Term where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 18, 26, 34])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Term.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.type\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\"], baseName' = FName \"type'\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term.TermType\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Term\"], baseName = MName \"TermType\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.datum\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\"], baseName' = FName \"datum\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Datum\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Datum\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.args\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\"], baseName' = FName \"args\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.optargs\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\"], baseName' = FName \"optargs\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Term\"], baseName = MName \"AssocPair\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [(FieldId {getFieldId = 10000},FieldId {getFieldId = 18999}),(FieldId {getFieldId = 20000},FieldId {getFieldId = 20000})], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Term/AssocPair.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Term.AssocPair (AssocPair(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'-import qualified Database.RethinkDB.Protobuf.Ql2.Term as Ql2 (Term)- -data AssocPair = AssocPair{key :: !(P'.Maybe P'.Utf8), val :: !(P'.Maybe Ql2.Term)}-               deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable AssocPair where-  mergeAppend (AssocPair x'1 x'2) (AssocPair y'1 y'2) = AssocPair (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)- -instance P'.Default AssocPair where-  defaultValue = AssocPair P'.defaultValue P'.defaultValue- -instance P'.Wire AssocPair where-  wireSize ft' self'@(AssocPair x'1 x'2)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = (P'.wireSizeOpt 1 9 x'1 + P'.wireSizeOpt 1 11 x'2)-  wirePut ft' self'@(AssocPair x'1 x'2)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             P'.wirePutOpt 10 9 x'1-             P'.wirePutOpt 18 11 x'2-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             10 -> Prelude'.fmap (\ !new'Field -> old'Self{key = Prelude'.Just new'Field}) (P'.wireGet 9)-             18 -> Prelude'.fmap (\ !new'Field -> old'Self{val = P'.mergeAppend (val old'Self) (Prelude'.Just new'Field)})-                    (P'.wireGet 11)-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> AssocPair) AssocPair where-  getVal m' f' = f' m'- -instance P'.GPB AssocPair- -instance P'.ReflectDescriptor AssocPair where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10, 18])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.Term.AssocPair\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\",MName \"Term\"], baseName = MName \"AssocPair\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"Term\",\"AssocPair.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.AssocPair.key\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\",MName \"AssocPair\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Ql2.Term.AssocPair.val\", haskellPrefix' = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule' = [MName \"Ql2\",MName \"Term\",MName \"AssocPair\"], baseName' = FName \"val\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Ql2.Term\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"Term\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/Term/AssocPair.hs-boot 
@@ -1,30 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Term.AssocPair (AssocPair) where-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data AssocPair- -instance P'.MessageAPI msg' (msg' -> AssocPair) AssocPair- -instance Prelude'.Show AssocPair- -instance Prelude'.Eq AssocPair- -instance Prelude'.Ord AssocPair- -instance Prelude'.Typeable AssocPair- -instance Prelude'.Data AssocPair- -instance P'.Mergeable AssocPair- -instance P'.Default AssocPair- -instance P'.Wire AssocPair- -instance P'.GPB AssocPair- -instance P'.ReflectDescriptor AssocPair
− Database/RethinkDB/Protobuf/Ql2/Term/TermType.hs 
@@ -1,744 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.Term.TermType (TermType(..)) where-import Prelude ((+), (/), (.))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data TermType = DATUM-              | MAKE_ARRAY-              | MAKE_OBJ-              | VAR-              | JAVASCRIPT-              | ERROR-              | IMPLICIT_VAR-              | DB-              | TABLE-              | GET-              | GET_ALL-              | EQ-              | NE-              | LT-              | LE-              | GT-              | GE-              | NOT-              | ADD-              | SUB-              | MUL-              | DIV-              | MOD-              | APPEND-              | PREPEND-              | DIFFERENCE-              | SET_INSERT-              | SET_INTERSECTION-              | SET_UNION-              | SET_DIFFERENCE-              | SLICE-              | SKIP-              | LIMIT-              | INDEXES_OF-              | CONTAINS-              | GET_FIELD-              | KEYS-              | HAS_FIELDS-              | WITH_FIELDS-              | PLUCK-              | WITHOUT-              | MERGE-              | BETWEEN-              | REDUCE-              | MAP-              | FILTER-              | CONCATMAP-              | ORDERBY-              | DISTINCT-              | COUNT-              | IS_EMPTY-              | UNION-              | NTH-              | GROUPED_MAP_REDUCE-              | GROUPBY-              | INNER_JOIN-              | OUTER_JOIN-              | EQ_JOIN-              | ZIP-              | INSERT_AT-              | DELETE_AT-              | CHANGE_AT-              | SPLICE_AT-              | COERCE_TO-              | TYPEOF-              | UPDATE-              | DELETE-              | REPLACE-              | INSERT-              | DB_CREATE-              | DB_DROP-              | DB_LIST-              | TABLE_CREATE-              | TABLE_DROP-              | TABLE_LIST-              | INDEX_CREATE-              | INDEX_DROP-              | INDEX_LIST-              | FUNCALL-              | BRANCH-              | ANY-              | ALL-              | FOREACH-              | FUNC-              | ASC-              | DESC-              | INFO-              | MATCH-              | SAMPLE-              | DEFAULT-              | JSON-              | ISO8601-              | TO_ISO8601-              | EPOCH_TIME-              | TO_EPOCH_TIME-              | NOW-              | IN_TIMEZONE-              | DURING-              | DATE-              | TIME_OF_DAY-              | TIMEZONE-              | YEAR-              | MONTH-              | DAY-              | DAY_OF_WEEK-              | DAY_OF_YEAR-              | HOURS-              | MINUTES-              | SECONDS-              | TIME-              | MONDAY-              | TUESDAY-              | WEDNESDAY-              | THURSDAY-              | FRIDAY-              | SATURDAY-              | SUNDAY-              | JANUARY-              | FEBRUARY-              | MARCH-              | APRIL-              | MAY-              | JUNE-              | JULY-              | AUGUST-              | SEPTEMBER-              | OCTOBER-              | NOVEMBER-              | DECEMBER-              | LITERAL-              deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable TermType- -instance Prelude'.Bounded TermType where-  minBound = DATUM-  maxBound = LITERAL- -instance P'.Default TermType where-  defaultValue = DATUM- -toMaybe'Enum :: Prelude'.Int -> P'.Maybe TermType-toMaybe'Enum 1 = Prelude'.Just DATUM-toMaybe'Enum 2 = Prelude'.Just MAKE_ARRAY-toMaybe'Enum 3 = Prelude'.Just MAKE_OBJ-toMaybe'Enum 10 = Prelude'.Just VAR-toMaybe'Enum 11 = Prelude'.Just JAVASCRIPT-toMaybe'Enum 12 = Prelude'.Just ERROR-toMaybe'Enum 13 = Prelude'.Just IMPLICIT_VAR-toMaybe'Enum 14 = Prelude'.Just DB-toMaybe'Enum 15 = Prelude'.Just TABLE-toMaybe'Enum 16 = Prelude'.Just GET-toMaybe'Enum 78 = Prelude'.Just GET_ALL-toMaybe'Enum 17 = Prelude'.Just EQ-toMaybe'Enum 18 = Prelude'.Just NE-toMaybe'Enum 19 = Prelude'.Just LT-toMaybe'Enum 20 = Prelude'.Just LE-toMaybe'Enum 21 = Prelude'.Just GT-toMaybe'Enum 22 = Prelude'.Just GE-toMaybe'Enum 23 = Prelude'.Just NOT-toMaybe'Enum 24 = Prelude'.Just ADD-toMaybe'Enum 25 = Prelude'.Just SUB-toMaybe'Enum 26 = Prelude'.Just MUL-toMaybe'Enum 27 = Prelude'.Just DIV-toMaybe'Enum 28 = Prelude'.Just MOD-toMaybe'Enum 29 = Prelude'.Just APPEND-toMaybe'Enum 80 = Prelude'.Just PREPEND-toMaybe'Enum 95 = Prelude'.Just DIFFERENCE-toMaybe'Enum 88 = Prelude'.Just SET_INSERT-toMaybe'Enum 89 = Prelude'.Just SET_INTERSECTION-toMaybe'Enum 90 = Prelude'.Just SET_UNION-toMaybe'Enum 91 = Prelude'.Just SET_DIFFERENCE-toMaybe'Enum 30 = Prelude'.Just SLICE-toMaybe'Enum 70 = Prelude'.Just SKIP-toMaybe'Enum 71 = Prelude'.Just LIMIT-toMaybe'Enum 87 = Prelude'.Just INDEXES_OF-toMaybe'Enum 93 = Prelude'.Just CONTAINS-toMaybe'Enum 31 = Prelude'.Just GET_FIELD-toMaybe'Enum 94 = Prelude'.Just KEYS-toMaybe'Enum 32 = Prelude'.Just HAS_FIELDS-toMaybe'Enum 96 = Prelude'.Just WITH_FIELDS-toMaybe'Enum 33 = Prelude'.Just PLUCK-toMaybe'Enum 34 = Prelude'.Just WITHOUT-toMaybe'Enum 35 = Prelude'.Just MERGE-toMaybe'Enum 36 = Prelude'.Just BETWEEN-toMaybe'Enum 37 = Prelude'.Just REDUCE-toMaybe'Enum 38 = Prelude'.Just MAP-toMaybe'Enum 39 = Prelude'.Just FILTER-toMaybe'Enum 40 = Prelude'.Just CONCATMAP-toMaybe'Enum 41 = Prelude'.Just ORDERBY-toMaybe'Enum 42 = Prelude'.Just DISTINCT-toMaybe'Enum 43 = Prelude'.Just COUNT-toMaybe'Enum 86 = Prelude'.Just IS_EMPTY-toMaybe'Enum 44 = Prelude'.Just UNION-toMaybe'Enum 45 = Prelude'.Just NTH-toMaybe'Enum 46 = Prelude'.Just GROUPED_MAP_REDUCE-toMaybe'Enum 47 = Prelude'.Just GROUPBY-toMaybe'Enum 48 = Prelude'.Just INNER_JOIN-toMaybe'Enum 49 = Prelude'.Just OUTER_JOIN-toMaybe'Enum 50 = Prelude'.Just EQ_JOIN-toMaybe'Enum 72 = Prelude'.Just ZIP-toMaybe'Enum 82 = Prelude'.Just INSERT_AT-toMaybe'Enum 83 = Prelude'.Just DELETE_AT-toMaybe'Enum 84 = Prelude'.Just CHANGE_AT-toMaybe'Enum 85 = Prelude'.Just SPLICE_AT-toMaybe'Enum 51 = Prelude'.Just COERCE_TO-toMaybe'Enum 52 = Prelude'.Just TYPEOF-toMaybe'Enum 53 = Prelude'.Just UPDATE-toMaybe'Enum 54 = Prelude'.Just DELETE-toMaybe'Enum 55 = Prelude'.Just REPLACE-toMaybe'Enum 56 = Prelude'.Just INSERT-toMaybe'Enum 57 = Prelude'.Just DB_CREATE-toMaybe'Enum 58 = Prelude'.Just DB_DROP-toMaybe'Enum 59 = Prelude'.Just DB_LIST-toMaybe'Enum 60 = Prelude'.Just TABLE_CREATE-toMaybe'Enum 61 = Prelude'.Just TABLE_DROP-toMaybe'Enum 62 = Prelude'.Just TABLE_LIST-toMaybe'Enum 75 = Prelude'.Just INDEX_CREATE-toMaybe'Enum 76 = Prelude'.Just INDEX_DROP-toMaybe'Enum 77 = Prelude'.Just INDEX_LIST-toMaybe'Enum 64 = Prelude'.Just FUNCALL-toMaybe'Enum 65 = Prelude'.Just BRANCH-toMaybe'Enum 66 = Prelude'.Just ANY-toMaybe'Enum 67 = Prelude'.Just ALL-toMaybe'Enum 68 = Prelude'.Just FOREACH-toMaybe'Enum 69 = Prelude'.Just FUNC-toMaybe'Enum 73 = Prelude'.Just ASC-toMaybe'Enum 74 = Prelude'.Just DESC-toMaybe'Enum 79 = Prelude'.Just INFO-toMaybe'Enum 97 = Prelude'.Just MATCH-toMaybe'Enum 81 = Prelude'.Just SAMPLE-toMaybe'Enum 92 = Prelude'.Just DEFAULT-toMaybe'Enum 98 = Prelude'.Just JSON-toMaybe'Enum 99 = Prelude'.Just ISO8601-toMaybe'Enum 100 = Prelude'.Just TO_ISO8601-toMaybe'Enum 101 = Prelude'.Just EPOCH_TIME-toMaybe'Enum 102 = Prelude'.Just TO_EPOCH_TIME-toMaybe'Enum 103 = Prelude'.Just NOW-toMaybe'Enum 104 = Prelude'.Just IN_TIMEZONE-toMaybe'Enum 105 = Prelude'.Just DURING-toMaybe'Enum 106 = Prelude'.Just DATE-toMaybe'Enum 126 = Prelude'.Just TIME_OF_DAY-toMaybe'Enum 127 = Prelude'.Just TIMEZONE-toMaybe'Enum 128 = Prelude'.Just YEAR-toMaybe'Enum 129 = Prelude'.Just MONTH-toMaybe'Enum 130 = Prelude'.Just DAY-toMaybe'Enum 131 = Prelude'.Just DAY_OF_WEEK-toMaybe'Enum 132 = Prelude'.Just DAY_OF_YEAR-toMaybe'Enum 133 = Prelude'.Just HOURS-toMaybe'Enum 134 = Prelude'.Just MINUTES-toMaybe'Enum 135 = Prelude'.Just SECONDS-toMaybe'Enum 136 = Prelude'.Just TIME-toMaybe'Enum 107 = Prelude'.Just MONDAY-toMaybe'Enum 108 = Prelude'.Just TUESDAY-toMaybe'Enum 109 = Prelude'.Just WEDNESDAY-toMaybe'Enum 110 = Prelude'.Just THURSDAY-toMaybe'Enum 111 = Prelude'.Just FRIDAY-toMaybe'Enum 112 = Prelude'.Just SATURDAY-toMaybe'Enum 113 = Prelude'.Just SUNDAY-toMaybe'Enum 114 = Prelude'.Just JANUARY-toMaybe'Enum 115 = Prelude'.Just FEBRUARY-toMaybe'Enum 116 = Prelude'.Just MARCH-toMaybe'Enum 117 = Prelude'.Just APRIL-toMaybe'Enum 118 = Prelude'.Just MAY-toMaybe'Enum 119 = Prelude'.Just JUNE-toMaybe'Enum 120 = Prelude'.Just JULY-toMaybe'Enum 121 = Prelude'.Just AUGUST-toMaybe'Enum 122 = Prelude'.Just SEPTEMBER-toMaybe'Enum 123 = Prelude'.Just OCTOBER-toMaybe'Enum 124 = Prelude'.Just NOVEMBER-toMaybe'Enum 125 = Prelude'.Just DECEMBER-toMaybe'Enum 137 = Prelude'.Just LITERAL-toMaybe'Enum _ = Prelude'.Nothing- -instance Prelude'.Enum TermType where-  fromEnum DATUM = 1-  fromEnum MAKE_ARRAY = 2-  fromEnum MAKE_OBJ = 3-  fromEnum VAR = 10-  fromEnum JAVASCRIPT = 11-  fromEnum ERROR = 12-  fromEnum IMPLICIT_VAR = 13-  fromEnum DB = 14-  fromEnum TABLE = 15-  fromEnum GET = 16-  fromEnum GET_ALL = 78-  fromEnum EQ = 17-  fromEnum NE = 18-  fromEnum LT = 19-  fromEnum LE = 20-  fromEnum GT = 21-  fromEnum GE = 22-  fromEnum NOT = 23-  fromEnum ADD = 24-  fromEnum SUB = 25-  fromEnum MUL = 26-  fromEnum DIV = 27-  fromEnum MOD = 28-  fromEnum APPEND = 29-  fromEnum PREPEND = 80-  fromEnum DIFFERENCE = 95-  fromEnum SET_INSERT = 88-  fromEnum SET_INTERSECTION = 89-  fromEnum SET_UNION = 90-  fromEnum SET_DIFFERENCE = 91-  fromEnum SLICE = 30-  fromEnum SKIP = 70-  fromEnum LIMIT = 71-  fromEnum INDEXES_OF = 87-  fromEnum CONTAINS = 93-  fromEnum GET_FIELD = 31-  fromEnum KEYS = 94-  fromEnum HAS_FIELDS = 32-  fromEnum WITH_FIELDS = 96-  fromEnum PLUCK = 33-  fromEnum WITHOUT = 34-  fromEnum MERGE = 35-  fromEnum BETWEEN = 36-  fromEnum REDUCE = 37-  fromEnum MAP = 38-  fromEnum FILTER = 39-  fromEnum CONCATMAP = 40-  fromEnum ORDERBY = 41-  fromEnum DISTINCT = 42-  fromEnum COUNT = 43-  fromEnum IS_EMPTY = 86-  fromEnum UNION = 44-  fromEnum NTH = 45-  fromEnum GROUPED_MAP_REDUCE = 46-  fromEnum GROUPBY = 47-  fromEnum INNER_JOIN = 48-  fromEnum OUTER_JOIN = 49-  fromEnum EQ_JOIN = 50-  fromEnum ZIP = 72-  fromEnum INSERT_AT = 82-  fromEnum DELETE_AT = 83-  fromEnum CHANGE_AT = 84-  fromEnum SPLICE_AT = 85-  fromEnum COERCE_TO = 51-  fromEnum TYPEOF = 52-  fromEnum UPDATE = 53-  fromEnum DELETE = 54-  fromEnum REPLACE = 55-  fromEnum INSERT = 56-  fromEnum DB_CREATE = 57-  fromEnum DB_DROP = 58-  fromEnum DB_LIST = 59-  fromEnum TABLE_CREATE = 60-  fromEnum TABLE_DROP = 61-  fromEnum TABLE_LIST = 62-  fromEnum INDEX_CREATE = 75-  fromEnum INDEX_DROP = 76-  fromEnum INDEX_LIST = 77-  fromEnum FUNCALL = 64-  fromEnum BRANCH = 65-  fromEnum ANY = 66-  fromEnum ALL = 67-  fromEnum FOREACH = 68-  fromEnum FUNC = 69-  fromEnum ASC = 73-  fromEnum DESC = 74-  fromEnum INFO = 79-  fromEnum MATCH = 97-  fromEnum SAMPLE = 81-  fromEnum DEFAULT = 92-  fromEnum JSON = 98-  fromEnum ISO8601 = 99-  fromEnum TO_ISO8601 = 100-  fromEnum EPOCH_TIME = 101-  fromEnum TO_EPOCH_TIME = 102-  fromEnum NOW = 103-  fromEnum IN_TIMEZONE = 104-  fromEnum DURING = 105-  fromEnum DATE = 106-  fromEnum TIME_OF_DAY = 126-  fromEnum TIMEZONE = 127-  fromEnum YEAR = 128-  fromEnum MONTH = 129-  fromEnum DAY = 130-  fromEnum DAY_OF_WEEK = 131-  fromEnum DAY_OF_YEAR = 132-  fromEnum HOURS = 133-  fromEnum MINUTES = 134-  fromEnum SECONDS = 135-  fromEnum TIME = 136-  fromEnum MONDAY = 107-  fromEnum TUESDAY = 108-  fromEnum WEDNESDAY = 109-  fromEnum THURSDAY = 110-  fromEnum FRIDAY = 111-  fromEnum SATURDAY = 112-  fromEnum SUNDAY = 113-  fromEnum JANUARY = 114-  fromEnum FEBRUARY = 115-  fromEnum MARCH = 116-  fromEnum APRIL = 117-  fromEnum MAY = 118-  fromEnum JUNE = 119-  fromEnum JULY = 120-  fromEnum AUGUST = 121-  fromEnum SEPTEMBER = 122-  fromEnum OCTOBER = 123-  fromEnum NOVEMBER = 124-  fromEnum DECEMBER = 125-  fromEnum LITERAL = 137-  toEnum-   = P'.fromMaybe (Prelude'.error "hprotoc generated code: toEnum failure for type Database.RethinkDB.Protobuf.Ql2.Term.TermType") .-      toMaybe'Enum-  succ DATUM = MAKE_ARRAY-  succ MAKE_ARRAY = MAKE_OBJ-  succ MAKE_OBJ = VAR-  succ VAR = JAVASCRIPT-  succ JAVASCRIPT = ERROR-  succ ERROR = IMPLICIT_VAR-  succ IMPLICIT_VAR = DB-  succ DB = TABLE-  succ TABLE = GET-  succ GET = GET_ALL-  succ GET_ALL = EQ-  succ EQ = NE-  succ NE = LT-  succ LT = LE-  succ LE = GT-  succ GT = GE-  succ GE = NOT-  succ NOT = ADD-  succ ADD = SUB-  succ SUB = MUL-  succ MUL = DIV-  succ DIV = MOD-  succ MOD = APPEND-  succ APPEND = PREPEND-  succ PREPEND = DIFFERENCE-  succ DIFFERENCE = SET_INSERT-  succ SET_INSERT = SET_INTERSECTION-  succ SET_INTERSECTION = SET_UNION-  succ SET_UNION = SET_DIFFERENCE-  succ SET_DIFFERENCE = SLICE-  succ SLICE = SKIP-  succ SKIP = LIMIT-  succ LIMIT = INDEXES_OF-  succ INDEXES_OF = CONTAINS-  succ CONTAINS = GET_FIELD-  succ GET_FIELD = KEYS-  succ KEYS = HAS_FIELDS-  succ HAS_FIELDS = WITH_FIELDS-  succ WITH_FIELDS = PLUCK-  succ PLUCK = WITHOUT-  succ WITHOUT = MERGE-  succ MERGE = BETWEEN-  succ BETWEEN = REDUCE-  succ REDUCE = MAP-  succ MAP = FILTER-  succ FILTER = CONCATMAP-  succ CONCATMAP = ORDERBY-  succ ORDERBY = DISTINCT-  succ DISTINCT = COUNT-  succ COUNT = IS_EMPTY-  succ IS_EMPTY = UNION-  succ UNION = NTH-  succ NTH = GROUPED_MAP_REDUCE-  succ GROUPED_MAP_REDUCE = GROUPBY-  succ GROUPBY = INNER_JOIN-  succ INNER_JOIN = OUTER_JOIN-  succ OUTER_JOIN = EQ_JOIN-  succ EQ_JOIN = ZIP-  succ ZIP = INSERT_AT-  succ INSERT_AT = DELETE_AT-  succ DELETE_AT = CHANGE_AT-  succ CHANGE_AT = SPLICE_AT-  succ SPLICE_AT = COERCE_TO-  succ COERCE_TO = TYPEOF-  succ TYPEOF = UPDATE-  succ UPDATE = DELETE-  succ DELETE = REPLACE-  succ REPLACE = INSERT-  succ INSERT = DB_CREATE-  succ DB_CREATE = DB_DROP-  succ DB_DROP = DB_LIST-  succ DB_LIST = TABLE_CREATE-  succ TABLE_CREATE = TABLE_DROP-  succ TABLE_DROP = TABLE_LIST-  succ TABLE_LIST = INDEX_CREATE-  succ INDEX_CREATE = INDEX_DROP-  succ INDEX_DROP = INDEX_LIST-  succ INDEX_LIST = FUNCALL-  succ FUNCALL = BRANCH-  succ BRANCH = ANY-  succ ANY = ALL-  succ ALL = FOREACH-  succ FOREACH = FUNC-  succ FUNC = ASC-  succ ASC = DESC-  succ DESC = INFO-  succ INFO = MATCH-  succ MATCH = SAMPLE-  succ SAMPLE = DEFAULT-  succ DEFAULT = JSON-  succ JSON = ISO8601-  succ ISO8601 = TO_ISO8601-  succ TO_ISO8601 = EPOCH_TIME-  succ EPOCH_TIME = TO_EPOCH_TIME-  succ TO_EPOCH_TIME = NOW-  succ NOW = IN_TIMEZONE-  succ IN_TIMEZONE = DURING-  succ DURING = DATE-  succ DATE = TIME_OF_DAY-  succ TIME_OF_DAY = TIMEZONE-  succ TIMEZONE = YEAR-  succ YEAR = MONTH-  succ MONTH = DAY-  succ DAY = DAY_OF_WEEK-  succ DAY_OF_WEEK = DAY_OF_YEAR-  succ DAY_OF_YEAR = HOURS-  succ HOURS = MINUTES-  succ MINUTES = SECONDS-  succ SECONDS = TIME-  succ TIME = MONDAY-  succ MONDAY = TUESDAY-  succ TUESDAY = WEDNESDAY-  succ WEDNESDAY = THURSDAY-  succ THURSDAY = FRIDAY-  succ FRIDAY = SATURDAY-  succ SATURDAY = SUNDAY-  succ SUNDAY = JANUARY-  succ JANUARY = FEBRUARY-  succ FEBRUARY = MARCH-  succ MARCH = APRIL-  succ APRIL = MAY-  succ MAY = JUNE-  succ JUNE = JULY-  succ JULY = AUGUST-  succ AUGUST = SEPTEMBER-  succ SEPTEMBER = OCTOBER-  succ OCTOBER = NOVEMBER-  succ NOVEMBER = DECEMBER-  succ DECEMBER = LITERAL-  succ _ = Prelude'.error "hprotoc generated code: succ failure for type Database.RethinkDB.Protobuf.Ql2.Term.TermType"-  pred MAKE_ARRAY = DATUM-  pred MAKE_OBJ = MAKE_ARRAY-  pred VAR = MAKE_OBJ-  pred JAVASCRIPT = VAR-  pred ERROR = JAVASCRIPT-  pred IMPLICIT_VAR = ERROR-  pred DB = IMPLICIT_VAR-  pred TABLE = DB-  pred GET = TABLE-  pred GET_ALL = GET-  pred EQ = GET_ALL-  pred NE = EQ-  pred LT = NE-  pred LE = LT-  pred GT = LE-  pred GE = GT-  pred NOT = GE-  pred ADD = NOT-  pred SUB = ADD-  pred MUL = SUB-  pred DIV = MUL-  pred MOD = DIV-  pred APPEND = MOD-  pred PREPEND = APPEND-  pred DIFFERENCE = PREPEND-  pred SET_INSERT = DIFFERENCE-  pred SET_INTERSECTION = SET_INSERT-  pred SET_UNION = SET_INTERSECTION-  pred SET_DIFFERENCE = SET_UNION-  pred SLICE = SET_DIFFERENCE-  pred SKIP = SLICE-  pred LIMIT = SKIP-  pred INDEXES_OF = LIMIT-  pred CONTAINS = INDEXES_OF-  pred GET_FIELD = CONTAINS-  pred KEYS = GET_FIELD-  pred HAS_FIELDS = KEYS-  pred WITH_FIELDS = HAS_FIELDS-  pred PLUCK = WITH_FIELDS-  pred WITHOUT = PLUCK-  pred MERGE = WITHOUT-  pred BETWEEN = MERGE-  pred REDUCE = BETWEEN-  pred MAP = REDUCE-  pred FILTER = MAP-  pred CONCATMAP = FILTER-  pred ORDERBY = CONCATMAP-  pred DISTINCT = ORDERBY-  pred COUNT = DISTINCT-  pred IS_EMPTY = COUNT-  pred UNION = IS_EMPTY-  pred NTH = UNION-  pred GROUPED_MAP_REDUCE = NTH-  pred GROUPBY = GROUPED_MAP_REDUCE-  pred INNER_JOIN = GROUPBY-  pred OUTER_JOIN = INNER_JOIN-  pred EQ_JOIN = OUTER_JOIN-  pred ZIP = EQ_JOIN-  pred INSERT_AT = ZIP-  pred DELETE_AT = INSERT_AT-  pred CHANGE_AT = DELETE_AT-  pred SPLICE_AT = CHANGE_AT-  pred COERCE_TO = SPLICE_AT-  pred TYPEOF = COERCE_TO-  pred UPDATE = TYPEOF-  pred DELETE = UPDATE-  pred REPLACE = DELETE-  pred INSERT = REPLACE-  pred DB_CREATE = INSERT-  pred DB_DROP = DB_CREATE-  pred DB_LIST = DB_DROP-  pred TABLE_CREATE = DB_LIST-  pred TABLE_DROP = TABLE_CREATE-  pred TABLE_LIST = TABLE_DROP-  pred INDEX_CREATE = TABLE_LIST-  pred INDEX_DROP = INDEX_CREATE-  pred INDEX_LIST = INDEX_DROP-  pred FUNCALL = INDEX_LIST-  pred BRANCH = FUNCALL-  pred ANY = BRANCH-  pred ALL = ANY-  pred FOREACH = ALL-  pred FUNC = FOREACH-  pred ASC = FUNC-  pred DESC = ASC-  pred INFO = DESC-  pred MATCH = INFO-  pred SAMPLE = MATCH-  pred DEFAULT = SAMPLE-  pred JSON = DEFAULT-  pred ISO8601 = JSON-  pred TO_ISO8601 = ISO8601-  pred EPOCH_TIME = TO_ISO8601-  pred TO_EPOCH_TIME = EPOCH_TIME-  pred NOW = TO_EPOCH_TIME-  pred IN_TIMEZONE = NOW-  pred DURING = IN_TIMEZONE-  pred DATE = DURING-  pred TIME_OF_DAY = DATE-  pred TIMEZONE = TIME_OF_DAY-  pred YEAR = TIMEZONE-  pred MONTH = YEAR-  pred DAY = MONTH-  pred DAY_OF_WEEK = DAY-  pred DAY_OF_YEAR = DAY_OF_WEEK-  pred HOURS = DAY_OF_YEAR-  pred MINUTES = HOURS-  pred SECONDS = MINUTES-  pred TIME = SECONDS-  pred MONDAY = TIME-  pred TUESDAY = MONDAY-  pred WEDNESDAY = TUESDAY-  pred THURSDAY = WEDNESDAY-  pred FRIDAY = THURSDAY-  pred SATURDAY = FRIDAY-  pred SUNDAY = SATURDAY-  pred JANUARY = SUNDAY-  pred FEBRUARY = JANUARY-  pred MARCH = FEBRUARY-  pred APRIL = MARCH-  pred MAY = APRIL-  pred JUNE = MAY-  pred JULY = JUNE-  pred AUGUST = JULY-  pred SEPTEMBER = AUGUST-  pred OCTOBER = SEPTEMBER-  pred NOVEMBER = OCTOBER-  pred DECEMBER = NOVEMBER-  pred LITERAL = DECEMBER-  pred _ = Prelude'.error "hprotoc generated code: pred failure for type Database.RethinkDB.Protobuf.Ql2.Term.TermType"- -instance P'.Wire TermType where-  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)-  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)-  wireGet 14 = P'.wireGetEnum toMaybe'Enum-  wireGet ft' = P'.wireGetErr ft'-  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum-  wireGetPacked ft' = P'.wireGetErr ft'- -instance P'.GPB TermType- -instance P'.MessageAPI msg' (msg' -> TermType) TermType where-  getVal m' f' = f' m'- -instance P'.ReflectEnum TermType where-  reflectEnum-   = [(1, "DATUM", DATUM), (2, "MAKE_ARRAY", MAKE_ARRAY), (3, "MAKE_OBJ", MAKE_OBJ), (10, "VAR", VAR),-      (11, "JAVASCRIPT", JAVASCRIPT), (12, "ERROR", ERROR), (13, "IMPLICIT_VAR", IMPLICIT_VAR), (14, "DB", DB),-      (15, "TABLE", TABLE), (16, "GET", GET), (78, "GET_ALL", GET_ALL), (17, "EQ", EQ), (18, "NE", NE), (19, "LT", LT),-      (20, "LE", LE), (21, "GT", GT), (22, "GE", GE), (23, "NOT", NOT), (24, "ADD", ADD), (25, "SUB", SUB), (26, "MUL", MUL),-      (27, "DIV", DIV), (28, "MOD", MOD), (29, "APPEND", APPEND), (80, "PREPEND", PREPEND), (95, "DIFFERENCE", DIFFERENCE),-      (88, "SET_INSERT", SET_INSERT), (89, "SET_INTERSECTION", SET_INTERSECTION), (90, "SET_UNION", SET_UNION),-      (91, "SET_DIFFERENCE", SET_DIFFERENCE), (30, "SLICE", SLICE), (70, "SKIP", SKIP), (71, "LIMIT", LIMIT),-      (87, "INDEXES_OF", INDEXES_OF), (93, "CONTAINS", CONTAINS), (31, "GET_FIELD", GET_FIELD), (94, "KEYS", KEYS),-      (32, "HAS_FIELDS", HAS_FIELDS), (96, "WITH_FIELDS", WITH_FIELDS), (33, "PLUCK", PLUCK), (34, "WITHOUT", WITHOUT),-      (35, "MERGE", MERGE), (36, "BETWEEN", BETWEEN), (37, "REDUCE", REDUCE), (38, "MAP", MAP), (39, "FILTER", FILTER),-      (40, "CONCATMAP", CONCATMAP), (41, "ORDERBY", ORDERBY), (42, "DISTINCT", DISTINCT), (43, "COUNT", COUNT),-      (86, "IS_EMPTY", IS_EMPTY), (44, "UNION", UNION), (45, "NTH", NTH), (46, "GROUPED_MAP_REDUCE", GROUPED_MAP_REDUCE),-      (47, "GROUPBY", GROUPBY), (48, "INNER_JOIN", INNER_JOIN), (49, "OUTER_JOIN", OUTER_JOIN), (50, "EQ_JOIN", EQ_JOIN),-      (72, "ZIP", ZIP), (82, "INSERT_AT", INSERT_AT), (83, "DELETE_AT", DELETE_AT), (84, "CHANGE_AT", CHANGE_AT),-      (85, "SPLICE_AT", SPLICE_AT), (51, "COERCE_TO", COERCE_TO), (52, "TYPEOF", TYPEOF), (53, "UPDATE", UPDATE),-      (54, "DELETE", DELETE), (55, "REPLACE", REPLACE), (56, "INSERT", INSERT), (57, "DB_CREATE", DB_CREATE),-      (58, "DB_DROP", DB_DROP), (59, "DB_LIST", DB_LIST), (60, "TABLE_CREATE", TABLE_CREATE), (61, "TABLE_DROP", TABLE_DROP),-      (62, "TABLE_LIST", TABLE_LIST), (75, "INDEX_CREATE", INDEX_CREATE), (76, "INDEX_DROP", INDEX_DROP),-      (77, "INDEX_LIST", INDEX_LIST), (64, "FUNCALL", FUNCALL), (65, "BRANCH", BRANCH), (66, "ANY", ANY), (67, "ALL", ALL),-      (68, "FOREACH", FOREACH), (69, "FUNC", FUNC), (73, "ASC", ASC), (74, "DESC", DESC), (79, "INFO", INFO), (97, "MATCH", MATCH),-      (81, "SAMPLE", SAMPLE), (92, "DEFAULT", DEFAULT), (98, "JSON", JSON), (99, "ISO8601", ISO8601),-      (100, "TO_ISO8601", TO_ISO8601), (101, "EPOCH_TIME", EPOCH_TIME), (102, "TO_EPOCH_TIME", TO_EPOCH_TIME), (103, "NOW", NOW),-      (104, "IN_TIMEZONE", IN_TIMEZONE), (105, "DURING", DURING), (106, "DATE", DATE), (126, "TIME_OF_DAY", TIME_OF_DAY),-      (127, "TIMEZONE", TIMEZONE), (128, "YEAR", YEAR), (129, "MONTH", MONTH), (130, "DAY", DAY), (131, "DAY_OF_WEEK", DAY_OF_WEEK),-      (132, "DAY_OF_YEAR", DAY_OF_YEAR), (133, "HOURS", HOURS), (134, "MINUTES", MINUTES), (135, "SECONDS", SECONDS),-      (136, "TIME", TIME), (107, "MONDAY", MONDAY), (108, "TUESDAY", TUESDAY), (109, "WEDNESDAY", WEDNESDAY),-      (110, "THURSDAY", THURSDAY), (111, "FRIDAY", FRIDAY), (112, "SATURDAY", SATURDAY), (113, "SUNDAY", SUNDAY),-      (114, "JANUARY", JANUARY), (115, "FEBRUARY", FEBRUARY), (116, "MARCH", MARCH), (117, "APRIL", APRIL), (118, "MAY", MAY),-      (119, "JUNE", JUNE), (120, "JULY", JULY), (121, "AUGUST", AUGUST), (122, "SEPTEMBER", SEPTEMBER), (123, "OCTOBER", OCTOBER),-      (124, "NOVEMBER", NOVEMBER), (125, "DECEMBER", DECEMBER), (137, "LITERAL", LITERAL)]-  reflectEnumInfo _-   = P'.EnumInfo (P'.makePNF (P'.pack ".Ql2.Term.TermType") ["Database", "RethinkDB", "Protobuf"] ["Ql2", "Term"] "TermType")-      ["Database", "RethinkDB", "Protobuf", "Ql2", "Term", "TermType.hs"]-      [(1, "DATUM"), (2, "MAKE_ARRAY"), (3, "MAKE_OBJ"), (10, "VAR"), (11, "JAVASCRIPT"), (12, "ERROR"), (13, "IMPLICIT_VAR"),-       (14, "DB"), (15, "TABLE"), (16, "GET"), (78, "GET_ALL"), (17, "EQ"), (18, "NE"), (19, "LT"), (20, "LE"), (21, "GT"),-       (22, "GE"), (23, "NOT"), (24, "ADD"), (25, "SUB"), (26, "MUL"), (27, "DIV"), (28, "MOD"), (29, "APPEND"), (80, "PREPEND"),-       (95, "DIFFERENCE"), (88, "SET_INSERT"), (89, "SET_INTERSECTION"), (90, "SET_UNION"), (91, "SET_DIFFERENCE"), (30, "SLICE"),-       (70, "SKIP"), (71, "LIMIT"), (87, "INDEXES_OF"), (93, "CONTAINS"), (31, "GET_FIELD"), (94, "KEYS"), (32, "HAS_FIELDS"),-       (96, "WITH_FIELDS"), (33, "PLUCK"), (34, "WITHOUT"), (35, "MERGE"), (36, "BETWEEN"), (37, "REDUCE"), (38, "MAP"),-       (39, "FILTER"), (40, "CONCATMAP"), (41, "ORDERBY"), (42, "DISTINCT"), (43, "COUNT"), (86, "IS_EMPTY"), (44, "UNION"),-       (45, "NTH"), (46, "GROUPED_MAP_REDUCE"), (47, "GROUPBY"), (48, "INNER_JOIN"), (49, "OUTER_JOIN"), (50, "EQ_JOIN"),-       (72, "ZIP"), (82, "INSERT_AT"), (83, "DELETE_AT"), (84, "CHANGE_AT"), (85, "SPLICE_AT"), (51, "COERCE_TO"), (52, "TYPEOF"),-       (53, "UPDATE"), (54, "DELETE"), (55, "REPLACE"), (56, "INSERT"), (57, "DB_CREATE"), (58, "DB_DROP"), (59, "DB_LIST"),-       (60, "TABLE_CREATE"), (61, "TABLE_DROP"), (62, "TABLE_LIST"), (75, "INDEX_CREATE"), (76, "INDEX_DROP"), (77, "INDEX_LIST"),-       (64, "FUNCALL"), (65, "BRANCH"), (66, "ANY"), (67, "ALL"), (68, "FOREACH"), (69, "FUNC"), (73, "ASC"), (74, "DESC"),-       (79, "INFO"), (97, "MATCH"), (81, "SAMPLE"), (92, "DEFAULT"), (98, "JSON"), (99, "ISO8601"), (100, "TO_ISO8601"),-       (101, "EPOCH_TIME"), (102, "TO_EPOCH_TIME"), (103, "NOW"), (104, "IN_TIMEZONE"), (105, "DURING"), (106, "DATE"),-       (126, "TIME_OF_DAY"), (127, "TIMEZONE"), (128, "YEAR"), (129, "MONTH"), (130, "DAY"), (131, "DAY_OF_WEEK"),-       (132, "DAY_OF_YEAR"), (133, "HOURS"), (134, "MINUTES"), (135, "SECONDS"), (136, "TIME"), (107, "MONDAY"), (108, "TUESDAY"),-       (109, "WEDNESDAY"), (110, "THURSDAY"), (111, "FRIDAY"), (112, "SATURDAY"), (113, "SUNDAY"), (114, "JANUARY"),-       (115, "FEBRUARY"), (116, "MARCH"), (117, "APRIL"), (118, "MAY"), (119, "JUNE"), (120, "JULY"), (121, "AUGUST"),-       (122, "SEPTEMBER"), (123, "OCTOBER"), (124, "NOVEMBER"), (125, "DECEMBER"), (137, "LITERAL")]
− Database/RethinkDB/Protobuf/Ql2/VersionDummy.hs 
@@ -1,56 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.VersionDummy (VersionDummy(..)) where-import Prelude ((+), (/))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data VersionDummy = VersionDummy{}-                  deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable VersionDummy where-  mergeAppend VersionDummy VersionDummy = VersionDummy- -instance P'.Default VersionDummy where-  defaultValue = VersionDummy- -instance P'.Wire VersionDummy where-  wireSize ft' self'@(VersionDummy)-   = case ft' of-       10 -> calc'Size-       11 -> P'.prependMessageSize calc'Size-       _ -> P'.wireSizeErr ft' self'-    where-        calc'Size = 0-  wirePut ft' self'@(VersionDummy)-   = case ft' of-       10 -> put'Fields-       11 -> do-               P'.putSize (P'.wireSize 10 self')-               put'Fields-       _ -> P'.wirePutErr ft' self'-    where-        put'Fields-         = do-             Prelude'.return ()-  wireGet ft'-   = case ft' of-       10 -> P'.getBareMessageWith update'Self-       11 -> P'.getMessageWith update'Self-       _ -> P'.wireGetErr ft'-    where-        update'Self wire'Tag old'Self-         = case wire'Tag of-             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self- -instance P'.MessageAPI msg' (msg' -> VersionDummy) VersionDummy where-  getVal m' f' = f' m'- -instance P'.GPB VersionDummy- -instance P'.ReflectDescriptor VersionDummy where-  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [])-  reflectDescriptorInfo _-   = Prelude'.read-      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Ql2.VersionDummy\", haskellPrefix = [MName \"Database\",MName \"RethinkDB\",MName \"Protobuf\"], parentModule = [MName \"Ql2\"], baseName = MName \"VersionDummy\"}, descFilePath = [\"Database\",\"RethinkDB\",\"Protobuf\",\"Ql2\",\"VersionDummy.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
− Database/RethinkDB/Protobuf/Ql2/VersionDummy/Version.hs 
@@ -1,58 +0,0 @@-{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}-module Database.RethinkDB.Protobuf.Ql2.VersionDummy.Version (Version(..)) where-import Prelude ((+), (/), (.))-import qualified Prelude as Prelude'-import qualified Data.Typeable as Prelude'-import qualified Data.Data as Prelude'-import qualified Text.ProtocolBuffers.Header as P'- -data Version = V0_1-             | V0_2-             deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)- -instance P'.Mergeable Version- -instance Prelude'.Bounded Version where-  minBound = V0_1-  maxBound = V0_2- -instance P'.Default Version where-  defaultValue = V0_1- -toMaybe'Enum :: Prelude'.Int -> P'.Maybe Version-toMaybe'Enum 1063369270 = Prelude'.Just V0_1-toMaybe'Enum 1915781601 = Prelude'.Just V0_2-toMaybe'Enum _ = Prelude'.Nothing- -instance Prelude'.Enum Version where-  fromEnum V0_1 = 1063369270-  fromEnum V0_2 = 1915781601-  toEnum-   = P'.fromMaybe-      (Prelude'.error "hprotoc generated code: toEnum failure for type Database.RethinkDB.Protobuf.Ql2.VersionDummy.Version")-      . toMaybe'Enum-  succ V0_1 = V0_2-  succ _ = Prelude'.error "hprotoc generated code: succ failure for type Database.RethinkDB.Protobuf.Ql2.VersionDummy.Version"-  pred V0_2 = V0_1-  pred _ = Prelude'.error "hprotoc generated code: pred failure for type Database.RethinkDB.Protobuf.Ql2.VersionDummy.Version"- -instance P'.Wire Version where-  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)-  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)-  wireGet 14 = P'.wireGetEnum toMaybe'Enum-  wireGet ft' = P'.wireGetErr ft'-  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum-  wireGetPacked ft' = P'.wireGetErr ft'- -instance P'.GPB Version- -instance P'.MessageAPI msg' (msg' -> Version) Version where-  getVal m' f' = f' m'- -instance P'.ReflectEnum Version where-  reflectEnum = [(1063369270, "V0_1", V0_1), (1915781601, "V0_2", V0_2)]-  reflectEnumInfo _-   = P'.EnumInfo-      (P'.makePNF (P'.pack ".Ql2.VersionDummy.Version") ["Database", "RethinkDB", "Protobuf"] ["Ql2", "VersionDummy"] "Version")-      ["Database", "RethinkDB", "Protobuf", "Ql2", "VersionDummy", "Version.hs"]-      [(1063369270, "V0_1"), (1915781601, "V0_2")]
Database/RethinkDB/ReQL.hs view
@@ -1,134 +1,131 @@-{-# LANGUAGE ExistentialQuantification, RecordWildCards, ScopedTypeVariables,-             FlexibleInstances, OverloadedStrings, PatternGuards, GADTs #-}+{-# LANGUAGE ExistentialQuantification, RecordWildCards,+             ScopedTypeVariables, FlexibleInstances,+             OverloadedStrings, PatternGuards, GADTs, +             EmptyDataDecls, DefaultSignatures #-}  -- | Building RQL queries in Haskell module Database.RethinkDB.ReQL (   ReQL(..),-  op,-  BaseReQL(..),-  BaseAttribute(..),+  op, op',+  Term(..),+  TermAttribute(..),   buildQuery,-  BaseArray,-  Backtrace, convertBacktrace,+  Backtrace, convertBacktrace, Frame(..),   Expr(..),   QuerySettings(..),   newVarId,   str,   num,   Attribute(..),+  Static, Dynamic, OptArg,+  OptArgs(..),   cons,   arr,   baseArray,   withQuerySettings,-  Object(..),-  Obj(..),-  returnVals,-  nonAtomic,-  canReturnVals,-  canNonAtomic,-  reqlToProtobuf,+  reqlToDatum,   Bound(..),-  closedOrOpen+  closedOrOpen,+  datumTerm,+  empty,+  WireQuery(..),+  WireBacktrace(..),+  note,+  (?:=)   ) where +import qualified Data.Aeson as J+import qualified Data.Aeson.Encode as J+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Builder as LT+import Data.Aeson (Value) import qualified Data.Vector as V import qualified Data.HashMap.Lazy as M import Data.Maybe (fromMaybe, catMaybes) import Data.String (IsString(..))-import Data.List (intersperse)-import qualified Data.Sequence as S+import Data.List (intercalate) import Control.Monad.State (State, get, put, runState) import Control.Applicative ((<$>)) import Data.Default (Default, def) import qualified Data.Text as T-import qualified Data.Aeson as J+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB import Data.Foldable (toList) import Data.Time-import Data.Time.Clock.POSIX import Control.Monad.Fix+import Data.Int+import Data.Monoid+import Data.Char+import Data.Ratio+import Data.Word+import qualified Data.HashMap.Strict as HM+import qualified Data.Map as Map+import qualified Data.Set as Set -import Text.ProtocolBuffers hiding (Key, cons, Default)-import Text.ProtocolBuffers.Basic hiding (Default)+import {-# SOURCE #-} Database.RethinkDB.Functions as R+import Database.RethinkDB.Wire+import Database.RethinkDB.Wire.Query+import qualified Database.RethinkDB.Wire.Term as Term+import Database.RethinkDB.Wire.Term hiding (JSON)+import Database.RethinkDB.Types+import Database.RethinkDB.Datum -import Database.RethinkDB.Protobuf.Ql2.Term-import qualified Database.RethinkDB.Protobuf.Ql2.Term as Term-import Database.RethinkDB.Protobuf.Ql2.Term.TermType as TermType-import Database.RethinkDB.Protobuf.Ql2.Term.AssocPair-import qualified Database.RethinkDB.Protobuf.Ql2.Query as Query-import Database.RethinkDB.Protobuf.Ql2.Query.QueryType-import qualified Database.RethinkDB.Protobuf.Ql2.Datum as Datum-import qualified Database.RethinkDB.Protobuf.Ql2.Datum.AssocPair as Datum-import Database.RethinkDB.Protobuf.Ql2.Datum-import qualified Database.RethinkDB.Protobuf.Ql2.Backtrace as QL-import qualified Database.RethinkDB.Protobuf.Ql2.Frame as QL-import Database.RethinkDB.Protobuf.Ql2.Datum.DatumType-import Database.RethinkDB.Protobuf.Ql2.Frame.FrameType as QL+-- $setup+--+-- Get the doctests ready+--+-- >>> import qualified Database.RethinkDB as R+-- >>> import Database.RethinkDB.NoClash+-- >>> h' <- connect "localhost" 28015 def+-- >>> let h = use "doctests" h' -import Database.RethinkDB.Objects as O+-- | A ReQL Term+data ReQL = ReQL { runReQL :: State QuerySettings Term } --- | An RQL term-data ReQL = ReQL { baseReQL :: State QuerySettings BaseReQL }+-- | Internal representation of a ReQL Term+data Term = Term {+  termType :: TermType,+  termArgs :: [Term],+  termOptArgs :: [TermAttribute]+  } | Datum {+  termDatum :: Datum+  } | Note {+  termNote :: String,+  termTerm :: Term+  } deriving Eq -data BaseReQL = BaseReQL {-    termType :: TermType,-    termDatum :: Maybe Datum.Datum,-    termArgs :: BaseArray,-    termOptArgs :: [BaseAttribute] }+-- | A term ready to be sent over the network+newtype WireTerm = WireTerm { termJSON :: Datum } +-- | State used to build a Term data QuerySettings = QuerySettings {   queryToken :: Int64,   queryDefaultDatabase :: Database,   queryVarIndex :: Int,-  queryUseOutdated :: Maybe Bool,-  queryReturnVals :: Maybe Bool,-  queryAtomic :: Maybe Bool+  queryUseOutdated :: Maybe Bool   }  instance Default QuerySettings where-  def = QuerySettings 0 (Database "") 0 Nothing Nothing Nothing+  def = QuerySettings 0 (Database "") 0 Nothing  withQuerySettings :: (QuerySettings -> ReQL) -> ReQL-withQuerySettings f = ReQL $ (baseReQL . f) =<< get---- | Include the value of single write operations in the returned object-returnVals :: ReQL -> ReQL-returnVals (ReQL t) = ReQL $ do-  state <- get-  put state{ queryReturnVals = Just True }-  ret <- t-  state' <- get-  put state'{ queryReturnVals = queryReturnVals state }-  return ret---- | Allow non-atomic replace-nonAtomic :: ReQL -> ReQL-nonAtomic (ReQL t) = ReQL $ do-  state <- get-  put state{ queryAtomic = Just False }-  ret <- t-  state' <- get-  put state'{ queryAtomic = queryAtomic state }-  return ret--canReturnVals :: ReQL -> ReQL-canReturnVals (ReQL t) = ReQL $ t >>= \ret -> do-  qs <- get-  case queryReturnVals qs of-    Nothing -> return ret-    Just rv -> return ret{-      termOptArgs = BaseAttribute "return_vals" (baseBool rv) : termOptArgs ret }+withQuerySettings f = ReQL $ (runReQL . f) =<< get -canNonAtomic :: ReQL -> ReQL-canNonAtomic (ReQL t) = ReQL $ t >>= \ret -> do-  qs <- get-  case queryAtomic qs of-    Nothing -> return ret-    Just atomic -> return ret{-      termOptArgs = BaseAttribute "non_atomic" (baseBool $ not atomic) : termOptArgs ret }+-- | An operation that accepts optional arguments+class OptArgs a where+  -- | Extend an operation with optional arguments+  ex :: a -> [Attribute Static] -> a -baseBool :: Bool -> BaseReQL-baseBool b = BaseReQL DATUM (Just defaultValue{-                                Datum.type' = Just R_BOOL, r_bool = Just b }) [] []+instance OptArgs ReQL where+  ex (ReQL m) attrs = ReQL $ do+    e <- m+    case e of+      Datum _ -> return e+      Term t a oa -> Term t a . (oa ++) <$> baseAttributes attrs+      Note n t -> Note n <$> runReQL (ex (ReQL $ return t) attrs)+      +instance OptArgs b => OptArgs (a -> b) where+  ex f a = flip ex a . f  newVarId :: State QuerySettings Int newVarId = do@@ -137,64 +134,55 @@   put QuerySettings {queryVarIndex = n, ..}   return $ n -instance Show BaseReQL where-  show (BaseReQL DATUM (Just dat) _ _) = showD dat-  show (BaseReQL MAKE_ARRAY _ x []) = "[" ++ (concat $ intersperse ", " $ map show x) ++ "]"-  show (BaseReQL MAKE_OBJ _ [] x) = "{" ++ (concat $ intersperse ", " $ map show x) ++ "}"-  show (BaseReQL VAR _ [BaseReQL DATUM (Just d) [] []] []) | Just x <- toDouble d =-    "x" ++ show (round x :: Int)-  show (BaseReQL FUNC _ [BaseReQL DATUM (Just d) [] [], body] []) | Just vars <- toDoubles d =-    "(\\" ++ (concat $ intersperse " " $ map (("x"++) . show . (round :: Double -> Int)) $ vars)+instance Show Term where+  show (Datum dat) = show dat+  show (Note n term) = shortLines "" ["{- " ++ n ++ " -}", show term]+  show (Term MAKE_ARRAY x []) = "[" ++ (shortLines "," $ map show x) ++ "]"+  show (Term MAKE_OBJ [] x) = "{" ++ (shortLines "," $ map show x) ++ "}"+  show (Term MAKE_OBJ args []) = "{" ++ (shortLines "," $ map (\(a,b) -> show a ++ ":" ++ show b) $ pairs args) ++ "}"+     where pairs (a:b:xs) = (a,b) : pairs xs+           pairs _ = []+  show (Term VAR [Datum d] []) | Just x <- toInt d = varName x+  show (Term FUNC [args, body] []) | Just vars <- argList args =+    "(\\" ++ (shortLines " " $ map varName vars)     ++ " -> " ++ show body ++ ")"-  show (BaseReQL GET_FIELD _ [o, k] []) = show o ++ "!" ++ show k-  show (BaseReQL fun _ args optargs) =-    show fun ++ "(" ++-    concat (intersperse ", " (map show args ++ map show optargs)) ++ ")"--showD :: Datum.Datum -> String-showD d = case Datum.type' d of-  Just R_NUM -> show' $ r_num d-  Just R_BOOL -> show' $ r_bool d-  Just R_STR -> show' $ r_str d-  Just R_ARRAY -> "[" ++ (concat $ intersperse ", " $ map showD $ toList $ r_array d) ++ "]"-  Just R_OBJECT ->-    "{" ++ (concat $ intersperse ", " $ map showDatumAttr $ toList $ r_object d) ++ "}"-  Just R_NULL -> "null"-  Nothing -> "Nothing"-  where show' Nothing = "Nothing"-        show' (Just a) = show a--showDatumAttr:: Datum.AssocPair -> String-showDatumAttr (Datum.AssocPair (Just k) (Just v)) = uToString k ++ ": " ++ showD v-showDatumAttr x = show x+  show (Term BRACKET [o, k] []) = show o ++ "[" ++ show k ++ "]"+  show (Term FUNCALL (f : as) []) = "(" ++ show f ++ ")(" ++ shortLines "," (map show as) ++ ")"+  show (Term fun args oargs) =+    map toLower (show fun) ++ "(" +++    shortLines "," (map show args ++ map show oargs) ++ ")" --- | Convert other types into ReqL expressions-class Expr e where-  expr :: e -> ReQL+shortLines :: String -> [String] -> String+shortLines sep args =+  if tooLong+  then "\n" ++ intercalate (sep ++ "\n") (map indent args)+  else intercalate (sep ++ " ") args+  where+    tooLong = any ('\n' `elem`) args || 80 < (length $ concat args)+    indent = (\x -> case x of [] -> []; _ -> init x) . unlines . map ("  "++) . lines  -instance Expr ReQL where-  expr t = t+varName :: Int -> String+varName n = replicate (q+1) (chr $ ord 'a' + r)+  where (q, r) = quotRem n 26  -- | A list of terms-data Array = Array { baseArray :: State QuerySettings BaseArray }--type BaseArray = [BaseReQL]+data ArgList = ArgList { baseArray :: State QuerySettings [Term] }  -- | Build arrays of exprs class Arr a where-  arr :: a -> Array+  arr :: a -> ArgList -cons :: Expr e => e -> Array -> Array-cons x xs = Array $ do-  bt <- baseReQL (expr x)+cons :: Expr e => e -> ArgList -> ArgList+cons x xs = ArgList $ do+  bt <- runReQL (expr x)   xs' <- baseArray xs   return $ bt : xs'  instance Arr () where-  arr () = Array $ return []+  arr () = ArgList $ return []  instance Expr a => Arr [a] where-  arr [] = Array $ return []+  arr [] = ArgList $ return []   arr (x:xs) = cons x (arr xs)  instance (Expr a, Expr b) => Arr (a, b) where@@ -206,268 +194,336 @@ instance (Expr a, Expr b, Expr c, Expr d) => Arr (a, b, c, d) where   arr (a,b,c,d) = cons a $ cons b $ cons c $ cons d $ arr () -instance Arr Array where+instance Arr ArgList where   arr = id --- | A list of key/value pairs-data Object = Object { baseObject :: State QuerySettings [BaseAttribute] }- infix 0 :=  -- | A key/value pair used for building objects-data Attribute = forall e . (Expr e) => T.Text := e+data Attribute a where +  (:=) :: Expr e => T.Text -> e -> Attribute a+  (::=) :: (Expr k, Expr v) => k -> v -> Attribute Dynamic+  NoAttribute :: Attribute a -data BaseAttribute = BaseAttribute T.Text BaseReQL+(?:=) :: Expr e => T.Text -> Maybe e -> Attribute a+_ ?:= Nothing = NoAttribute+k ?:= (Just v) = k := v -mapBaseAttribute :: (BaseReQL -> BaseReQL) -> BaseAttribute -> BaseAttribute-mapBaseAttribute f (BaseAttribute k v) = BaseAttribute k (f v)+type OptArg = Attribute Static -instance Show BaseAttribute where-  show (BaseAttribute a b) = T.unpack a ++ ": " ++ show b+data Static+data Dynamic --- | Convert into a ReQL object-class Obj o where-  obj :: o -> Object+instance Expr (Attribute a) where+  expr (k := v) = expr (k, v)+  expr (k ::= v) = expr (k, v)+  expr NoAttribute = expr Null+  exprList kvs = maybe (obj kvs) (op' MAKE_OBJ () . concat) $ mapM staticPair kvs+    where staticPair :: Attribute a -> Maybe [Attribute Static]+          staticPair (k := v) = Just [k := v]+          staticPair NoAttribute = Just []+          staticPair _ = Nothing+          obj :: [Attribute a] -> ReQL+          obj = op OBJECT . concatMap unpair+          unpair :: Attribute a -> [ReQL]+          unpair (k := v) = [expr k, expr v]+          unpair (k ::= v) = [expr k, expr v]+          unpair NoAttribute = [] -instance Obj [Attribute] where-  obj = Object . mapM base-    where base (k := e) = BaseAttribute k <$> baseReQL (expr e)+data TermAttribute = TermAttribute T.Text Term deriving Eq -instance Obj [BaseAttribute] where-  obj = Object . return+mapTermAttribute :: (Term -> Term) -> TermAttribute -> TermAttribute+mapTermAttribute f (TermAttribute k v) = TermAttribute k (f v) -instance Obj Object where-  obj = id+instance Show TermAttribute where+  show (TermAttribute a b) = T.unpack a ++ ": " ++ show b -instance Obj () where-  obj _ = Object $ return []+baseAttributes :: [Attribute Static] -> State QuerySettings [TermAttribute]+baseAttributes = sequence . concat . map toBase+  where+    toBase :: Attribute Static -> [State QuerySettings TermAttribute]+    toBase (k := v) = [TermAttribute k <$> runReQL (expr v)]+    toBase NoAttribute = []  -- | Build a term-op :: (Arr a, Obj o) => TermType -> a -> o -> ReQL-op t a b = ReQL $ do+op' :: Arr a => TermType -> a -> [Attribute Static] -> ReQL+op' t a b = ReQL $ do   a' <- baseArray (arr a)-  b' <- baseObject (obj b)-  case (t, a') of-    (FUNCALL, (BaseReQL FUNC Nothing [argsFunDatum, fun] [] : argsCall)) |-      BaseReQL DATUM (Just argsFunArray) [] [] <- argsFunDatum,-      Just varsFun <- toDoubles argsFunArray,+  b' <- baseAttributes b+  case (t, a', b') of+    -- Inline function calls if all arguments are variables+    (FUNCALL, (Term FUNC [argsFunTerm, fun] [] : argsCall), []) |+      Just varsFun <- argList argsFunTerm,       length varsFun == length argsCall,       Just varsCall <- varsOf argsCall ->         return $ alphaRename (zip varsFun varsCall) fun-    _ -> return $ BaseReQL t Nothing a' b'+    _ -> return $ Term t a' b' -toDoubles :: Datum.Datum -> Maybe [Double]-toDoubles Datum.Datum{-  Datum.type' = Just R_ARRAY,-  r_array = s } =-  sequence . map toDouble . toList $ s-toDoubles _ = Nothing+-- | Build a term with no optargs+op :: Arr a => TermType -> a -> ReQL+op t a = op' t a [] -toDouble :: Datum.Datum -> Maybe Double-toDouble Datum.Datum{ type' = Just R_NUM, r_num = Just n } = Just n-toDouble _ = Nothing+argList :: Term -> Maybe [Int]+argList (Datum d) | Just a <- toInts d = Just a+argList (Term MAKE_ARRAY a []) = mapM toInt =<< datums a+  where datums (Datum d:xs) = fmap (d:) $ datums xs; datums [] = Just []; datums _ = Nothing+argList _ = Nothing -varsOf :: [BaseReQL] -> Maybe [Double]+toInts :: Datum -> Maybe [Int]+toInts (Array xs) = mapM toInt $ toList xs+toInts _ = Nothing++toInt :: Datum -> Maybe Int+toInt (Number n) = if denominator (toRational n) == 1 then Just (truncate n) else Nothing+toInt _ = Nothing++varsOf :: [Term] -> Maybe [Int] varsOf = sequence . map varOf     -varOf :: BaseReQL -> Maybe Double-varOf (BaseReQL VAR Nothing [BaseReQL DATUM (Just d) [] []] []) = toDouble d+varOf :: Term -> Maybe Int+varOf (Term VAR [Datum d] []) = toInt d varOf _ = Nothing -datumNumberArray :: [Int] -> Datum.Datum-datumNumberArray a =-  defaultValue{-    Datum.type' = Just R_ARRAY,-    r_array = S.fromList $ map datumInt a }--datumInt :: Int -> Datum.Datum-datumInt n =-  defaultValue{-    Datum.type' = Just R_NUM,-    r_num = Just $ fromIntegral n }--alphaRename :: [(Double, Double)] -> BaseReQL -> BaseReQL+alphaRename :: [(Int, Int)] -> Term -> Term alphaRename assoc = fix $ \f x ->   case varOf x of     Just n       | Just n' <- lookup n assoc ->-      BaseReQL VAR Nothing-      [BaseReQL DATUM-       (Just $ defaultValue{ Datum.type' = Just R_NUM, r_num = Just n' }) [] []] []+      Term VAR [Datum $ toDatum n'] []       | otherwise -> x     _ -> updateChildren x f -updateChildren :: BaseReQL -> (BaseReQL -> BaseReQL) -> BaseReQL-updateChildren (BaseReQL t d a o) f = BaseReQL t d (map f a) (map (mapBaseAttribute f) o)+updateChildren :: Term -> (Term -> Term) -> Term+updateChildren (Note _ t) f = updateChildren t f+updateChildren d@Datum{} _ = d+updateChildren (Term t a o) f = Term t (map f a) (map (mapTermAttribute f) o) -datumTerm :: DatumType -> Datum.Datum -> ReQL-datumTerm t d = ReQL $ return $ BaseReQL DATUM (Just d { Datum.type' = Just t }) [] []+datumTerm :: ToDatum a => a -> ReQL+datumTerm = ReQL . return . Datum . toDatum  -- | A shortcut for inserting strings into ReQL expressions -- Useful when OverloadedStrings makes the type ambiguous str :: String -> ReQL-str s = datumTerm R_STR defaultValue { r_str = Just (uFromString s) }+str = datumTerm  -- | A shortcut for inserting numbers into ReQL expressions num :: Double -> ReQL num = expr -instance Expr Int64 where-  expr i = datumTerm R_NUM defaultValue { r_num = Just (fromIntegral i) }+instance Num ReQL where+  fromInteger = datumTerm+  a + b = op ADD (a, b)+  a * b = op MUL (a, b)+  a - b = op SUB (a, b)+  negate a = op SUB (0 :: Double, a)+  abs n = op BRANCH (op Term.LT (n, 0 :: Double), negate n, n)+  signum n = op BRANCH (op Term.LT (n, 0 :: Double),+                        -1 :: Double,+                        op BRANCH (op Term.EQ (n, 0 :: Double), 0 :: Double, 1 :: Double)) -instance Expr Int where-  expr i = datumTerm R_NUM defaultValue { r_num = Just (fromIntegral i) }+instance IsString ReQL where+  fromString = datumTerm -instance Expr Integer where-  expr i = datumTerm R_NUM defaultValue { r_num = Just (fromIntegral i) }+-- | Convert other types into ReQL expressions+class Expr e where+  expr :: e -> ReQL+  default expr :: ToDatum e => e -> ReQL+  expr = datumTerm+  exprList :: [e] -> ReQL+  exprList = expr . arr -instance Num ReQL where-  fromInteger x = datumTerm R_NUM defaultValue { r_num = Just (fromInteger x) }-  a + b = op ADD (a, b) ()-  a * b = op MUL (a, b) ()-  a - b = op SUB (a, b) ()-  negate a = op SUB (0 :: Double, a) ()-  abs n = op BRANCH (op TermType.LT (n, 0 :: Double) (), negate n, n) ()-  signum n = op BRANCH (op TermType.LT (n, 0 :: Double) (),-                        -1 :: Double,-                        op BRANCH (op TermType.EQ (n, 0 :: Double) (), 0 :: Double, 1 :: Double) ()) ()+instance Expr ReQL where+  expr t = t -instance Expr T.Text where-  expr t = datumTerm R_STR defaultValue { r_str = Just (uFromString $ T.unpack t) }+instance Expr Char where+  exprList = datumTerm -instance Expr Bool where-  expr b = datumTerm R_BOOL defaultValue { r_bool = Just b }+instance (Expr a, Expr b) => Expr (Either a b) where+  expr (Left a) = expr ["Left" := a]+  expr (Right b) = expr ["Right" := b] -instance Expr () where-  expr _ = datumTerm R_NULL defaultValue+instance Expr a => Expr (HM.HashMap [Char] a) where+  expr = expr . map (\(k,v) -> T.pack k := v) . HM.toList -instance IsString ReQL where-  fromString s = datumTerm R_STR defaultValue { r_str = Just (uFromString $ s) }+instance Expr a => Expr (HM.HashMap T.Text a) where+  expr = expr . map (uncurry (:=)) . HM.toList +instance Expr a => Expr (Map.Map [Char] a) where+  expr = expr . map (\(k,v) -> T.pack k := v) . Map.toList++instance Expr a => Expr (Map.Map T.Text a) where+  expr = expr . map (uncurry (:=)) . Map.toList++instance Expr a => Expr (Maybe a) where+  expr Nothing = expr Null+  expr (Just a) = expr a++instance Expr a => Expr (Set.Set a) where+  expr = expr . Set.toList++instance Expr a => Expr (V.Vector a) where+  expr = expr . V.toList++instance Expr Value where+  expr v = op Term.JSON [encodeTextJSON v]++instance Expr Int+instance Expr Integer+instance Expr Bool+instance Expr Datum+instance Expr Double+instance Expr ()+instance Expr Float+instance Expr Int8+instance Expr Int16+instance Expr Int32+instance Expr Int64+instance Expr LT.Text+instance Expr T.Text+instance Expr LB.ByteString+instance Expr SB.ByteString+instance Expr Word+instance Expr Word8+instance Expr Word16+instance Expr Word32+instance Expr Word64+instance Expr (Ratio Integer)+ instance (a ~ ReQL) => Expr (a -> ReQL) where   expr f = ReQL $ do     v <- newVarId-    baseReQL $ op FUNC (datumNumberArray [v], expr $ f (op VAR [v] ())) ()+    runReQL $ op FUNC ([v], expr $ f (op VAR [v]))  instance (a ~ ReQL, b ~ ReQL) => Expr (a -> b -> ReQL) where   expr f = ReQL $ do     a <- newVarId     b <- newVarId-    baseReQL $ op FUNC (datumNumberArray [a, b], expr $ f (op VAR [a] ()) (op VAR [b] ())) ()--instance Expr Datum.Datum where-  expr d = ReQL $ return $ BaseReQL DATUM (Just d) [] []+    runReQL $ op FUNC ([a, b], expr $ f (op VAR [a]) (op VAR [b]))  instance Expr Table where   expr (Table mdb name _) = withQuerySettings $ \QuerySettings {..} ->-    op TABLE (fromMaybe queryDefaultDatabase mdb, name) $ catMaybes [+    op' TABLE (fromMaybe queryDefaultDatabase mdb, name) $ catMaybes [       fmap ("use_outdated" :=) queryUseOutdated ]  instance Expr Database where-  expr (Database name) = op DB [name] ()--instance Expr J.Value where-  expr J.Null = expr ()-  expr (J.Bool b) = expr b-  expr (J.Number n) = expr (fromRational (toRational n) :: Double)-  expr (J.String t) = expr t-  expr (J.Array a) = expr a-  expr (J.Object o) = expr o--instance Expr Double where-  expr d = datumTerm R_NUM defaultValue { r_num = Just d }--instance Expr Rational where-  expr x = expr (fromRational x :: Double)--instance Expr x => Expr (V.Vector x) where-  expr v = expr (V.toList v)+  expr (Database name) = op DB [name]  instance Expr a => Expr [a] where-  expr a = expr $ arr a+  expr = exprList -instance Expr Array where-  expr a = op MAKE_ARRAY a ()+instance Expr ArgList where+  expr a = op MAKE_ARRAY a -instance Expr e => Expr (M.HashMap T.Text e) where-  expr m = expr $ obj $ map (uncurry (:=)) $ M.toList m+instance (Expr k, Expr v) => Expr (M.HashMap k v) where+  expr m = expr $ map (uncurry (::=)) $ M.toList m -instance Expr Object where-  expr o = op MAKE_OBJ () o -buildBaseReQL :: BaseReQL -> Term-buildBaseReQL BaseReQL {..} = defaultValue {-    Term.type' = Just termType,-    datum = termDatum,-    args = buildBaseArray termArgs,-    optargs = buildTermAssoc termOptArgs }+buildTerm :: Term -> WireTerm+buildTerm (Note _ t) = buildTerm t+buildTerm (Datum d)+  | complexDatum d = buildTerm $ Term Term.JSON [Datum $ toDatum $ encodeTextJSON $ J.toJSON d] []+  | otherwise = WireTerm $ d+buildTerm (Term type_ args oargs) =+  WireTerm $ toDatum (+    toWire type_,+    map (termJSON . buildTerm) args,+    buildAttributes oargs) -buildBaseArray :: BaseArray -> Seq Term-buildBaseArray [] = S.empty-buildBaseArray (x:xs) = buildBaseReQL x S.<| buildBaseArray xs+complexDatum :: Datum -> Bool+complexDatum Null = False+complexDatum Bool{} = False+complexDatum Number{} = False+complexDatum String{} = False+complexDatum _ = True -buildTermAssoc :: [BaseAttribute] -> Seq AssocPair-buildTermAssoc = S.fromList . map buildTermAttribute+encodeTextJSON :: Value -> T.Text+encodeTextJSON = LT.toStrict . LT.toLazyText . J.encodeToTextBuilder -buildTermAttribute :: BaseAttribute -> AssocPair-buildTermAttribute (BaseAttribute k v) = AssocPair (Just $ uFromString $ T.unpack k) (Just $ buildBaseReQL v)+buildAttributes :: [TermAttribute] -> Datum+buildAttributes ts = toDatum $ M.fromList $ map toPair ts+ where toPair (TermAttribute a b) = (a, termJSON $ buildTerm b) -buildQuery :: ReQL -> Int64 -> Database -> (Query.Query, BaseReQL)-buildQuery term token db = (defaultValue {-                              Query.type' = Just START,-                              Query.query = Just pterm },-                            bterm)-  where bterm =-         fst $ runState (baseReQL term) (def {queryToken = token,-                                              queryDefaultDatabase = db })-        pterm = buildBaseReQL bterm+newtype WireQuery = WireQuery { queryJSON :: Datum } -- TODO: rename+                  deriving Show +buildQuery :: ReQL -> Int64 -> Database -> [(T.Text, Datum)] -> (WireQuery, Term)+buildQuery reql token db opts =+  (WireQuery $ toDatum (toWire START, termJSON pterm, object opts), bterm)+  where+    bterm = fst $ runState (runReQL reql) (def {queryToken = token,+                                                queryDefaultDatabase = db })+    pterm = buildTerm bterm+ instance Show ReQL where-  show t = show . snd $ buildQuery t 0 (Database "")+  show t = show . snd $ buildQuery t 0 (Database "") [] -reqlToProtobuf :: ReQL -> Query.Query-reqlToProtobuf t = fst $ buildQuery t 0 (Database "")+reqlToDatum :: ReQL -> Datum+reqlToDatum t = queryJSON $ fst $ buildQuery t 0 (Database "") []  type Backtrace = [Frame] -data Frame = FramePos Int64 | FrameOpt T.Text+data Frame = FramePos Int | FrameOpt T.Text  instance Show Frame where     show (FramePos n) = show n     show (FrameOpt k) = show k -convertBacktrace :: QL.Backtrace -> Backtrace-convertBacktrace = concatMap convertFrame . toList . QL.frames-    where convertFrame QL.Frame { type' = Just QL.POS, pos = Just n } = [FramePos n]-          convertFrame QL.Frame { type' = Just QL.OPT, opt = Just k } = [FrameOpt (T.pack $ uToString k)]-          convertFrame _ = []+instance FromDatum Frame where+  parseDatum d@Number{} | Success i <- fromDatum d = return $ FramePos i+  parseDatum (String s) = return $ FrameOpt s+  parseDatum _ = mempty -instance Expr UTCTime where-  expr t = op EPOCH_TIME [expr . toRational $ utcTimeToPOSIXSeconds t] ()+newtype WireBacktrace = WireBacktrace { backtraceJSON :: Datum } -instance Expr ZonedTime where-  expr (ZonedTime-        (LocalTime-         date-         (TimeOfDay hour minute seconds))-        timezone) = let-    (year, month, day) = toGregorian date-    in  op TIME [-      expr year, expr month, expr day, expr hour, expr minute, expr (toRational seconds),-      str $ timeZoneOffsetString timezone] ()+convertBacktrace :: WireBacktrace -> Backtrace+convertBacktrace (WireBacktrace b) =+  case fromDatum b of+    Success a -> a+    Error _ -> [] -instance Expr BaseReQL where+instance Expr UTCTime+instance Expr ZonedTime++instance Expr Term where   expr = ReQL . return  -- | An upper or lower bound for between and during data Bound a =   Open { getBound :: a } -- ^ An inclusive bound   | Closed { getBound :: a } -- ^ An exclusive bound+  | DefaultBound { getBound :: a } -closedOrOpen :: Bound a -> T.Text-closedOrOpen Open{} = "open"-closedOrOpen Closed{} = "closed"+instance Functor Bound where+  fmap f (Open a) = Open (f a)+  fmap f (Closed a) = Closed (f a)+  fmap f (DefaultBound a) = DefaultBound (f a) +closedOrOpen :: Bound a -> Maybe T.Text+closedOrOpen Open{} = Just "open"+closedOrOpen Closed{} = Just "closed"+closedOrOpen DefaultBound{} = Nothing++boundOp :: (a -> a -> a) -> Bound a -> Bound a -> Bound a+boundOp f (Closed a) (Closed b) = Closed $ f a b+boundOp f (Closed a) (Open b) = Open $ f a b+boundOp f (Open a) (Closed b) = Open $ f a b+boundOp f (Open a) (Open b) = Open $ f a b+boundOp f (DefaultBound a) b = fmap (f a) b+boundOp f a (DefaultBound b) = fmap (flip f b) a++instance Num a => Num (Bound a) where+  (+) = boundOp (+)+  (-) = boundOp (-)+  (*) = boundOp (*)+  negate = fmap negate+  abs = fmap abs+  signum = fmap signum+  fromInteger = DefaultBound . fromInteger++-- | An empty object+empty :: ReQL+empty = op MAKE_OBJ ()+ instance (Expr a, Expr b) => Expr (a, b) where   expr (a, b) = expr [expr a, expr b] @@ -479,3 +535,35 @@  instance (Expr a, Expr b, Expr c, Expr d, Expr e) => Expr (a, b, c, d, e) where   expr (a, b, c, d, e) = expr [expr a, expr b, expr c, expr d, expr e]++-- | Add a note a a ReQL Term+--+-- This note does not get sent to the server. It is used to annotate+-- backtraces and help debugging.+note :: String -> ReQL -> ReQL+note n (ReQL t) = ReQL $ return . Note n =<< t++instance Fractional ReQL where+  a / b = op DIV [a, b]+  recip a = op DIV [num 1, a]+  fromRational = expr++instance Floating ReQL where+  pi = js "Math.PI"+  exp x = js "(function(x){return Math.pow(Math.E,x)})" `apply` [x]+  sqrt x = js "Math.sqrt" `apply` [x]+  log x = js "Math.log" `apply` [x]+  (**) x y = js "Math.pow" `apply` [x, y]+  logBase x y = js "(function(x, y){return Math.log(x)/Math.log(y)})" `apply` [x, y]+  sin x = js "Math.sin" `apply` [x]+  tan x = js "Math.tan" `apply` [x]+  cos x = js "Math.cos" `apply` [x]+  asin x = js "Math.asin" `apply` [x]+  atan x = js "Math.atan" `apply` [x]+  acos x = js "Math.acos" `apply` [x]+  sinh = error "hyberbolic math is not supported"+  tanh = error "hyberbolic math is not supported"+  cosh = error "hyberbolic math is not supported"+  asinh = error "hyberbolic math is not supported"+  atanh = error "hyberbolic math is not supported"+  acosh = error "hyberbolic math is not supported"
+ Database/RethinkDB/ReQL.hs-boot view
@@ -0,0 +1,3 @@+module Database.RethinkDB.ReQL where+data ReQL+class Expr e
Database/RethinkDB/Time.hs view
@@ -2,123 +2,74 @@  module Database.RethinkDB.Time where -import qualified  Data.Time as Time-import qualified  Data.Time.Clock.POSIX as Time-import Data.Aeson as JSON-import Data.Aeson.Types (Parser)-import Control.Monad-import Control.Applicative-+import Database.RethinkDB.Wire.Term import Database.RethinkDB.ReQL -import Database.RethinkDB.Protobuf.Ql2.Term.TermType+-- $setup+-- >>> :set -XOverloadedStrings+-- >>> :load Database.RethinkDB.NoClash+-- >>> import qualified Database.RethinkDB as R+-- >>> import Database.RethinkDB.NoClash+-- >>> import Prelude+-- >>> h <- connect "localhost" 28015 def  -- | The time and date when the query is executed ----- > >>> run h $ now :: IO (Maybe R.ZonedTime)--- > Just 2013-10-28 00:01:43.930000066757 +0000+-- > >>> run' h $ now now :: ReQL-now = op NOW () ()+now = op NOW ()  -- | Build a time object from the year, month, day, hour, minute, second and timezone fields ----- > >>> run h $ time 2011 12 24 23 59 59 "Z" :: IO (Maybe R.ZonedTime)--- > Just 2011-12-24 23:59:59 +0000+-- >>> run' h $ time 2011 12 24 23 59 59 "Z"+-- Time<2011-12-24 23:59:59 +0000> time :: ReQL -> ReQL -> ReQL -> ReQL -> ReQL -> ReQL -> ReQL -> ReQL-time y m d hh mm ss tz = op TIME [y, m, d, hh, mm, ss, tz] ()+time y m d hh mm ss tz = op TIME [y, m, d, hh, mm, ss, tz]  -- | Build a time object given the number of seconds since the unix epoch ----- > >>> run h $ epochTime 1147162826 :: IO (Maybe R.ZonedTime)--- > Just 2006-05-09 08:20:26 +0000+-- >>> run' h $ epochTime 1147162826+-- Time<2006-05-09 08:20:26 +0000> epochTime :: ReQL -> ReQL-epochTime t = op EPOCH_TIME [t] ()+epochTime t = op EPOCH_TIME [t]  -- | Build a time object given an iso8601 string ----- > >>> run h $ iso8601 "2012-01-07T08:34:00-0700" :: IO (Maybe R.UTCTime)--- > Just 2012-01-07 15:34:00 UTC+-- >>> run' h $ iso8601 "2012-01-07T08:34:00-0700"+-- Time<2012-01-07 08:34:00 -0700> iso8601 :: ReQL -> ReQL-iso8601 t = op ISO8601 [t] ()+iso8601 t = op ISO8601 [t]  -- | The same time in a different timezone ----- > >>> run h $ inTimezone "+0800" now :: IO (Maybe R.ZonedTime)--- > Just 2013-10-28 08:16:39.22000002861 +0800+-- >>> _ <- run' h $ inTimezone "+0800" now inTimezone :: Expr time => ReQL -> time -> ReQL-inTimezone tz t = op IN_TIMEZONE (t, tz) ()+inTimezone tz t = op IN_TIMEZONE (t, tz)  -- | Test if a time is between two other times ----- > >>> run h $ during (Open $ now - (60*60)) (Closed now) $ epochTime 1382919271 :: IO (Maybe Bool)--- > Just True+-- >>> run' h $ during (Open $ now R.- (60*60)) (Closed now) $ epochTime 1382919271+-- false during :: (Expr left, Expr right, Expr time) => Bound left -> Bound right -> time -> ReQL-during l r t = op DURING (t, getBound l, getBound r) [-  "left_bound" := closedOrOpen l, "right_bound" := closedOrOpen r]+during l r t = op' DURING (t, getBound l, getBound r) [+  "left_bound" ?:= closedOrOpen l, "right_bound" ?:= closedOrOpen r]  -- | Extract part of a time value timezone, date, timeOfDay, year, month, day, dayOfWeek, dayOfYear, hours, minutes, seconds ::   Expr time => time -> ReQL-timezone t = op TIMEZONE [t] ()-date  t = op DATE [t] ()-timeOfDay t = op TIME_OF_DAY [t] ()-year t = op YEAR [t] ()-month t = op MONTH [t] ()-day t = op DAY [t] ()-dayOfWeek t = op DAY_OF_WEEK [t] ()-dayOfYear t = op DAY_OF_YEAR [t] ()-hours t = op HOURS [t] ()-minutes t = op MINUTES [t] ()-seconds t = op SECONDS [t] ()+timezone t = op TIMEZONE [t]+date  t = op DATE [t]+timeOfDay t = op TIME_OF_DAY [t]+year t = op YEAR [t]+month t = op MONTH [t]+day t = op DAY [t]+dayOfWeek t = op DAY_OF_WEEK [t]+dayOfYear t = op DAY_OF_YEAR [t]+hours t = op HOURS [t]+minutes t = op MINUTES [t]+seconds t = op SECONDS [t]  -- | Convert a time to another representation toIso8601, toEpochTime :: Expr t => t -> ReQL-toIso8601 t = op TO_ISO8601 [t] ()-toEpochTime t = op TO_EPOCH_TIME [t] ()---- | Time with no time zone------ The default FromJSON instance for Data.Time.UTCTime is incompatible with ReQL's time type-newtype UTCTime = UTCTime Time.UTCTime--instance Show UTCTime where-  show (UTCTime t) = show t---- | Time with a time zone------ The default FromJSON instance for Data.Time.ZonedTime is incompatible with ReQL's time type-newtype ZonedTime = ZonedTime Time.ZonedTime--instance Show ZonedTime where-  show (ZonedTime t) = show t--instance FromJSON UTCTime where-  parseJSON (JSON.Object v) = UTCTime . Time.posixSecondsToUTCTime . fromRational <$> v .: "epoch_time"-  parseJSON _ = mzero--instance FromJSON ZonedTime where-  parseJSON (JSON.Object v) = do-                         tz <- v .: "timezone"-                         t <- v.: "epoch_time"-                         tz' <- parseTimeZone tz-                         return . ZonedTime $ Time.utcToZonedTime tz'-                           (Time.posixSecondsToUTCTime (fromRational t))-  parseJSON _ = mzero--parseTimeZone :: String -> Parser Time.TimeZone-parseTimeZone "Z" = return Time.utc-parseTimeZone tz = Time.minutesToTimeZone <$> case tz of -  ('-':tz') -> negate <$> go tz'-  ('+':tz') -> go tz'-  _ -> go tz-  where-    go tz' = do-        (h, _:m) <- return $ break (==':') tz'-        ([(hh, "")], [(mm, "")]) <- return $ (reads h, reads m)-        return $ hh * 60 + mm--instance Expr UTCTime where-  expr (UTCTime t) = expr t--instance Expr ZonedTime where-  expr (ZonedTime t) = expr t+toIso8601 t = op TO_ISO8601 [t]+toEpochTime t = op TO_EPOCH_TIME [t]
+ Database/RethinkDB/Types.hs view
@@ -0,0 +1,45 @@+module Database.RethinkDB.Types (+  Database(..),+  Table(..),+  Key,+  Index(..)+  ) where++import qualified Data.Text as Text+import Data.Text (Text, pack)+import Data.String++type Key = Text++-- | A database, referenced by name+data Database = Database {+  databaseName :: Text+  } deriving (Eq, Ord)++instance Show Database where+  show (Database d) = show d++instance IsString Database where+  fromString name = Database $ fromString name++-- | A table description+data Table = Table {+  tableDatabase :: Maybe Database, -- ^ when Nothing, use the connection's database+  tableName :: Text,+  tablePrimaryKey :: Maybe Key+  } deriving (Eq, Ord)++instance Show Table where+  show (Table db' nam mkey) =+    maybe "" (\(Database d) -> Text.unpack d++".") db' ++ Text.unpack nam +++    maybe "" (\k -> "[" ++ show k ++ "]") mkey++instance IsString Table where+  fromString name = Table Nothing (fromString name) Nothing++data Index =+  PrimaryKey |+  Index Key++instance IsString Index where+  fromString = Index . pack
+ Database/RethinkDB/Wire.hs view
@@ -0,0 +1,4 @@+module Database.RethinkDB.Wire where+class WireValue a where+  toWire :: a -> Int+  fromWire :: Int -> Maybe a
+ Database/RethinkDB/Wire/Datum.hs view
@@ -0,0 +1,23 @@+module Database.RethinkDB.Wire.Datum where+import Prelude (Maybe(..), Eq, Show)+import Database.RethinkDB.Wire+data DatumType = R_NULL | R_BOOL | R_NUM | R_STR | R_ARRAY | R_OBJECT | R_JSON+  deriving (Eq, Show)+instance WireValue DatumType where+  toWire R_NULL = 1+  toWire R_BOOL = 2+  toWire R_NUM = 3+  toWire R_STR = 4+  toWire R_ARRAY = 5+  toWire R_OBJECT = 6+  toWire R_JSON = 7+  fromWire 1 = Just R_NULL+  fromWire 2 = Just R_BOOL+  fromWire 3 = Just R_NUM+  fromWire 4 = Just R_STR+  fromWire 5 = Just R_ARRAY+  fromWire 6 = Just R_OBJECT+  fromWire 7 = Just R_JSON+  fromWire _ = Nothing++
+ Database/RethinkDB/Wire/Frame.hs view
@@ -0,0 +1,13 @@+module Database.RethinkDB.Wire.Frame where+import Prelude (Maybe(..), Eq, Show)+import Database.RethinkDB.Wire+data FrameType = POS | OPT+  deriving (Eq, Show)+instance WireValue FrameType where+  toWire POS = 1+  toWire OPT = 2+  fromWire 1 = Just POS+  fromWire 2 = Just OPT+  fromWire _ = Nothing++
+ Database/RethinkDB/Wire/Query.hs view
@@ -0,0 +1,17 @@+module Database.RethinkDB.Wire.Query where+import Prelude (Maybe(..), Eq, Show)+import Database.RethinkDB.Wire+data QueryType = START | CONTINUE | STOP | NOREPLY_WAIT+  deriving (Eq, Show)+instance WireValue QueryType where+  toWire START = 1+  toWire CONTINUE = 2+  toWire STOP = 3+  toWire NOREPLY_WAIT = 4+  fromWire 1 = Just START+  fromWire 2 = Just CONTINUE+  fromWire 3 = Just STOP+  fromWire 4 = Just NOREPLY_WAIT+  fromWire _ = Nothing++
+ Database/RethinkDB/Wire/Response.hs view
@@ -0,0 +1,25 @@+module Database.RethinkDB.Wire.Response where+import Prelude (Maybe(..), Eq, Show)+import Database.RethinkDB.Wire+data ResponseType = SUCCESS_ATOM | SUCCESS_SEQUENCE | SUCCESS_PARTIAL | SUCCESS_FEED | WAIT_COMPLETE | CLIENT_ERROR | COMPILE_ERROR | RUNTIME_ERROR+  deriving (Eq, Show)+instance WireValue ResponseType where+  toWire SUCCESS_ATOM = 1+  toWire SUCCESS_SEQUENCE = 2+  toWire SUCCESS_PARTIAL = 3+  toWire SUCCESS_FEED = 5+  toWire WAIT_COMPLETE = 4+  toWire CLIENT_ERROR = 16+  toWire COMPILE_ERROR = 17+  toWire RUNTIME_ERROR = 18+  fromWire 1 = Just SUCCESS_ATOM+  fromWire 2 = Just SUCCESS_SEQUENCE+  fromWire 3 = Just SUCCESS_PARTIAL+  fromWire 5 = Just SUCCESS_FEED+  fromWire 4 = Just WAIT_COMPLETE+  fromWire 16 = Just CLIENT_ERROR+  fromWire 17 = Just COMPILE_ERROR+  fromWire 18 = Just RUNTIME_ERROR+  fromWire _ = Nothing++
+ Database/RethinkDB/Wire/Term.hs view
@@ -0,0 +1,333 @@+module Database.RethinkDB.Wire.Term where+import Prelude (Maybe(..), Eq, Show)+import Database.RethinkDB.Wire+data TermType = DATUM | MAKE_ARRAY | MAKE_OBJ | VAR | JAVASCRIPT | UUID | HTTP | ERROR | IMPLICIT_VAR | DB | TABLE | GET | GET_ALL | EQ | NE | LT | LE | GT | GE | NOT | ADD | SUB | MUL | DIV | MOD | APPEND | PREPEND | DIFFERENCE | SET_INSERT | SET_INTERSECTION | SET_UNION | SET_DIFFERENCE | SLICE | SKIP | LIMIT | INDEXES_OF | CONTAINS | GET_FIELD | KEYS | OBJECT | HAS_FIELDS | WITH_FIELDS | PLUCK | WITHOUT | MERGE | BETWEEN | REDUCE | MAP | FILTER | CONCATMAP | ORDERBY | DISTINCT | COUNT | IS_EMPTY | UNION | NTH | BRACKET | INNER_JOIN | OUTER_JOIN | EQ_JOIN | ZIP | INSERT_AT | DELETE_AT | CHANGE_AT | SPLICE_AT | COERCE_TO | TYPEOF | UPDATE | DELETE | REPLACE | INSERT | DB_CREATE | DB_DROP | DB_LIST | TABLE_CREATE | TABLE_DROP | TABLE_LIST | SYNC | INDEX_CREATE | INDEX_DROP | INDEX_LIST | INDEX_STATUS | INDEX_WAIT | INDEX_RENAME | FUNCALL | BRANCH | ANY | ALL | FOREACH | FUNC | ASC | DESC | INFO | MATCH | UPCASE | DOWNCASE | SAMPLE | DEFAULT | JSON | ISO8601 | TO_ISO8601 | EPOCH_TIME | TO_EPOCH_TIME | NOW | IN_TIMEZONE | DURING | DATE | TIME_OF_DAY | TIMEZONE | YEAR | MONTH | DAY | DAY_OF_WEEK | DAY_OF_YEAR | HOURS | MINUTES | SECONDS | TIME | MONDAY | TUESDAY | WEDNESDAY | THURSDAY | FRIDAY | SATURDAY | SUNDAY | JANUARY | FEBRUARY | MARCH | APRIL | MAY | JUNE | JULY | AUGUST | SEPTEMBER | OCTOBER | NOVEMBER | DECEMBER | LITERAL | GROUP | SUM | AVG | MIN | MAX | SPLIT | UNGROUP | RANDOM | CHANGES | ARGS | BINARY | GEOJSON | TO_GEOJSON | POINT | LINE | POLYGON | DISTANCE | INTERSECTS | INCLUDES | CIRCLE | GET_INTERSECTING | FILL | GET_NEAREST | POLYGON_SUB+  deriving (Eq, Show)+instance WireValue TermType where+  toWire DATUM = 1+  toWire MAKE_ARRAY = 2+  toWire MAKE_OBJ = 3+  toWire VAR = 10+  toWire JAVASCRIPT = 11+  toWire UUID = 169+  toWire HTTP = 153+  toWire ERROR = 12+  toWire IMPLICIT_VAR = 13+  toWire DB = 14+  toWire TABLE = 15+  toWire GET = 16+  toWire GET_ALL = 78+  toWire EQ = 17+  toWire NE = 18+  toWire LT = 19+  toWire LE = 20+  toWire GT = 21+  toWire GE = 22+  toWire NOT = 23+  toWire ADD = 24+  toWire SUB = 25+  toWire MUL = 26+  toWire DIV = 27+  toWire MOD = 28+  toWire APPEND = 29+  toWire PREPEND = 80+  toWire DIFFERENCE = 95+  toWire SET_INSERT = 88+  toWire SET_INTERSECTION = 89+  toWire SET_UNION = 90+  toWire SET_DIFFERENCE = 91+  toWire SLICE = 30+  toWire SKIP = 70+  toWire LIMIT = 71+  toWire INDEXES_OF = 87+  toWire CONTAINS = 93+  toWire GET_FIELD = 31+  toWire KEYS = 94+  toWire OBJECT = 143+  toWire HAS_FIELDS = 32+  toWire WITH_FIELDS = 96+  toWire PLUCK = 33+  toWire WITHOUT = 34+  toWire MERGE = 35+  toWire BETWEEN = 36+  toWire REDUCE = 37+  toWire MAP = 38+  toWire FILTER = 39+  toWire CONCATMAP = 40+  toWire ORDERBY = 41+  toWire DISTINCT = 42+  toWire COUNT = 43+  toWire IS_EMPTY = 86+  toWire UNION = 44+  toWire NTH = 45+  toWire BRACKET = 170+  toWire INNER_JOIN = 48+  toWire OUTER_JOIN = 49+  toWire EQ_JOIN = 50+  toWire ZIP = 72+  toWire INSERT_AT = 82+  toWire DELETE_AT = 83+  toWire CHANGE_AT = 84+  toWire SPLICE_AT = 85+  toWire COERCE_TO = 51+  toWire TYPEOF = 52+  toWire UPDATE = 53+  toWire DELETE = 54+  toWire REPLACE = 55+  toWire INSERT = 56+  toWire DB_CREATE = 57+  toWire DB_DROP = 58+  toWire DB_LIST = 59+  toWire TABLE_CREATE = 60+  toWire TABLE_DROP = 61+  toWire TABLE_LIST = 62+  toWire SYNC = 138+  toWire INDEX_CREATE = 75+  toWire INDEX_DROP = 76+  toWire INDEX_LIST = 77+  toWire INDEX_STATUS = 139+  toWire INDEX_WAIT = 140+  toWire INDEX_RENAME = 156+  toWire FUNCALL = 64+  toWire BRANCH = 65+  toWire ANY = 66+  toWire ALL = 67+  toWire FOREACH = 68+  toWire FUNC = 69+  toWire ASC = 73+  toWire DESC = 74+  toWire INFO = 79+  toWire MATCH = 97+  toWire UPCASE = 141+  toWire DOWNCASE = 142+  toWire SAMPLE = 81+  toWire DEFAULT = 92+  toWire JSON = 98+  toWire ISO8601 = 99+  toWire TO_ISO8601 = 100+  toWire EPOCH_TIME = 101+  toWire TO_EPOCH_TIME = 102+  toWire NOW = 103+  toWire IN_TIMEZONE = 104+  toWire DURING = 105+  toWire DATE = 106+  toWire TIME_OF_DAY = 126+  toWire TIMEZONE = 127+  toWire YEAR = 128+  toWire MONTH = 129+  toWire DAY = 130+  toWire DAY_OF_WEEK = 131+  toWire DAY_OF_YEAR = 132+  toWire HOURS = 133+  toWire MINUTES = 134+  toWire SECONDS = 135+  toWire TIME = 136+  toWire MONDAY = 107+  toWire TUESDAY = 108+  toWire WEDNESDAY = 109+  toWire THURSDAY = 110+  toWire FRIDAY = 111+  toWire SATURDAY = 112+  toWire SUNDAY = 113+  toWire JANUARY = 114+  toWire FEBRUARY = 115+  toWire MARCH = 116+  toWire APRIL = 117+  toWire MAY = 118+  toWire JUNE = 119+  toWire JULY = 120+  toWire AUGUST = 121+  toWire SEPTEMBER = 122+  toWire OCTOBER = 123+  toWire NOVEMBER = 124+  toWire DECEMBER = 125+  toWire LITERAL = 137+  toWire GROUP = 144+  toWire SUM = 145+  toWire AVG = 146+  toWire MIN = 147+  toWire MAX = 148+  toWire SPLIT = 149+  toWire UNGROUP = 150+  toWire RANDOM = 151+  toWire CHANGES = 152+  toWire ARGS = 154+  toWire BINARY = 155+  toWire GEOJSON = 157+  toWire TO_GEOJSON = 158+  toWire POINT = 159+  toWire LINE = 160+  toWire POLYGON = 161+  toWire DISTANCE = 162+  toWire INTERSECTS = 163+  toWire INCLUDES = 164+  toWire CIRCLE = 165+  toWire GET_INTERSECTING = 166+  toWire FILL = 167+  toWire GET_NEAREST = 168+  toWire POLYGON_SUB = 171+  fromWire 1 = Just DATUM+  fromWire 2 = Just MAKE_ARRAY+  fromWire 3 = Just MAKE_OBJ+  fromWire 10 = Just VAR+  fromWire 11 = Just JAVASCRIPT+  fromWire 169 = Just UUID+  fromWire 153 = Just HTTP+  fromWire 12 = Just ERROR+  fromWire 13 = Just IMPLICIT_VAR+  fromWire 14 = Just DB+  fromWire 15 = Just TABLE+  fromWire 16 = Just GET+  fromWire 78 = Just GET_ALL+  fromWire 17 = Just EQ+  fromWire 18 = Just NE+  fromWire 19 = Just LT+  fromWire 20 = Just LE+  fromWire 21 = Just GT+  fromWire 22 = Just GE+  fromWire 23 = Just NOT+  fromWire 24 = Just ADD+  fromWire 25 = Just SUB+  fromWire 26 = Just MUL+  fromWire 27 = Just DIV+  fromWire 28 = Just MOD+  fromWire 29 = Just APPEND+  fromWire 80 = Just PREPEND+  fromWire 95 = Just DIFFERENCE+  fromWire 88 = Just SET_INSERT+  fromWire 89 = Just SET_INTERSECTION+  fromWire 90 = Just SET_UNION+  fromWire 91 = Just SET_DIFFERENCE+  fromWire 30 = Just SLICE+  fromWire 70 = Just SKIP+  fromWire 71 = Just LIMIT+  fromWire 87 = Just INDEXES_OF+  fromWire 93 = Just CONTAINS+  fromWire 31 = Just GET_FIELD+  fromWire 94 = Just KEYS+  fromWire 143 = Just OBJECT+  fromWire 32 = Just HAS_FIELDS+  fromWire 96 = Just WITH_FIELDS+  fromWire 33 = Just PLUCK+  fromWire 34 = Just WITHOUT+  fromWire 35 = Just MERGE+  fromWire 36 = Just BETWEEN+  fromWire 37 = Just REDUCE+  fromWire 38 = Just MAP+  fromWire 39 = Just FILTER+  fromWire 40 = Just CONCATMAP+  fromWire 41 = Just ORDERBY+  fromWire 42 = Just DISTINCT+  fromWire 43 = Just COUNT+  fromWire 86 = Just IS_EMPTY+  fromWire 44 = Just UNION+  fromWire 45 = Just NTH+  fromWire 170 = Just BRACKET+  fromWire 48 = Just INNER_JOIN+  fromWire 49 = Just OUTER_JOIN+  fromWire 50 = Just EQ_JOIN+  fromWire 72 = Just ZIP+  fromWire 82 = Just INSERT_AT+  fromWire 83 = Just DELETE_AT+  fromWire 84 = Just CHANGE_AT+  fromWire 85 = Just SPLICE_AT+  fromWire 51 = Just COERCE_TO+  fromWire 52 = Just TYPEOF+  fromWire 53 = Just UPDATE+  fromWire 54 = Just DELETE+  fromWire 55 = Just REPLACE+  fromWire 56 = Just INSERT+  fromWire 57 = Just DB_CREATE+  fromWire 58 = Just DB_DROP+  fromWire 59 = Just DB_LIST+  fromWire 60 = Just TABLE_CREATE+  fromWire 61 = Just TABLE_DROP+  fromWire 62 = Just TABLE_LIST+  fromWire 138 = Just SYNC+  fromWire 75 = Just INDEX_CREATE+  fromWire 76 = Just INDEX_DROP+  fromWire 77 = Just INDEX_LIST+  fromWire 139 = Just INDEX_STATUS+  fromWire 140 = Just INDEX_WAIT+  fromWire 156 = Just INDEX_RENAME+  fromWire 64 = Just FUNCALL+  fromWire 65 = Just BRANCH+  fromWire 66 = Just ANY+  fromWire 67 = Just ALL+  fromWire 68 = Just FOREACH+  fromWire 69 = Just FUNC+  fromWire 73 = Just ASC+  fromWire 74 = Just DESC+  fromWire 79 = Just INFO+  fromWire 97 = Just MATCH+  fromWire 141 = Just UPCASE+  fromWire 142 = Just DOWNCASE+  fromWire 81 = Just SAMPLE+  fromWire 92 = Just DEFAULT+  fromWire 98 = Just JSON+  fromWire 99 = Just ISO8601+  fromWire 100 = Just TO_ISO8601+  fromWire 101 = Just EPOCH_TIME+  fromWire 102 = Just TO_EPOCH_TIME+  fromWire 103 = Just NOW+  fromWire 104 = Just IN_TIMEZONE+  fromWire 105 = Just DURING+  fromWire 106 = Just DATE+  fromWire 126 = Just TIME_OF_DAY+  fromWire 127 = Just TIMEZONE+  fromWire 128 = Just YEAR+  fromWire 129 = Just MONTH+  fromWire 130 = Just DAY+  fromWire 131 = Just DAY_OF_WEEK+  fromWire 132 = Just DAY_OF_YEAR+  fromWire 133 = Just HOURS+  fromWire 134 = Just MINUTES+  fromWire 135 = Just SECONDS+  fromWire 136 = Just TIME+  fromWire 107 = Just MONDAY+  fromWire 108 = Just TUESDAY+  fromWire 109 = Just WEDNESDAY+  fromWire 110 = Just THURSDAY+  fromWire 111 = Just FRIDAY+  fromWire 112 = Just SATURDAY+  fromWire 113 = Just SUNDAY+  fromWire 114 = Just JANUARY+  fromWire 115 = Just FEBRUARY+  fromWire 116 = Just MARCH+  fromWire 117 = Just APRIL+  fromWire 118 = Just MAY+  fromWire 119 = Just JUNE+  fromWire 120 = Just JULY+  fromWire 121 = Just AUGUST+  fromWire 122 = Just SEPTEMBER+  fromWire 123 = Just OCTOBER+  fromWire 124 = Just NOVEMBER+  fromWire 125 = Just DECEMBER+  fromWire 137 = Just LITERAL+  fromWire 144 = Just GROUP+  fromWire 145 = Just SUM+  fromWire 146 = Just AVG+  fromWire 147 = Just MIN+  fromWire 148 = Just MAX+  fromWire 149 = Just SPLIT+  fromWire 150 = Just UNGROUP+  fromWire 151 = Just RANDOM+  fromWire 152 = Just CHANGES+  fromWire 154 = Just ARGS+  fromWire 155 = Just BINARY+  fromWire 157 = Just GEOJSON+  fromWire 158 = Just TO_GEOJSON+  fromWire 159 = Just POINT+  fromWire 160 = Just LINE+  fromWire 161 = Just POLYGON+  fromWire 162 = Just DISTANCE+  fromWire 163 = Just INTERSECTS+  fromWire 164 = Just INCLUDES+  fromWire 165 = Just CIRCLE+  fromWire 166 = Just GET_INTERSECTING+  fromWire 167 = Just FILL+  fromWire 168 = Just GET_NEAREST+  fromWire 171 = Just POLYGON_SUB+  fromWire _ = Nothing++
+ Database/RethinkDB/Wire/VersionDummy.hs view
@@ -0,0 +1,25 @@+module Database.RethinkDB.Wire.VersionDummy where+import Prelude (Maybe(..), Eq, Show)+import Database.RethinkDB.Wire+data Version = V0_1 | V0_2 | V0_3+  deriving (Eq, Show)+instance WireValue Version where+  toWire V0_1 = 0x3f61ba36+  toWire V0_2 = 0x723081e1+  toWire V0_3 = 0x5f75e83e+  fromWire 0x3f61ba36 = Just V0_1+  fromWire 0x723081e1 = Just V0_2+  fromWire 0x5f75e83e = Just V0_3+  fromWire _ = Nothing+++data Protocol = PROTOBUF | JSON+  deriving (Eq, Show)+instance WireValue Protocol where+  toWire PROTOBUF = 0x271ffc41+  toWire JSON = 0x7e6970c7+  fromWire 0x271ffc41 = Just PROTOBUF+  fromWire 0x7e6970c7 = Just JSON+  fromWire _ = Nothing++
+ Debug.hs view
@@ -0,0 +1,12 @@+module Debug (+  module Debug.Trace,+  tr, tracePrint+  ) where++import Debug.Trace++tr :: Show a => String -> a -> a+tr s a = trace (s ++ " " ++ show a) a++tracePrint :: Show a => a -> IO ()+tracePrint = traceIO . show
+ bench/Bench.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++-- TODO: find the cause of the bad performance reported by these benchmarks++module Main where++import Control.Exception+import Database.RethinkDB.NoClash+import qualified Database.RethinkDB as R+import Criterion.Main+import Control.Monad++main :: IO ()+main = do+  h <- prepare+  let test name = bench name . nfIO . void . run' h+  let testn n name q = bench ("[" ++ show n ++ "x] " ++ name) . nfIO . (mapM_ next =<<) . sequence . replicate n $ runCursor h q+  defaultMain [+    test "nil" $ nil,+    testn 10 "nil" $ nil,+    testn 100 "nil" $ nil,+    test "point get" $ table "bench" # get (num 0)+    ]++runCursor :: RethinkDBHandle -> ReQL -> IO (Cursor Datum)+runCursor = run++prepare :: IO RethinkDBHandle+prepare = do+  h <- fmap (use "bench") $ connect "localhost" 28015 Nothing+  try_ $ run' h $ dbCreate "bench"+  try_ $ run' h $ tableCreate "bench"+  try_ $ run' h $ table "bench" # ex insert ["conflict" := str "replace"] ["id" := num 0]+  return h++try_ :: IO a -> IO (Either SomeException a)+try_ = try
+ doctests.hs view
@@ -0,0 +1,5 @@+module Main where++import Test.DocTest++main = doctest ["Database.RethinkDB"]
rethinkdb.cabal view
@@ -1,56 +1,90 @@-name:                rethinkdb-version:             1.8.0.5-description:         RethinkDB is a distributed document store with a powerful query language.-synopsis:            RethinkDB driver for Haskell-homepage:            http://github.com/atnnn/haskell-rethinkdb-license:             Apache-license-file:        LICENSE-author:              Etienne Laurin-maintainer:          Etienne Laurin <etienne@atnnn.com>-category:            Database-build-type:          Simple-cabal-version:       >=1.8+name: rethinkdb+version: 1.15.0.0+cabal-version: >=1.8+build-type: Simple+license: Apache+license-file: LICENSE+maintainer: Etienne Laurin <etienne@atnnn.com>+homepage: http://github.com/atnnn/haskell-rethinkdb+synopsis: A driver for the RethinkDB database server+description:+    A driver for the RethinkDB database server+category: Database+author: Etienne Laurin +source-repository head+    type: git+    location: https://github.com/atnnn/haskell-rethinkdb+ +flag dev+    default: False+    manual: True+ library-  exposed-modules:     Database.RethinkDB-                       Database.RethinkDB.NoClash-                       Database.RethinkDB.Driver-                       Database.RethinkDB.Functions-                       Database.RethinkDB.Time-                       Database.RethinkDB.Objects-                       Database.RethinkDB.ReQL-                       Database.RethinkDB.Network-                       Database.RethinkDB.MapReduce-                       Database.RethinkDB.Protobuf.Ql2-                       Database.RethinkDB.Protobuf.Ql2.Backtrace-                       Database.RethinkDB.Protobuf.Ql2.Datum-                       Database.RethinkDB.Protobuf.Ql2.Datum.AssocPair-                       Database.RethinkDB.Protobuf.Ql2.Datum.DatumType-                       Database.RethinkDB.Protobuf.Ql2.Frame-                       Database.RethinkDB.Protobuf.Ql2.Frame.FrameType-                       Database.RethinkDB.Protobuf.Ql2.Query-                       Database.RethinkDB.Protobuf.Ql2.Query.AssocPair-                       Database.RethinkDB.Protobuf.Ql2.Query.QueryType-                       Database.RethinkDB.Protobuf.Ql2.Response-                       Database.RethinkDB.Protobuf.Ql2.Response.ResponseType-                       Database.RethinkDB.Protobuf.Ql2.Term-                       Database.RethinkDB.Protobuf.Ql2.Term.AssocPair-                       Database.RethinkDB.Protobuf.Ql2.Term.TermType-                       Database.RethinkDB.Protobuf.Ql2.VersionDummy-                       Database.RethinkDB.Protobuf.Ql2.VersionDummy.Version-  build-depends:       base >= 4 && < 5,-                       protocol-buffers,-                       unordered-containers,-                       text,-                       aeson,-                       bytestring,-                       containers,-                       attoparsec,-                       data-default,-                       network,-                       ghc-prim,-                       mtl,-                       vector,-                       protocol-buffers-descriptor,-                       time,-                       utf8-string+    build-depends:+        base >=4 && <4.8,+        unordered-containers ==0.2.*,+        text >=0.11 && <1.3,+        aeson >=0.7 && <0.9,+        bytestring ==0.10.*,+        containers ==0.5.*,+        data-default ==0.5.*,+        network >=2.4 && <2.6,+        mtl >=2.1 && <2.3,+        vector ==0.10.*,+        time ==1.4.*,+        utf8-string ==0.3.*,+        binary >=0.5 && <0.8,+        scientific ==0.3.*,+        base64-bytestring ==1.0.*+     +    if flag(dev)+        exposed-modules:+            Debug+        exposed: True+        buildable: True+    exposed-modules:+        Database.RethinkDB+        Database.RethinkDB.NoClash+        Database.RethinkDB.Driver+        Database.RethinkDB.Functions+        Database.RethinkDB.Time+        Database.RethinkDB.Types+        Database.RethinkDB.Datum+        Database.RethinkDB.Geospatial+        Database.RethinkDB.ReQL+        Database.RethinkDB.Network+        Database.RethinkDB.MapReduce+        Database.RethinkDB.Wire+        Database.RethinkDB.Wire.Datum+        Database.RethinkDB.Wire.Frame+        Database.RethinkDB.Wire.Query+        Database.RethinkDB.Wire.Response+        Database.RethinkDB.Wire.Term+        Database.RethinkDB.Wire.VersionDummy+    exposed: True+    buildable: True+    ghc-options: -Wall+    ghc-prof-options: -fprof-auto++test-suite doctests+    build-depends:+        base,+        doctest >=0.9+    type: exitcode-stdio-1.0+    main-is: doctests.hs+    buildable: True+    ghc-options: -threaded++benchmark bench+    build-depends:+        base,+        criterion,+        rethinkdb,+        text,+        aeson+    hs-source-dirs: bench+    type: exitcode-stdio-1.0+    main-is: Bench.hs+    ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N+    ghc-prof-options: -fprof-auto "-with-rtsopts=-p -s -h -i0.1 -N"