commit e071be82a7be530f1f81bf387133a14b62e042e5
Author: hellerve <veit@veitheller.de>
Date:   Sun Feb 9 20:23:25 2020 +0100

    initial

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..33e6b71
--- /dev/null
+++ b/README.md
@@ -0,0 +1,19 @@
+# redis
+
+is a Redis client library for Carp.
+
+## Installation
+
+```clojure
+(load "https://veitheller.de/git/carpentry/redis.git@master")
+```
+
+## Usage
+
+TODO
+
+You can also look at the examples in the [`examples`](/examples) directory.
+
+<hr/>
+
+Have fun!
diff --git a/examples/simple.carp b/examples/simple.carp
new file mode 100644
index 0000000..4419a43
--- /dev/null
+++ b/examples/simple.carp
@@ -0,0 +1,22 @@
+(load "https://veitheller.de/git/carpentry/redis.git@master")
+
+(defn main []
+    (match (Redis.open "127.0.0.1")
+      (Result.Success r)
+        (do
+          (Redis.send &r @"PING" &[])
+          (println* &(Redis.read &r))
+
+          (Redis.send &r @"PING" &[(to-redis @"hiiiii")])
+          (println* &(Redis.read &r))
+
+          (println* &(Redis.echo &r @"hi"))
+
+          (println* &(Redis.rpush &r @"mylist" @"1"))
+          (println* &(Redis.rpush &r @"mylist" @"2"))
+          (println* &(Redis.lrange &r @"mylist" @"-100" @"100"))
+
+          (println* &(Redis.latency-help &r))
+
+          (Redis.close r))
+      (Result.Error err) (IO.errorln &err)))
diff --git a/redis.carp b/redis.carp
new file mode 100644
index 0000000..d289d36
--- /dev/null
+++ b/redis.carp
@@ -0,0 +1,387 @@
+(load "git@github.com:carpentry-org/sockets@master")
+
+(deftype RESP
+  (Null [])
+  (Str [String])
+  (Err [String])
+  (Integer [Int])
+  ;(Arr [(Array &Resp)])
+  (Arr [(Array String)])
+)
+
+(defmodule RESP
+  (use-all Array Int Maybe Pattern Result)
+
+  (def separator "\r\n")
+  (def c (prn &@&[@""]))
+
+  (defn str [r]
+    (match @r
+      (Null) @"$-1\r\n"
+      (Str s) (fmt "$%d\r\n%s\r\n" (length &s) &s)
+      (Err s) (fmt "-%s\r\n" &s)
+      (Integer i) (fmt ":%d\r\n" i)
+      (Arr a) (fmt "*%d\r\n%s" (length &a) &(concat &a))))
+
+  (defn decode-bulk-string [s]
+    (if (starts-with? s "-1\r\n")
+      (Success (Null))
+      (let [splt (split #"\r\n" s)
+            l &(unsafe-first &splt)]
+        (if (not (num? l))
+          (Error @"Error decoding bulk string: does not start with length!")
+          (Success (Str
+            (String.prefix-string &(join "\r\n" &(suffix-array &splt 1))
+                                  (from-string l))))))))
+
+  (defn agg [els len]
+    (let-do [consumed 0
+             clen 0]
+      (foreach [el els]
+        (if (>= clen len)
+          (break)
+          (do
+            (set! consumed (inc consumed))
+            (set! clen (+ 2 (+ clen (length el)))))))
+      consumed))
+
+  (defn decode-arr [s]
+    (if (starts-with? s "*0\r\n")
+      (Success (Null))
+      (let [splt (split #"\r\n" &(chomp s))
+            sl &(unsafe-first &splt)]
+        (if (not (num? sl))
+          (Error @"Error decoding array: does not start with length!")
+          (let-do [l (from-string sl)
+                   a (Array.allocate l)
+                   idx 0
+                   err ""]
+            (for [i 0 (- (length &splt) 1)]
+              ; TODO: have nested structures
+              (let-do [el (unsafe-nth &splt (+ i 1))]
+                (case (head el)
+                  \$
+                    (let [il (from-string &(tail el))]
+                      (if (= -1 il)
+                        (aset-uninitialized! &a idx @"")
+                        (let-do [rest (suffix-array &splt (+ i 2))]
+                          (aset-uninitialized! &a idx (prefix-string &(join "\r\n" &rest) il))
+                          (set! i (+ i (agg &rest il))))))
+                  \*
+                    (do
+                      (set! err "TODO: cannot deal with nested arrays")
+                      (break))
+                  (aset-uninitialized! &a idx (chomp el)))
+                (set! idx (inc idx))))
+            (if (= err "")
+              (Success (Arr a))
+              (Error @err)))))))
+
+  (defn from-string [s]
+    (if (empty? s)
+      (Success (Null))
+      (case (head s)
+        \+ (Success (Str (unsafe-first &(split #"\r\n" &(tail s)))))
+        \- (Success (Err (unsafe-first &(split #"\r\n" &(tail s)))))
+        \: (Success (Integer (from-string &(unsafe-first &(split #"\r\n" &(tail s))))))
+        \$ (decode-bulk-string &(tail s))
+        \* (decode-arr &(tail s))
+        (Error (fmt "Malformed RESP data: got %s" s)))))
+)
+
+(definterface to-redis (Fn [a] RESP))
+
+(defmodule String
+  (defn to-redis [s] (RESP.Str s))
+)
+
+(defmodule Int
+  (defn to-redis [s] (RESP.Integer s))
+)
+
+(deftype Redis [
+  sock Socket
+])
+
+(defmodule Redis
+  (use-all Array Result Socket)
+
+  (defn open-on [host port]
+    (let [s (setup-client host port)]
+      (if (valid? &s)
+        (Success (init s))
+        (Error (fmt "Couldn’t connect to %s:%d" host port)))))
+
+  (defn open [host] (open-on host 6379))
+
+  (defn read [r] (RESP.from-string &(Socket.read (sock r))))
+  (defn send [r cmd args]
+    (if (empty? args)
+      (Socket.send (sock r) &(fmt "%s\r\n" &cmd))
+      (Socket.send (sock r) &(str &(RESP.Arr (concat &[[(str &(to-redis cmd))] (copy-map &RESP.str args)]))))))
+
+  (defn close [r] (Socket.close @(sock &r)))
+
+)
+
+(defndynamic rtreat- [s]
+  (let [i (String.index-of s \-)]
+    (if (= i -1)
+      s
+      (String.join [(String.prefix-string s i)
+                    " "
+                    (rtreat- (String.suffix-string s (+ i 1)))]))))
+
+(defndynamic rconv- [args]
+  (if (= (length args) 0)
+    (array)
+    (cons (list 'to-redis (car args)) (rconv- (cdr args)))))
+
+(defmacro defredis [cmd :rest args]
+  (list 'defmodule 'Redis
+    (list 'defn cmd (cadr (collect-into (cons 'r args) array))
+      (list 'do
+        (list 'Redis.send 'r (list 'copy (rtreat- (Symbol.str cmd))) (list 'ref (rconv- args)))
+        '(Redis.read r)))))
+
+(defredis append key value)
+(defredis auth password)
+(defredis bgrewriteaof)
+(defredis bgsave)
+(defredis bitcount key)
+(defredis bitfield key)
+(defredis bitop operation destkey key)
+(defredis bitpos key bit)
+(defredis blpop key timeout)
+(defredis brpop key timeout)
+(defredis brpoplpush source destination timeout)
+(defredis bzpopmin key timeout)
+(defredis bzpopmax key timeout)
+(defredis client-id)
+(defredis client-kill)
+(defredis client-list)
+(defredis client-getname)
+(defredis client-pause timeout)
+(defredis client-reply)
+(defredis client-setname connection-name)
+(defredis client-unblock client-id)
+(defredis cluster-addslots slot)
+(defredis cluster-bumpepoch)
+(defredis cluster-count-failure-reports node-id)
+(defredis cluster-countkeysinslot slot)
+(defredis cluster-delslots slot)
+(defredis cluster-failover)
+(defredis cluster-flushslots)
+(defredis cluster-forget node-id)
+(defredis cluster-getkeysinslot slot count)
+(defredis cluster-info)
+(defredis cluster-keyslot key)
+(defredis cluster-meet ip port)
+(defredis cluster-myid)
+(defredis cluster-nodes)
+(defredis cluster-replicate node-id)
+(defredis cluster-reset)
+(defredis cluster-saveconfig)
+(defredis cluster-set-config-epoch config-epoch)
+(defredis cluster-setslot slot)
+(defredis cluster-slaves node-id)
+(defredis cluster-replicas node-id)
+(defredis cluster-slots)
+(defredis command)
+(defredis command-count)
+(defredis command-getkeys)
+(defredis command-info command-name)
+(defredis config-get parameter)
+(defredis config-rewrite)
+(defredis config-set parameter value)
+(defredis config-resetstat)
+(defredis dbsize)
+(defredis debug-object key)
+(defredis debug-segfault)
+(defredis decr key)
+(defredis decrby key decrement)
+(defredis del key)
+(defredis discard)
+(defredis dump key)
+(defredis echo message)
+(defredis eval script numkeys key)
+(defredis evalsha sha1 numkeys key)
+(defredis exec)
+(defredis exists key)
+(defredis expire key seconds)
+(defredis expireat key timestamp)
+(defredis flushall)
+(defredis flushdb)
+(defredis geoadd key longitude latitude member)
+(defredis geohash key member)
+(defredis geopos key member)
+(defredis geodist key member1 member2)
+(defredis georadius key longitude latitude radius)
+(defredis georadiusbymember key member radius)
+(defredis get key)
+(defredis getbit key offset)
+(defredis getrange key start end)
+(defredis getset key value)
+(defredis hdel key field)
+(defredis hexists key field)
+(defredis hget key field)
+(defredis hgetall key)
+(defredis hincrby key field increment)
+(defredis hincrbyfloat key field increment)
+(defredis hkeys key)
+(defredis hlen key)
+(defredis hmget key field)
+(defredis hmset key field value)
+(defredis hset key field value)
+(defredis hsetnx key field value)
+(defredis hstrlen key field)
+(defredis hvals key)
+(defredis incr key)
+(defredis incrby key increment)
+(defredis incrbyfloat key increment)
+(defredis info)
+(defredis lolwut)
+(defredis keys pattern)
+(defredis lastsave)
+(defredis lindex key index)
+(defredis linsert key w pivot element)
+(defredis llen key)
+(defredis lpop key)
+(defredis lpush key element)
+(defredis lpushx key element)
+(defredis lrange key start stop)
+(defredis lrem key count element)
+(defredis lset key index element)
+(defredis ltrim key start stop)
+(defredis memory-doctor)
+(defredis memory-help)
+(defredis memory-malloc-stats)
+(defredis memory-purge)
+(defredis memory-stats)
+(defredis memory-usage key)
+(defredis mget key)
+(defredis migrate host port key destination-db timeout)
+(defredis module-list)
+(defredis module-load path)
+(defredis module-unload name)
+(defredis monitor)
+(defredis move key db)
+(defredis mset key value)
+(defredis msetnx key value)
+(defredis multi)
+(defredis object subcommand)
+(defredis persist key)
+(defredis pexpire key milliseconds)
+(defredis pexpireat key milliseconds-timestamp)
+(defredis pfadd key element)
+(defredis pfcount key)
+(defredis pfmerge destkey sourcekey)
+(defredis ping)
+(defredis psetex key milliseconds value)
+(defredis psubscribe pattern)
+(defredis pubsub subcommand)
+(defredis pttl key)
+(defredis publish channel message)
+(defredis punsubscribe)
+(defredis quit)
+(defredis randomkey)
+(defredis readonly)
+(defredis readwrite)
+(defredis rename key newkey)
+(defredis renamenx key newkey)
+(defredis restore key ttl serialized-value)
+(defredis role)
+(defredis rpop key)
+(defredis rpoplpush source destination)
+(defredis rpush key element)
+(defredis rpushx key element)
+(defredis sadd key member)
+(defredis save)
+(defredis scard key)
+(defredis script-debug mode)
+(defredis script-exists sha1)
+(defredis script-flush)
+(defredis script-kill)
+(defredis script-load script)
+(defredis sdiff key)
+(defredis sdiffstore destination key)
+(defredis select index)
+(defredis set key value)
+(defredis setbit key offset value)
+(defredis setex key seconds value)
+(defredis setnx key value)
+(defredis setrange key offset value)
+(defredis shutdown)
+(defredis sinter key)
+(defredis sinterstore destination key)
+(defredis sismember key member)
+(defredis slaveof host port)
+(defredis replicaof host port)
+(defredis slowlog subcommand)
+(defredis smembers key)
+(defredis smove source destination member)
+(defredis sort key)
+(defredis spop key)
+(defredis srandmember key)
+(defredis srem key member)
+(defredis strlen key)
+(defredis subscribe channel)
+(defredis sunion key)
+(defredis sunionstore destination key)
+(defredis swapdb index1 index2)
+(defredis sync)
+(defredis psync replicationid offset)
+(defredis time)
+(defredis touch key)
+(defredis ttl key)
+(defredis type key)
+(defredis unsubscribe)
+(defredis unlink key)
+(defredis unwatch)
+(defredis wait numreplicas timeout)
+(defredis watch key)
+(defredis zadd key)
+(defredis zcard key)
+(defredis zcount key min max)
+(defredis zincrby key increment member)
+(defredis zinterstore destination numkeys key)
+(defredis zlexcount key min max)
+(defredis zpopmax key)
+(defredis zpopmin key)
+(defredis zrange key start stop)
+(defredis zrangebylex key min max)
+(defredis zrevrangebylex key max min)
+(defredis zrangebyscore key min max)
+(defredis zrank key member)
+(defredis zrem key member)
+(defredis zremrangebylex key min max)
+(defredis zremrangebyrank key start stop)
+(defredis zremrangebyscore key min max)
+(defredis zrevrange key start stop)
+(defredis zrevrangebyscore key max min)
+(defredis zrevrank key member)
+(defredis zscore key member)
+(defredis zunionstore destination numkeys key)
+(defredis scan cursor)
+(defredis sscan key cursor)
+(defredis hscan key cursor)
+(defredis zscan key cursor)
+(defredis xinfo)
+(defredis xadd key ID field value)
+(defredis xtrim key MAXLEN count)
+(defredis xdel key ID)
+(defredis xrange key start end)
+(defredis xrevrange key end start)
+(defredis xlen key)
+(defredis xread)
+(defredis xgroup)
+(defredis xreadgroup GROUP group consumer)
+(defredis xack key group ID)
+(defredis xclaim key group consumer min-idle-time ID)
+(defredis xpending key group)
+(defredis latency-doctor)
+(defredis latency-graph event)
+(defredis latency-history event)
+(defredis latency-latest)
+(defredis latency-reset)
+(defredis latency-help)