From 028235b9ffc8972bbf74d41eee1ef970ac01d007 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sun, 10 May 2009 20:06:28 -0300 Subject: [PATCH] extra.redis: Vocabulary for communicating with the Redis key-value database --- extra/redis/authors.txt | 1 + extra/redis/command-writer/authors.txt | 1 + .../command-writer-tests.factor | 138 ++++++++++++++++++ .../command-writer/command-writer.factor | 104 +++++++++++++ extra/redis/command-writer/summary.txt | 1 + extra/redis/redis.factor | 74 ++++++++++ extra/redis/response-parser/authors.txt | 1 + .../response-parser-tests.factor | 20 +++ .../response-parser/response-parser.factor | 27 ++++ extra/redis/response-parser/summary.txt | 1 + extra/redis/summary.txt | 1 + 11 files changed, 369 insertions(+) create mode 100644 extra/redis/authors.txt create mode 100644 extra/redis/command-writer/authors.txt create mode 100644 extra/redis/command-writer/command-writer-tests.factor create mode 100644 extra/redis/command-writer/command-writer.factor create mode 100644 extra/redis/command-writer/summary.txt create mode 100644 extra/redis/redis.factor create mode 100644 extra/redis/response-parser/authors.txt create mode 100644 extra/redis/response-parser/response-parser-tests.factor create mode 100644 extra/redis/response-parser/response-parser.factor create mode 100644 extra/redis/response-parser/summary.txt create mode 100644 extra/redis/summary.txt diff --git a/extra/redis/authors.txt b/extra/redis/authors.txt new file mode 100644 index 0000000000..f4a8cb1dc2 --- /dev/null +++ b/extra/redis/authors.txt @@ -0,0 +1 @@ +Bruno Deferrari diff --git a/extra/redis/command-writer/authors.txt b/extra/redis/command-writer/authors.txt new file mode 100644 index 0000000000..f4a8cb1dc2 --- /dev/null +++ b/extra/redis/command-writer/authors.txt @@ -0,0 +1 @@ +Bruno Deferrari diff --git a/extra/redis/command-writer/command-writer-tests.factor b/extra/redis/command-writer/command-writer-tests.factor new file mode 100644 index 0000000000..901c4e41f3 --- /dev/null +++ b/extra/redis/command-writer/command-writer-tests.factor @@ -0,0 +1,138 @@ +! Copyright (C) 2009 Bruno Deferrari +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test redis.command-writer io.streams.string ; +IN: redis.command-writer.tests + +#! Connection +[ "QUIT\r\n" ] [ [ quit ] with-string-writer ] unit-test + +[ "PING\r\n" ] [ [ ping ] with-string-writer ] unit-test + +[ "AUTH password\r\n" ] [ [ "password" auth ] with-string-writer ] unit-test + +#! String values +[ "SET key 3\r\nfoo\r\n" ] [ [ "foo" "key" set ] with-string-writer ] unit-test + +[ "GET key\r\n" ] [ [ "key" get ] with-string-writer ] unit-test + +[ "GETSET key 3\r\nfoo\r\n" ] [ + [ "foo" "key" getset ] with-string-writer +] unit-test + +[ "MGET key1 key2 key3\r\n" ] [ + [ { "key1" "key2" "key3" } mget ] with-string-writer +] unit-test + +[ "SETNX key 3\r\nfoo\r\n" ] [ + [ "foo" "key" setnx ] with-string-writer +] unit-test + +[ "INCR key\r\n" ] [ [ "key" incr ] with-string-writer ] unit-test + +[ "INCRBY key 7\r\n" ] [ [ 7 "key" incrby ] with-string-writer ] unit-test + +[ "DECR key\r\n" ] [ [ "key" decr ] with-string-writer ] unit-test + +[ "DECRBY key 7\r\n" ] [ [ 7 "key" decrby ] with-string-writer ] unit-test + +[ "EXISTS key\r\n" ] [ [ "key" exists ] with-string-writer ] unit-test + +[ "DEL key\r\n" ] [ [ "key" del ] with-string-writer ] unit-test + +[ "TYPE key\r\n" ] [ [ "key" type ] with-string-writer ] unit-test + +#! Key space +[ "KEYS pat*\r\n" ] [ [ "pat*" keys ] with-string-writer ] unit-test + +[ "RANDOMKEY\r\n" ] [ [ randomkey ] with-string-writer ] unit-test + +[ "RENAME key newkey\r\n" ] [ + [ "newkey" "key" rename ] with-string-writer +] unit-test + +[ "RENAMENX key newkey\r\n" ] [ + [ "newkey" "key" renamenx ] with-string-writer +] unit-test + +[ "DBSIZE\r\n" ] [ [ dbsize ] with-string-writer ] unit-test + +[ "EXPIRE key 7\r\n" ] [ [ 7 "key" expire ] with-string-writer ] unit-test + +#! Lists +[ "RPUSH key 3\r\nfoo\r\n" ] [ [ "foo" "key" rpush ] with-string-writer ] unit-test + +[ "LPUSH key 3\r\nfoo\r\n" ] [ [ "foo" "key" lpush ] with-string-writer ] unit-test + +[ "LLEN key\r\n" ] [ [ "key" llen ] with-string-writer ] unit-test + +[ "LRANGE key 5 9\r\n" ] [ [ 5 9 "key" lrange ] with-string-writer ] unit-test + +[ "LTRIM key 5 9\r\n" ] [ [ 5 9 "key" ltrim ] with-string-writer ] unit-test + +[ "LINDEX key 7\r\n" ] [ [ 7 "key" lindex ] with-string-writer ] unit-test + +[ "LSET key 0 3\r\nfoo\r\n" ] [ [ "foo" 0 "key" lset ] with-string-writer ] unit-test + +[ "LREM key 1 3\r\nfoo\r\n" ] [ [ "foo" 1 "key" lrem ] with-string-writer ] unit-test + +[ "LPOP key\r\n" ] [ [ "key" lpop ] with-string-writer ] unit-test + +[ "RPOP key\r\n" ] [ [ "key" rpop ] with-string-writer ] unit-test + +#! Sets +[ "SADD key 3\r\nfoo\r\n" ] [ [ "foo" "key" sadd ] with-string-writer ] unit-test + +[ "SREM key 3\r\nfoo\r\n" ] [ [ "foo" "key" srem ] with-string-writer ] unit-test + +[ "SMOVE srckey dstkey 3\r\nfoo\r\n" ] [ + [ "foo" "dstkey" "srckey" smove ] with-string-writer +] unit-test + +[ "SCARD key\r\n" ] [ [ "key" scard ] with-string-writer ] unit-test + +[ "SISMEMBER key 3\r\nfoo\r\n" ] [ + [ "foo" "key" sismember ] with-string-writer +] unit-test + +[ "SINTER key1 key2 key3\r\n" ] [ + [ { "key1" "key2" "key3" } sinter ] with-string-writer +] unit-test + +[ "SINTERSTORE dstkey key1 key2 key3\r\n" ] [ + [ { "key1" "key2" "key3" } "dstkey" sinterstore ] with-string-writer +] unit-test + +[ "SUNION key1 key2 key3\r\n" ] [ + [ { "key1" "key2" "key3" } sunion ] with-string-writer +] unit-test + +[ "SUNIONSTORE dstkey key1 key2 key3\r\n" ] [ + [ { "key1" "key2" "key3" } "dstkey" sunionstore ] with-string-writer +] unit-test + +[ "SMEMBERS key\r\n" ] [ [ "key" smembers ] with-string-writer ] unit-test + +#! Multiple db +[ "SELECT 2\r\n" ] [ [ 2 select ] with-string-writer ] unit-test + +[ "MOVE key 2\r\n" ] [ [ 2 "key" move ] with-string-writer ] unit-test + +[ "FLUSHDB\r\n" ] [ [ flushdb ] with-string-writer ] unit-test + +[ "FLUSHALL\r\n" ] [ [ flushall ] with-string-writer ] unit-test + +#! Sorting + +#! Persistence control +[ "SAVE\r\n" ] [ [ save ] with-string-writer ] unit-test + +[ "BGSAVE\r\n" ] [ [ bgsave ] with-string-writer ] unit-test + +[ "LASTSAVE\r\n" ] [ [ lastsave ] with-string-writer ] unit-test + +[ "SHUTDOWN\r\n" ] [ [ shutdown ] with-string-writer ] unit-test + +#! Remote server control +[ "INFO\r\n" ] [ [ info ] with-string-writer ] unit-test + +[ "MONITOR\r\n" ] [ [ monitor ] with-string-writer ] unit-test diff --git a/extra/redis/command-writer/command-writer.factor b/extra/redis/command-writer/command-writer.factor new file mode 100644 index 0000000000..e5e635f457 --- /dev/null +++ b/extra/redis/command-writer/command-writer.factor @@ -0,0 +1,104 @@ +! Copyright (C) 2009 Bruno Deferrari +! See http://factorcode.org/license.txt for BSD license. +USING: io io.crlf kernel math.parser sequences strings interpolate locals ; +IN: redis.command-writer + +string write crlf ] + [ write ] bi ; + +: space ( -- ) CHAR: space write1 ; + +: write-key/value ( value key -- ) + write space + write-value-with-length ; + +: write-key/integer ( integer key -- ) + write space + number>string write ; + +PRIVATE> + +#! Connection +: quit ( -- ) "QUIT" write crlf ; +: ping ( -- ) "PING" write crlf ; +: auth ( password -- ) "AUTH " write write crlf ; + +#! String values +: set ( value key -- ) "SET " write write-key/value crlf ; +: get ( key -- ) "GET " write write crlf ; +: getset ( value key -- ) "GETSET " write write-key/value crlf ; +: mget ( keys -- ) "MGET " write " " join write crlf ; +: setnx ( value key -- ) "SETNX " write write-key/value crlf ; +: incr ( key -- ) "INCR " write write crlf ; +: incrby ( integer key -- ) "INCRBY " write write-key/integer crlf ; +: decr ( key -- ) "DECR " write write crlf ; +: decrby ( integer key -- ) "DECRBY " write write-key/integer crlf ; +: exists ( key -- ) "EXISTS " write write crlf ; +: del ( key -- ) "DEL " write write crlf ; +: type ( key -- ) "TYPE " write write crlf ; + +#! Key space +: keys ( pattern -- ) "KEYS " write write crlf ; +: randomkey ( -- ) "RANDOMKEY" write crlf ; +: rename ( newkey key -- ) "RENAME " write write space write crlf ; +: renamenx ( newkey key -- ) "RENAMENX " write write space write crlf ; +: dbsize ( -- ) "DBSIZE" write crlf ; +: expire ( integer key -- ) "EXPIRE " write write-key/integer crlf ; + +#! Lists +: rpush ( value key -- ) "RPUSH " write write-key/value crlf ; +: lpush ( value key -- ) "LPUSH " write write-key/value crlf ; +: llen ( key -- ) "LLEN " write write crlf ; +: lrange ( start end key -- ) + "LRANGE " write write [ space number>string write ] bi@ crlf ; +: ltrim ( start end key -- ) + "LTRIM " write write [ space number>string write ] bi@ crlf ; +: lindex ( integer key -- ) "LINDEX " write write-key/integer crlf ; +: lset ( value index key -- ) + "LSET " write write-key/integer space write-value-with-length crlf ; +: lrem ( value amount key -- ) + "LREM " write write-key/integer space write-value-with-length crlf ; +: lpop ( key -- ) "LPOP " write write crlf ; +: rpop ( key -- ) "RPOP " write write crlf ; + +#! Sets +: sadd ( member key -- ) + "SADD " write write space write-value-with-length crlf ; +: srem ( member key -- ) + "SREM " write write space write-value-with-length crlf ; +: smove ( member newkey key -- ) + "SMOVE " write write space write space write-value-with-length crlf ; +: scard ( key -- ) "SCARD " write write crlf ; +: sismember ( member key -- ) + "SISMEMBER " write write space write-value-with-length crlf ; +: sinter ( keys -- ) "SINTER " write " " join write crlf ; +: sinterstore ( keys destkey -- ) + "SINTERSTORE " write write space " " join write crlf ; +: sunion ( keys -- ) "SUNION " write " " join write crlf ; +: sunionstore ( keys destkey -- ) + "SUNIONSTORE " write write " " join space write crlf ; +: smembers ( key -- ) "SMEMBERS " write write crlf ; + +#! Multiple db +: select ( integer -- ) "SELECT " write number>string write crlf ; +: move ( integer key -- ) "MOVE " write write-key/integer crlf ; +: flushdb ( -- ) "FLUSHDB" write crlf ; +: flushall ( -- ) "FLUSHALL" write crlf ; + +#! Sorting +! sort + +#! Persistence control +: save ( -- ) "SAVE" write crlf ; +: bgsave ( -- ) "BGSAVE" write crlf ; +: lastsave ( -- ) "LASTSAVE" write crlf ; +: shutdown ( -- ) "SHUTDOWN" write crlf ; + +#! Remote server control +: info ( -- ) "INFO" write crlf ; +: monitor ( -- ) "MONITOR" write crlf ; diff --git a/extra/redis/command-writer/summary.txt b/extra/redis/command-writer/summary.txt new file mode 100644 index 0000000000..917b915546 --- /dev/null +++ b/extra/redis/command-writer/summary.txt @@ -0,0 +1 @@ +Definitions of messages sent to Redis diff --git a/extra/redis/redis.factor b/extra/redis/redis.factor new file mode 100644 index 0000000000..1f6d732407 --- /dev/null +++ b/extra/redis/redis.factor @@ -0,0 +1,74 @@ +! Copyright (C) 2009 Bruno Deferrari +! See http://factorcode.org/license.txt for BSD license. +USING: io redis.response-parser redis.command-writer ; +IN: redis + +#! Connection +: redis-quit ( -- ) quit flush ; +: redis-ping ( -- response ) ping flush read-response ; +: redis-auth ( password -- response ) auth flush read-response ; + +#! String values +: redis-set ( value key -- response ) set flush read-response ; +: redis-get ( key -- response ) get flush read-response ; +: redis-getset ( value key -- response ) getset flush read-response ; +: redis-mget ( keys -- response ) mget flush read-response ; +: redis-setnx ( value key -- response ) setnx flush read-response ; +: redis-incr ( key -- response ) incr flush read-response ; +: redis-incrby ( integer key -- response ) incrby flush read-response ; +: redis-decr ( key -- response ) decr flush read-response ; +: redis-decrby ( integer key -- response ) decrby flush read-response ; +: redis-exists ( key -- response ) exists flush read-response ; +: redis-del ( key -- response ) del flush read-response ; +: redis-type ( key -- response ) type flush read-response ; + +#! Key space +: redis-keys ( pattern -- response ) keys flush read-response ; +: redis-randomkey ( -- response ) randomkey flush read-response ; +: redis-rename ( newkey key -- response ) rename flush read-response ; +: redis-renamenx ( newkey key -- response ) renamenx flush read-response ; +: redis-dbsize ( -- response ) dbsize flush read-response ; +: redis-expire ( integer key -- response ) expire flush read-response ; + +#! Lists +: redis-rpush ( value key -- response ) rpush flush read-response ; +: redis-lpush ( value key -- response ) lpush flush read-response ; +: redis-llen ( key -- response ) llen flush read-response ; +: redis-lrange ( start end key -- response ) lrange flush read-response ; +: redis-ltrim ( start end key -- response ) ltrim flush read-response ; +: redis-lindex ( integer key -- response ) lindex flush read-response ; +: redis-lset ( value index key -- response ) lset flush read-response ; +: redis-lrem ( value amount key -- response ) lrem flush read-response ; +: redis-lpop ( key -- response ) lpop flush read-response ; +: redis-rpop ( key -- response ) rpop flush read-response ; + +#! Sets +: redis-sadd ( member key -- response ) sadd flush read-response ; +: redis-srem ( member key -- response ) srem flush read-response ; +: redis-smove ( member newkey key -- response ) smove flush read-response ; +: redis-scard ( key -- response ) scard flush read-response ; +: redis-sismember ( member key -- response ) sismember flush read-response ; +: redis-sinter ( keys -- response ) sinter flush read-response ; +: redis-sinterstore ( keys destkey -- response ) sinterstore flush read-response ; +: redis-sunion ( keys -- response ) sunion flush read-response ; +: redis-sunionstore ( keys destkey -- response ) sunionstore flush read-response ; +: redis-smembers ( key -- response ) smembers flush read-response ; + +#! Multiple db +: redis-select ( integer -- response ) select flush read-response ; +: redis-move ( integer key -- response ) move flush read-response ; +: redis-flushdb ( -- response ) flushdb flush read-response ; +: redis-flushall ( -- response ) flushall flush read-response ; + +#! Sorting +! sort + +#! Persistence control +: redis-save ( -- response ) save flush read-response ; +: redis-bgsave ( -- response ) bgsave flush read-response ; +: redis-lastsave ( -- response ) lastsave flush read-response ; +: redis-shutdown ( -- response ) shutdown flush read-response ; + +#! Remote server control +: redis-info ( -- response ) info flush read-response ; +: redis-monitor ( -- response ) monitor flush read-response ; diff --git a/extra/redis/response-parser/authors.txt b/extra/redis/response-parser/authors.txt new file mode 100644 index 0000000000..f4a8cb1dc2 --- /dev/null +++ b/extra/redis/response-parser/authors.txt @@ -0,0 +1 @@ +Bruno Deferrari diff --git a/extra/redis/response-parser/response-parser-tests.factor b/extra/redis/response-parser/response-parser-tests.factor new file mode 100644 index 0000000000..bde36114c3 --- /dev/null +++ b/extra/redis/response-parser/response-parser-tests.factor @@ -0,0 +1,20 @@ +! Copyright (C) 2009 Bruno Deferrari +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test redis.response-parser io.streams.string ; +IN: redis.response-parser.tests + +[ 1 ] [ ":1\r\n" [ read-response ] with-string-reader ] unit-test + +[ "hello" ] [ "$5\r\nhello\r\n" [ read-response ] with-string-reader ] unit-test + +[ f ] [ "$-1\r\n" [ read-response ] with-string-reader ] unit-test + +[ { "hello" "world!" } ] [ + "*2\r\n$5\r\nhello\r\n$6\r\nworld!\r\n" [ read-response ] with-string-reader +] unit-test + +[ { "hello" f "world!" } ] [ + "*3\r\n$5\r\nhello\r\n$-1\r\n$6\r\nworld!\r\n" [ + read-response + ] with-string-reader +] unit-test diff --git a/extra/redis/response-parser/response-parser.factor b/extra/redis/response-parser/response-parser.factor new file mode 100644 index 0000000000..3d92d553b0 --- /dev/null +++ b/extra/redis/response-parser/response-parser.factor @@ -0,0 +1,27 @@ +! Copyright (C) 2009 Bruno Deferrari +! See http://factorcode.org/license.txt for BSD license. +USING: combinators io kernel math math.parser sequences ; +IN: redis.response-parser + +number read-bulk ; +: read-multi-bulk ( n -- seq/f ) + dup 0 < [ drop f ] [ + iota [ drop (read-multi-bulk) ] map + ] if ; + +: handle-response ( string -- string ) ; ! TODO +: handle-error ( string -- string ) ; ! TODO + +PRIVATE> + +: read-response ( -- response ) + readln unclip { + { CHAR: : [ string>number ] } + { CHAR: + [ handle-response ] } + { CHAR: $ [ string>number read-bulk ] } + { CHAR: * [ string>number read-multi-bulk ] } + { CHAR: - [ handle-error ] } + } case ; diff --git a/extra/redis/response-parser/summary.txt b/extra/redis/response-parser/summary.txt new file mode 100644 index 0000000000..b89407c7b4 --- /dev/null +++ b/extra/redis/response-parser/summary.txt @@ -0,0 +1 @@ +Parser for responses sent by the Redis server diff --git a/extra/redis/summary.txt b/extra/redis/summary.txt new file mode 100644 index 0000000000..0cd6e69e38 --- /dev/null +++ b/extra/redis/summary.txt @@ -0,0 +1 @@ +Words for communicating with the Redis key-value database -- 2.34.1