gistfile1.sls

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