From f3b459a93835f12cd041d99c3893af305af7bc42 Mon Sep 17 00:00:00 2001
From: Paul Woolcock <pwoolcock@barracuda.com>
Date: Tue, 30 Jul 2013 14:42:40 -0400
Subject: [PATCH] Add hash commands to extra/redis

---
 .../command-writer-tests.factor               | 62 +++++++++++++++++++
 .../command-writer/command-writer.factor      | 24 ++++++-
 extra/redis/redis.factor                      | 15 +++++
 3 files changed, 100 insertions(+), 1 deletion(-)

diff --git a/extra/redis/command-writer/command-writer-tests.factor b/extra/redis/command-writer/command-writer-tests.factor
index 901c4e41f31..1e3ef59ccde 100644
--- a/extra/redis/command-writer/command-writer-tests.factor
+++ b/extra/redis/command-writer/command-writer-tests.factor
@@ -112,6 +112,68 @@ IN: redis.command-writer.tests
 
 [ "SMEMBERS key\r\n" ] [ [ "key" smembers ] with-string-writer ] unit-test
 
+#! Hashes
+[ "HDEL key field\r\n" ] [
+    [ "field" "key" hdel ] with-string-writer
+] unit-test
+
+[ "HEXISTS key field\r\n" ] [
+    [ "field" "key" hexists ] with-string-writer
+] unit-test
+
+[ "HGET key field\r\n" ] [
+    [ "field" "key" hget ] with-string-writer
+] unit-test
+
+[ "HGETALL key\r\n" ] [
+    [ "key" hgetall ] with-string-writer
+] unit-test
+
+[ "HINCRBY key field 1\r\n" ] [
+    [ 1 "field" "key" hincrby ] with-string-writer
+] unit-test
+
+[ "HINCRBYFLOAT key field 1.0\r\n" ] [
+    [ 1.0 "field" "key" hincrbyfloat ] with-string-writer
+] unit-test
+
+[ "HKEYS key\r\n" ] [
+    [ "key" hkeys ] with-string-writer
+] unit-test
+
+[ "HLEN key\r\n" ] [
+    [ "key" hlen ] with-string-writer
+] unit-test
+
+[ "HMGET key field1 field2\r\n" ] [
+    [
+        { "field1" "field2" }
+        "key"
+        hmget
+    ] with-string-writer
+] unit-test
+
+[ "HMSET key field1 value1 field2 value2\r\n" ] [
+    [
+        { { "field1" "value1" } { "field2" "value2" } }
+        "key"
+        hmset
+    ] with-string-writer
+] unit-test
+
+[ "HSET key field value\r\n" ] [
+    [
+        "value"
+        "field"
+        "key"
+        hset
+    ] with-string-writer
+] unit-test
+
+[ "HSETNX key field value\r\n" ] [ [ "value" "field" "key" hsetnx ] with-string-writer ] unit-test
+
+[ "HVALS key\r\n" ] [ [ "key" hvals ] with-string-writer ] unit-test
+
 #! Multiple db
 [ "SELECT 2\r\n" ] [ [ 2 select ] with-string-writer ] unit-test
 
diff --git a/extra/redis/command-writer/command-writer.factor b/extra/redis/command-writer/command-writer.factor
index e5e635f4577..17e4c27c97e 100644
--- a/extra/redis/command-writer/command-writer.factor
+++ b/extra/redis/command-writer/command-writer.factor
@@ -1,6 +1,6 @@
 ! 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 ;
+USING: assocs io io.crlf kernel math.parser sequences strings interpolate locals ;
 IN: redis.command-writer
 
 <PRIVATE
@@ -84,6 +84,28 @@ PRIVATE>
     "SUNIONSTORE " write write " " join space write crlf ;
 : smembers ( key -- ) "SMEMBERS " write write crlf ;
 
+#! Hashes
+: hdel ( field key -- ) "HDEL " write write space write crlf ;
+: hexists ( field key -- ) "HEXISTS " write write space write crlf ;
+: hget ( field key -- ) "HGET " write write space write crlf ;
+: hgetall ( key -- ) "HGETALL " write write crlf ;
+: hincrby ( integer field key -- )
+    "HINCRBY " write write space write space number>string write crlf ;
+: hincrbyfloat (  float field key -- )
+    "HINCRBYFLOAT " write write space write space number>string write crlf ;
+: hkeys ( key -- ) "HKEYS " write write crlf ;
+: hlen ( key -- ) "HLEN " write write crlf ;
+: hmget ( seq key  -- )
+    "HMGET " write write space " " join write crlf ;
+: hmset ( assoc key -- ) 
+    "HMSET " write write space
+    >alist [ " " join ] map " " join write crlf ;
+: hset ( value field key -- ) "HSET " write write space write
+    space write crlf ;
+: hsetnx ( value field key -- ) "HSETNX " write write space
+    write space write crlf ;
+: hvals ( key -- ) "HVALS " write write crlf ;
+
 #! Multiple db
 : select ( integer -- ) "SELECT " write number>string write crlf ;
 : move ( integer key -- ) "MOVE " write write-key/integer crlf ;
diff --git a/extra/redis/redis.factor b/extra/redis/redis.factor
index 51d0c21a94e..6de729468b1 100644
--- a/extra/redis/redis.factor
+++ b/extra/redis/redis.factor
@@ -56,6 +56,21 @@ IN: redis
 : redis-sunionstore ( keys destkey -- response ) sunionstore flush read-response ;
 : redis-smembers ( key -- response ) smembers flush read-response ;
 
+#! Hashes
+: redis-hdel ( field key -- response ) hdel flush read-response ;
+: redis-hexists ( field key -- response ) hexists flush read-response ;
+: redis-hget ( field key -- response ) hget flush read-response ;
+: redis-hgetall ( key -- response ) hgetall flush read-response ;
+: redis-hincrby ( integer field key -- response ) hincrby flush read-response ;
+: redis-hincrbyfloat (  float field key -- response ) hincrbyfloat flush read-response ;
+: redis-hkeys ( key -- response ) hkeys flush read-response ;
+: redis-hlen ( key -- response ) hlen flush read-response ;
+: redis-hmget ( seq key  -- response ) hmget flush read-response ;
+: redis-hmset ( assoc key -- response ) hmset flush read-response ;
+: redis-hset ( value field key -- response ) hset flush read-response ;
+: redis-hsetnx ( value field key -- response ) hsetnx flush read-response ;
+: redis-hvals ( key -- response ) hvals flush read-response ;
+
 #! Multiple db
 : redis-select ( integer -- response ) select flush read-response ;
 : redis-move ( integer key -- response ) move flush read-response ;