Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (define *redis* (make-parameter #f))
- ;; Returns a new connection to the server
- (define redis-open open-net-io)
- ;; Calls the procedure passing a connection to the server.
- ;; The connection is closed after proc returns.
- (define (with-redis-connection host port proc)
- (with-net-io host port
- (lambda (in out)
- (proc (list in out)))))
- (define (make-bool value)
- (= 1 value))
- ;; Reads and parses a response from Redis
- (define (redis-response in)
- (define (drop-crlf) (read-string 2 in))
- ;; FIXME: error and reply should be different types
- (define (single-reply) (string->symbol (read-line in)))
- (define error-reply single-reply)
- (define (bulk-reply)
- (let ((len (integer-reply)))
- (cond ((= -1 len) #f)
- (else
- (let ((result (read-string len in)))
- (drop-crlf)
- result)))))
- (define (multi-bulk-reply)
- (let loop ((count (integer-reply))
- (result '()))
- (cond ((= -1 count) #f)
- ((zero? count) (reverse result))
- (else (loop (- count 1)
- (cons (bulk-reply) result))))))
- (define (integer-reply)
- (string->number (read-line in)))
- (case (read-char in)
- ((#\+) (single-reply))
- ((#\-) (error-reply))
- ((#\$) (bulk-reply))
- ((#\*) (multi-bulk-reply))
- ((#\:) (integer-reply))))
- ;; Sends a multi bulk command
- (define (multi-bulk-query out command)
- (define (send . args)
- (for-each (lambda (s) (display s out)) args))
- (send "*" (length command) "\r\n")
- (for-each (lambda (s) (send "$" (string-length s) "\r\n" s "\r\n"))
- command)
- (flush-output out))
- ;; Executes a command and parses the result
- (define (redis-command conn command . args)
- (multi-bulk-query (cadr conn) (cons command args))
- (redis-response (car conn)))
- (define (redis-select db)
- (redis-command (*redis*) "SELECT" db))
- (define (redis-info)
- (let ((info-string (redis-command (*redis*) "INFO")))
- info-string ;; TODO: parse
- ))
- (define (redis-flushdb)
- (redis-command (*redis*) "FLUSHDB"))
- (define (redis-save)
- (redis-command (*redis*) "SAVE"))
- (define (redis-savebg)
- (redis-command (*redis*) "SAVEBG"))
- (define (redis-get key)
- (redis-command (*redis*) "GET" key))
- (define (redis-getset key value)
- (redis-command (*redis*) "GETSET" key value))
- (define (redis-mget . keys)
- (apply redis-command (*redis*) (cons "MGET" keys)))
- (define (redis-append key value)
- (redis-command (*redis*) "APPEND" key value))
- (define (redis-substr key start stop)
- (redis-command (*redis*) "SUBSTR" key start stop))
- ;; FIXME: return as hash/assoc
- (define (redis-hgetall key)
- (redis-command (*redis*) "HGETALL" key))
- (define (redis-hget key field)
- (redis-command (*redis*) "HGET" key field))
- (define (redis-hdel key field)
- (redis-command (*redis*) "HDEL" key field))
- (define (redis-hkeys key)
- (redis-command (*redis*) "HKEYS" key))
- (define (redis-randomkey)
- (redis-command (*redis*) "RANDOMKEY"))
- (define (redis-echo value)
- (redis-command (*redis*) "ECHO" value))
- (define (redis-ping)
- (redis-command (*redis*) "PING"))
- (define (redis-lastsave)
- (redis-command (*redis*) "LASTSAVE"))
- (define (redis-dbsize)
- (redis-command (*redis*) "DBSIZE"))
- (define (redis-exists key)
- (make-bool (redis-command (*redis*) "EXISTS" key)))
- (define (redis-llen key)
- (redis-command (*redis*) "LLEN" key))
- (define (redis-lrange key start stop)
- (redis-command (*redis*) "LRANGE" key start stop))
- (define (redis-ltrim key start stop)
- (redis-command (*redis*) "LTRIM" key start stop))
- (define (redis-lindex key index)
- (redis-command (*redis*) "LINDEX" key index))
- (define (redis-lset key index value)
- (redis-command (*redis*) "LSET" key index value))
- (define (redis-lrem key count value)
- (redis-command (*redis*) "LREM" key count value))
- (define (redis-rpush key value)
- (redis-command (*redis*) "RPUSH" key value))
- (define (redis-lpush key value)
- (redis-command (*redis*) "LPUSH" key value))
- (define (redis-rpop key)
- (redis-command (*redis*) "RPOP" key))
- (define (redis-lpop key)
- (redis-command (*redis*) "LPOP" key))
- (define (redis-brpop key timeout)
- (redis-command (*redis*) "BRPOP" key timeout))
- (define (redis-blpop key timeout)
- (redis-command (*redis*) "BLPOP" key timeout))
- (define (redis-rpoplpush source destination)
- (redis-command (*redis*) "RPOPLPUSH" source destination))
- (define (redis-smembers key)
- (redis-command (*redis*) "SMEMBERS" key))
- (define (redis-sismember key member)
- (make-bool (redis-command (*redis*) "SISMEMBER" key member)))
- (define (redis-sadd key value)
- (make-bool (redis-command (*redis*) "SADD" key value)))
- (define (redis-srem key value)
- (make-bool (redis-command (*redis*) "SREM" key value)))
- (define (redis-smove source destination value)
- (make-bool (redis-command (*redis*) "SMOVE" source destination value)))
- (define (redis-spop key)
- (redis-command (*redis*) "SPOP" key))
- (define (redis-scard key)
- (redis-command (*redis*) "SCARD" key))
- (define (redis-sinter . keys)
- (apply redis-command (*redis*) (cons "SINTER" keys)))
- (define (redis-sinterstore destination . keys)
- (apply redis-command (*redis*) (cons "SINTERSTORE" (cons destination keys))))
- (define (redis-sunion . keys)
- (apply redis-command (*redis*) (cons "SUNION" keys)))
- (define (redis-sunionstore destination . keys)
- (apply redis-command (*redis*) (cons "SUNIONSTORE" (cons destination keys))))
- (define (redis-sdiff . keys)
- (apply redis-command (*redis*) (cons "SDIFF" keys)))
- (define (redis-sdiffstore destination . keys)
- (apply redis-command (*redis*) (cons "SDIFFSTORE" (cons destination keys))))
- (define (redis-srandmember key)
- (redis-command (*redis*) "SRANDMEMBER" key))
- (define (redis-zadd key score member)
- (make-bool (redis-command (*redis*) "ZADD" key score member)))
- (define (redis-zrank key member)
- (redis-command (*redis*) "ZRANK" key member))
- (define (redis-zrevrank key member)
- (redis-command (*redis*) "ZREVRANK" key member))
- (define (redis-zincrby key increment member)
- (redis-command (*redis*) "ZINCRBY" key increment member))
- (define (redis-zcard key)
- (redis-command (*redis*) "ZCARD" key))
- ;; FIXME: options WITHSCORES
- (define (redis-zrange key start stop . options)
- (redis-command (*redis*) "ZRANGE" key start stop))
- ;; FIXME: options LIMIT offset count WITHSCORES
- (define (redis-zrangebyscore key min max . options)
- (redis-command (*redis*) "ZRANGEBYSCORE" key min max))
- ;; FIXME: options WITHSCORES
- (define (redis-zrevrange key start stop . options)
- (redis-command (*redis*) "ZREVRANGE" key start stop))
- (define (redis-zremrangebyscore key min max)
- (redis-command (*redis*) "ZREMRANGEBYSCORE" key min max))
- (define (redis-zremrangebyrank key start stop)
- (redis-command (*redis*) "ZREMRANGEBYRANK" key start stop))
- (define (redis-zscore key member)
- (redis-command (*redis*) "ZSCORE" key))
- (define (redis-zrem key member)
- (make-bool (redis-command (*redis*) "ZREM" key)))
- ;; FIXME: options [WEIGHTS w1 ... wN] [AGGREGATE SUM|MIN|MAX]
- ;; flatten keys param
- (define (redis-zinterstore destination keys . options)
- (redis-command (*redis*) "ZINTERSTORE" destination (length keys) keys))
- ;; FIXME: options [WEIGHTS w1 ... wN] [AGGREGATE SUM|MIN|MAX]
- ;; flatten keys param
- (define (redis-zunionstore destination keys . options)
- (redis-command (*redis*) "ZUNIONSTORE" destination (length keys) keys))
- (define (redis-move key db)
- (make-bool (redis-command (*redis*) "MOVE" key db)))
- (define (redis-setnx key value)
- ;; TODO: convert value to string
- (make-bool (redis-command (*redis*) "SETNX" key value)))
- (define (redis-del . keys)
- (make-bool (apply redis-command (*redis*) "DEL" keys)))
- (define (redis-rename oldname newname)
- (redis-command (*redis*) "RENAME" oldname newname))
- (define (redis-renamenx oldname newname)
- (make-bool (redis-command (*redis*) "RENAMENX" oldname newname)))
- (define (redis-expire key seconds)
- (make-bool (redis-command (*redis*) "EXPIRE" key seconds)))
- (define (redis-ttl key)
- (redis-command (*redis*) "TTL" key))
- (define (redis-expireat key time)
- (make-bool (redis-command (*redis*) "EXPIREAT" key time)))
- (define (redis-set key value)
- ;; TODO: convert value to string
- (redis-command (*redis*) "SET" key value))
Add Comment
Please, Sign In to add comment