extra/redis/command-writer/command-writer.factor

   1 ! Copyright (C) 2009 Bruno Deferrari
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays assocs formatting kernel math math.parser
   4 sequences strings ;
   5 IN: redis.command-writer
   6
   7 <PRIVATE
   8
   9 GENERIC: write-resp ( value -- )
  10
  11 M: string write-resp ( string -- )
  12     [ length ] keep "$%s\r\n%s\r\n" printf ;
  13
  14 M: integer write-resp ( integer -- )
  15     ":%s\r\n" printf ;
  16
  17 M: sequence write-resp ( sequence -- )
  18     [ length "*%s\r\n" printf ] keep
  19     [ write-resp ] each ;
  20
  21 : write-command ( sequence command -- )
  22     suffix reverse
  23     [ dup number? [ number>string ] when ] map
  24     write-resp ;
  25
  26 PRIVATE>
  27
  28 ! Connection
  29 : quit ( -- ) { "QUIT" } write-resp ;
  30 : ping ( -- ) { "PING" } write-resp ;
  31 : auth ( password -- ) 1array "AUTH" write-command ;
  32
  33 ! String values
  34 : set ( value key -- ) 2array "SET" write-command ;
  35 : get ( key -- ) 1array "GET" write-command ;
  36 : getset ( value key -- ) 2array "GETSET" write-command ;
  37 : mget ( keys -- ) reverse "MGET" write-command ;
  38 : setnx ( value key -- ) 2array "SETNX" write-command ;
  39 : incr ( key -- ) 1array "INCR" write-command ;
  40 : incrby ( integer key -- ) 2array "INCRBY" write-command ;
  41 : decr ( key -- ) 1array "DECR" write-command ;
  42 : decrby ( integer key -- ) 2array "DECRBY" write-command ;
  43 : exists ( key -- ) 1array "EXISTS" write-command ;
  44 : del ( key -- ) 1array "DEL" write-command ;
  45 : type ( key -- ) 1array "TYPE" write-command ;
  46
  47 ! Key space
  48 : keys ( pattern -- ) 1array "KEYS" write-command ;
  49 : randomkey ( -- ) { "RANDOMKEY" } write-resp ;
  50 : rename ( newkey key -- ) 2array "RENAME" write-command ;
  51 : renamenx ( newkey key -- ) 2array "RENAMENX" write-command ;
  52 : dbsize ( -- ) { "DBSIZE" } write-resp ;
  53 : expire ( integer key -- ) 2array "EXPIRE" write-command ;
  54
  55 ! Lists
  56 : rpush ( value key -- ) 2array "RPUSH" write-command ;
  57 : lpush ( value key -- ) 2array "LPUSH" write-command ;
  58 : llen ( key -- ) 1array "LLEN" write-command ;
  59 : lrange ( start end key -- )
  60     swapd 3array "LRANGE" write-command ;
  61 : ltrim ( start end key -- )
  62     swapd 3array "LTRIM" write-command ;
  63 : lindex ( integer key -- ) 2array "LINDEX" write-command ;
  64 : lset ( value index key -- ) 3array "LSET" write-command ;
  65 : lrem ( value amount key -- ) 3array "LREM" write-command ;
  66 : lpop ( key -- ) 1array "LPOP" write-command ;
  67 : rpop ( key -- ) 1array "RPOP" write-command ;
  68
  69 ! Sets
  70 : sadd ( member key -- ) 2array "SADD" write-command ;
  71 : srem  ( member key -- ) 2array "SREM" write-command ;
  72 : smove ( member newkey key -- )
  73     3array "SMOVE" write-command ;
  74 : scard ( key -- ) 1array "SCARD" write-command ;
  75 : sismember ( member key -- )
  76     2array "SISMEMBER" write-command ;
  77 : sinter ( keys -- ) reverse "SINTER" write-command ;
  78 : sinterstore ( keys destkey -- )
  79     [ reverse ] dip suffix "SINTERSTORE" write-command ;
  80 : sunion ( keys -- ) reverse "SUNION" write-command ;
  81 : sunionstore ( keys destkey -- )
  82     [ reverse ] dip suffix "SUNIONSTORE" write-command ;
  83 : smembers ( key -- ) 1array "SMEMBERS" write-command ;
  84
  85 ! Hashes
  86 : hdel ( field key -- ) 2array "HDEL" write-command ;
  87 : hexists ( field key -- ) 2array "HEXISTS" write-command ;
  88 : hget ( field key -- ) 2array "HGET" write-command ;
  89 : hgetall ( key -- ) 1array "HGETALL" write-command ;
  90 : hincrby ( integer field key -- )
  91     3array "HINCRBY" write-command ;
  92 : hincrbyfloat (  float field key -- )
  93     3array "HINCRBYFLOAT" write-command ;
  94 : hkeys ( key -- ) 1array "HKEYS" write-command ;
  95 : hlen ( key -- ) 1array "HLEN" write-command ;
  96 : hmget ( seq key  -- ) prefix reverse "HMGET" write-command ;
  97 : hmset ( assoc key -- )
  98     [
  99         >alist concat reverse
 100     ] dip suffix "HMSET" write-command ;
 101 : hset ( value field key -- ) 3array "HSET" write-command ;
 102 : hsetnx ( value field key -- )
 103     3array "HSETNX" write-command ;
 104 : hvals ( key -- ) 1array "HVALS" write-command ;
 105
 106 ! Multiple db
 107 : select ( integer -- ) 1array "SELECT" write-command ;
 108 : move ( integer key -- ) 2array "MOVE" write-command ;
 109 : swapdb ( old new -- ) 2array "SWAPDB" write-command ;
 110 : flushdb ( -- ) { "FLUSHDB" } write-resp ;
 111 : flushall ( -- ) { "FLUSHALL" } write-resp ;
 112
 113 ! Sorting
 114 ! sort
 115
 116 ! Persistence control
 117 : save ( -- ) { "SAVE" } write-resp ;
 118 : bgsave ( -- ) { "BGSAVE" } write-resp ;
 119 : lastsave ( -- ) { "LASTSAVE" } write-resp ;
 120 : shutdown ( -- ) { "SHUTDOWN" } write-resp ;
 121
 122 ! Remote server control
 123 : info ( -- ) { "INFO" } write-resp ;
 124 : monitor ( -- ) { "MONITOR" } write-resp ;