carpentry/redis
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

initial

Browse Source
This commit is contained in:
Veit Heller
2020-02-09 20:23:25 +01:00
commit e071be82a7
3 changed files with 428 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
README.md Normal file
View File

@@ -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!

22
examples/simple.carp Normal file
View File

@@ -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)))

387
redis.carp Normal file
View File

@@ -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)