1. Nikhil Marathe
  2. newlisp-redis


newlisp-redis / redis.lsp

;; @module redis
;; @description newLISP bindings for the Redis database ( http://code.google.com/p/redis )
;; @version 0.1
;; @author Nikhil Marathe <nsm.nikhil@gmail.com> 2010
;; @link http://bitbucket.org/nikhilm/newlisp-redis http://bitbucket.org/nikhilm/newlisp-redis
;; This module provides bindings to Redis. It communicates
;; with the Redis server and returns values in appropriate
;; lisp-y types.
;; Commands are automatically generated, so the documentation
;; can be found in the Redis Command Reference.
;; For a reference look at @link ../test-redis.lsp test-redis.lsp
;; To view a list of commands do:
;; <pre> (println redis:inline-commands)</pre>
;; and so on for other types
;; @example
;; (setf 'redis (redis:connect))
;; (redis:ping redis)
;; => "PONG"

(context 'redis)

(constant 'CRLF "\r\n")
(constant 'BUFSIZE 4096)

// transformed from redis-node-client + ping and quit
(constant 'inline-commands 
  '("auth" "bgsave" "dbsize" "decr" "decrby" "del"
    "exists" "expire" "flushall" "flushdb" "get" "incr" "incrby" "info"
    "keys" "lastsave" "lindex" "llen" "lpop" "lrange" "ltrim" "mget"
    "move" "ping" "quit" "randomkey" "rename" "renamenx" "rpop" "save" "scard" "sdiff"
    "sdiffstore" "select" "shutdown" "sinter" "sinterstore" "smembers"
    "spop" "srandmember" "sunion" "sunionstore" "ttl" "type"
    "zrange" "zrevrange" "zcard" "zrangebyscore"))

(constant 'bulk-commands
  '("getset" "lpush" "lrem" "lset" "rpush" "sadd"
    "set" "setnx" "sismember" "smove" "srem" "zadd"
    "zrem" "zscore" "rpoplpush"))

(define (make-inline-command command)
  (letex ((fname (sym command)) (cmd command))
        (define (fname r)
          (letn ( (args-as-strings (map (fn (x) (string x)) (args)))
                  (command-string (join (cons (upper-case cmd) args-as-strings) " ")) )
              (:query r (append command-string redis:CRLF))))))

(context MAIN)

;; @syntax (redis [host] [port])
;; Creates a new connection to a Redis instance
;; @return a new connection object or nil on error
(define (redis:redis (host "localhost") (port 6379))
  (let (sock (net-connect host port))
    (if (nil? sock)
      (list redis sock ""))))

;; @syntax (:close redis)
;; Closes a redis connection, including the socket
(define (redis:close r)
  (:quit r)
  (net-close (r 1) true))

(define (redis:query r command-str)
  (net-send (r 1) (append command-str redis:CRLF))
  (net-receive (r 1) buf redis:BUFSIZE)
  (write-buffer (r 2) buf)
  (:handle-reply r))

(define (redis:handle-reply r , reply)
  (while (> (length (r 2)) 0)
    (setf reply
        (case (first (r 2))
          ("+" (:handle-single-reply r))
          ("-" (:handle-error r))
          ("$" (:handle-bulk-reply r))
          ("*" (:handle-multi-bulk-reply r))
          (":" (:handle-integer-reply r))
          (true (:handle-unknown-reply r))))
    (setf (r 2) ((reply 1) (r 2)))
    (reply 0)))

(define (redis:handle-single-reply r)
  (letn ((trimm (chop (r 2) 2))
         (message (1 trimm)))
    (list message (length (r 2)))))

(define (redis:handle-bulk-reply r)
  (list (r 2) (length (r 2))))

(define (redis:handle-error r)
  (throw-error (1 (chop (r 2) 2))))

(define (redis:handle-integer-reply r)
  (let (num (int (1 (r 2)))) 
    (if (nil? num)
      (throw-error (append "Invalid integer reply:" (r 2)))
      (list (int num) (length (r 2))))))

(dolist (x redis:inline-commands)
  (redis:make-inline-command x))

(dolist (x redis:bulk-commands)
  (redis:make-bulk-command x))