extra/mongodb/msg/msg.factor

   1 USING: accessors assocs hashtables constructors kernel linked-assocs math
   2 sequences strings ;
   3
   4 IN: mongodb.msg
   5
   6 CONSTANT: OP_Reply   1
   7 CONSTANT: OP_Message 1000
   8 CONSTANT: OP_Update  2001
   9 CONSTANT: OP_Insert  2002
  10 CONSTANT: OP_Query   2004
  11 CONSTANT: OP_GetMore 2005
  12 CONSTANT: OP_Delete  2006
  13 CONSTANT: OP_KillCursors 2007
  14
  15 CONSTANT: ResultFlag_CursorNotFound  1 ! /* returned, with zero results, when getMore is called but the cursor id is not valid at the server. */
  16 CONSTANT: ResultFlag_ErrSet  2 ! /* { $err : ... } is being returned */
  17 CONSTANT: ResultFlag_ShardConfigStale 4 !  /* have to update config from the server,  usually $err is also set */
  18
  19 TUPLE: mdb-msg
  20 { opcode integer }
  21 { req-id integer initial: 0 }
  22 { resp-id integer initial: 0 }
  23 { length integer initial: 0 }
  24 { flags integer initial: 0 } ;
  25
  26 TUPLE: mdb-query-msg < mdb-msg
  27 { collection string }
  28 { skip# integer initial: 0 }
  29 { return# integer initial: 0 }
  30 { query assoc }
  31 { returnfields assoc }
  32 { orderby sequence }
  33 explain hint ;
  34
  35 TUPLE: mdb-insert-msg < mdb-msg
  36 { collection string }
  37 { objects sequence } ;
  38
  39 TUPLE: mdb-update-msg < mdb-msg
  40 { collection string }
  41 { upsert? integer initial: 0 }
  42 { selector assoc }
  43 { object assoc } ;
  44
  45 TUPLE: mdb-delete-msg < mdb-msg
  46 { collection string }
  47 { selector assoc } ;
  48
  49 TUPLE: mdb-getmore-msg < mdb-msg
  50 { collection string }
  51 { return# integer initial: 0 }
  52 { cursor integer initial: 0 }
  53 { query mdb-query-msg } ;
  54
  55 TUPLE: mdb-killcursors-msg < mdb-msg
  56 { cursors# integer initial: 0 }
  57 { cursors sequence } ;
  58
  59 TUPLE: mdb-reply-msg < mdb-msg
  60 { collection string }
  61 { cursor integer initial: 0 }
  62 { start# integer initial: 0 }
  63 { requested# integer initial: 0 }
  64 { returned# integer initial: 0 }
  65 { objects sequence } ;
  66
  67
  68 CONSTRUCTOR: mdb-getmore-msg ( collection return# cursor -- mdb-getmore-msg )
  69     OP_GetMore >>opcode ; inline
  70
  71 CONSTRUCTOR: mdb-delete-msg ( collection selector -- mdb-delete-msg )
  72     OP_Delete >>opcode ; inline
  73
  74 CONSTRUCTOR: mdb-query-msg ( collection query -- mdb-query-msg )
  75     OP_Query >>opcode ; inline
  76
  77 GENERIC: <mdb-killcursors-msg> ( object -- mdb-killcursors-msg )
  78
  79 M: sequence <mdb-killcursors-msg> ( sequences -- mdb-killcursors-msg )
  80     [ mdb-killcursors-msg new ] dip
  81     [ length >>cursors# ] keep
  82     >>cursors OP_KillCursors >>opcode ; inline
  83
  84 M: integer <mdb-killcursors-msg> ( integer -- mdb-killcursors-msg )
  85     V{ } clone [ push ] keep <mdb-killcursors-msg> ;
  86
  87 GENERIC: <mdb-insert-msg> ( collection objects -- mdb-insert-msg )
  88
  89 M: sequence <mdb-insert-msg> ( collection sequence -- mdb-insert-msg )
  90     [ mdb-insert-msg new ] 2dip
  91     [ >>collection ] dip
  92     >>objects OP_Insert >>opcode ;
  93
  94 M: assoc <mdb-insert-msg> ( collection assoc -- mdb-insert-msg )
  95     [ mdb-insert-msg new ] 2dip
  96     [ >>collection ] dip
  97     V{ } clone tuck push
  98     >>objects OP_Insert >>opcode ;
  99
 100
 101 CONSTRUCTOR: mdb-update-msg ( collection selector object -- mdb-update-msg )
 102     OP_Update >>opcode ; inline
 103
 104 CONSTRUCTOR: mdb-reply-msg ( -- mdb-reply-msg ) ; inline
 105