Reading GET, POST and Cookie values in guile scheme

I’ve start playing with cgi in guile scheme and I came up with the functions to read GET, POST and Cookie values that I want to share. here is the code:

(use-modules (web uri)) ;; includes uri-decode procedure

(define (read-port port)
    (let iter ((result '()) (chr (read-char port)))
        (if (eof-object? chr)
            (list->string result)
            (iter (append result (list chr)) (read-char port)))))

(define (params->alist string fn sep)
  (map (lambda (pair)
          (let* ((list (string-split pair #\=))
                 (key (fn (string-trim (car list))))
                 (value (fn (string-trim (string-join (cdr list) "=")))))
             (cons key value)))
       (string-split string sep)))

(define (create-param-proc string fn sep)
   (if (or (equal? string #f) (equal? string ""))
       (lambda (var) "")
       (let ((query (params->alist string fn sep)))
          (lambda (var)
             (let ((pair (assoc var query)))
               (if (null? pair)
                   ""
                   (cdr pair)))))))



(define GET (create-param-proc (getenv "QUERY_STRING") uri-decode #\&))
(define POST (create-param-proc (read-port (current-input-port)) uri-decode #\&))
(define COOKIE (create-param-proc (getenv "HTTP_COOKIE") identity #\;))

And to get the values you just execute one of GET, POST, COOKIE procedures:

(display (string-append "foo: " (GET "foo")))
(newline)

(display (string-append "foo: " (POST "foo")))
(newline)
(display (string-append "foo: " (COOKIE "foo")))
(newline)

Lisp Macro for Lisp like Structures in Guile Scheme Interpreter

Guile has ugly structure implementaion. Here are sructure implementation for guile (using lisp like macros) which look more like common lisp structures.

(define (make-name name)
  "create struct constructor name."
  (string->symbol (string-append "make-" (symbol->string name))))


(define (make-getter name field)
  "create filed acess function name."
  (string->symbol (string-append (symbol->string name) "-"
				 (symbol->string field))))


(define (make-setter name field)
  "create field setter function name."
  (string->symbol (string-append "set-" 
				 (symbol->string name) "-"
				 (symbol->string field) "!")))


(define (make-predicate name)
  "create predicate function name."
  (string->symbol (string-append (symbol->string name) "?")))


(define-macro (defstruct name . fields)
  "Macro implementing structures in guile based on assoc list."
  (let ((names (map (lambda (symbol) (gensym)) fields))
        (struct (gensym))
        (field-arg (gensym)))
    `(if (not (every-unique ',fields))
        (error 'defstruct "Fields must be unique")
        (begin
          (define (,(make-name name) ,@names)
        (map cons ',fields (list ,@names)))
          ,@(map (lambda (field)
               `(define (,(make-getter name field) ,struct)
              (cdr (assq ',field ,struct)))) fields)
          ,@(map (lambda (field)
               `(define (,(make-setter name field) ,struct ,field-arg)
                    (assq-set! ,struct ',field ,field-arg)
              ,field-arg)) fields)
          (define (,(make-predicate name) ,struct)
            (and (struct? ,struct) (equal? ',fields (map car ,struct))))))))


(define (unique item list)
  "check if item ocour only once."
  (= (length (filter (lambda (i) (eq? item i)) list)) 1))


(define (every predicate list)
  "check if every element in list return true for a given predicate."
  (let ((result #t))
    (for-each (lambda (x)
		(if (not (predicate x)) (set! result #f))) list)
    result))


(define (every-unique list)
  "check if every element ocour only once."
  (every (lambda (item) (unique item list)) list))

(define (struct? struct)
  "check if argument is structure (actualy it check if struct is alist with keys are symbols)."
  (and (list? struct) (every pair? struct) (every symbol? (map car struct))))


(define (last list)
  "return last element from the list."
  (let iter ((list list))
    (if (null? (cdr list))
	(car list)
	(iter (cdr list)))))


(define (write-struct struct)
  "print structure."
  (if (struct? struct)
      (begin
	(display "#<")
	(for-each (lambda (field)
		    (let ((first (car field)))
		      (if (struct? first)
			  (write-struct first)
			  (display first)))
		    (display ":")
		    (let ((rest (cdr field)))
		      (if (struct? rest)
			  (write-struct rest)
			  (write rest)))
		    (if (not (eq? field (last struct)))
			(display " "))) struct)
	(display ">"))))

(define (print-struct struct)
  (write-struct struct)
  (newline))

This implementation use alist as structure. If you use defstruct macro it will define couple of function: constructor make-<struct name>, geters for every field <struct name>-<field name> seters for every field set-<struct name>-<field name>! and predicate <struct name>? which check if structure are of specific type.

You can use it like this

(defstruct point x y)
(define point (make-point 10 20))
(set-point-x! point 1)
(display (string-append "x: " (point-x point)))
(newline)
(display (string-append "is struct?: " (if (struct? point) "true" "false")))
(newline)
(display (string-append "is point?: " (if (point? point) "true" "false")))
(newline)
(print-struct point)

You could download code here.