Source

newlisp-redis / redis.lsp

Full commit
;; @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
;; @homepage @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.
;;
;; @example
;; (setf 'redis (redis:connect))
;; (redis:ping redis)
;; => "+PONG"

(context 'redis)

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

(constant 'inline-commands 
  '("ping" "bgsave" "get" "quit" "auth" "exists" "type" "select" "dbsize"))

(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)
      nil
      (list redis sock ""))))

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