#lang scheme/base ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SHP: Hypertext Processor ;; ;; a PHP like web framework for PLT Scheme ;; ;; Bonzai Lab, LLC. All rights reserved. ;; ;; Licensed under LGPL. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; query.ss - parsing web query in hierarchical fashion (and returns a hash) ;; yc 7/7/2010 - first version. (require (planet bzlib/base)) #| this module provides the functionality for converting key/value pairs into a hierarchical hash object. the idea is that the key can indicate a hierarchy themselves - so for example: abc.foo.bar represents a 3 level hierarchy, and the whole key/value pairs represents a flattened hierarchy. this module unflattens the hierarchy to return a hash instead. if multiple keys collide - their values will be folded into a list. ;; shall we rename them to call? web-call. (define kvs1 `(("a.b.c" . "def") ("a.b.c" . "ghi") ("a.c" . "bar"))) (define ckvs (kvs->ckvs kvs1)) ;; #hash(("a" . #hash(("b" . #hash(("c" . ("def" "ghi")))) ("c" . "bar")))) ;;|# ;; used to determine whether a value is passed in. ;; (basically empty key/value can either be an empty string or #f. (define (no-value? v) (or (not v) (equal? v ""))) ;; split the key based on the delimiter (define (split-key key (delim #px"\\.")) (define (empty? s) (equal? s "")) (filter (compose not empty?) (regexp-split delim key))) ;; convert a list into dotted pairs (where the last pair has two values instead of one value with null) ;; this is used so that when we split the key we have it in the dotted pair form, which is easier to ;; manipulate when we are merging everything into an hierarchical hash. (define (list->dotted-pairs lst) (define (helper rest acc) (if (null? rest) acc (helper (cdr rest) (cons (car rest) acc)))) (let ((lst (reverse lst))) (helper (cdr lst) (car lst)))) ;; kv -> key/value pair ;; ckv -> complex-key/value pair. (define (kv->ckv kv) (cons (list->dotted-pairs (split-key (car kv))) (cdr kv))) ;; kvs -> listof kv ;; ckvs -> listof ckv (define (kvs->ckvs kvs) (map kv->ckv kvs)) ;; merge a key/val pair into a hash. (define (merge-kv-into-hash hash key val) (if-it (hash-ref hash key #f) (hash-set hash key (if (pair? it) (append it (list val)) (list it val))) (hash-set hash key val))) ;; (trace merge-kv-into-hash) ;; merge a composite-key/val pair into a hash recursively - this is the work horse. (define (merge-ckv-into-hash hash key val ckvs) (define (nest-helper top-key rest-key inner-hash) (hash-set hash top-key (merge-ckv-into-hash inner-hash rest-key val ckvs))) (if (pair? key) ;; this means we need to recursively handle the value... (if-it (hash-ref hash (car key) #f) (if (not (hash? it)) ;; this is error! (error 'group-ckvs "invalid ckvs combo ~a" ckvs) (nest-helper (car key) (cdr key) it)) (nest-helper (car key) (cdr key) (make-immutable-hash '()))) (if-it (hash-ref hash key #f) (if (hash? it) (error 'group-ckvs "invalid ckvs combo: ~a" ckvs) (merge-kv-into-hash hash key val)) (merge-kv-into-hash hash key val)))) ;; (trace merge-ckv-into-hash) ;; wraps around merge-ckvs-into-hash by takin in a list of ckv (define (group-ckvs ckvs) (define (helper rest hash) (if (null? rest) hash (helper (cdr rest) (merge-ckv-into-hash hash (caar rest) (cdar rest) ckvs)))) ;; (trace helper) (helper ckvs (make-immutable-hash '()))) ;; converts kvs into ckvs and finally convert into a hash ;; if there are empty keys they are discarded. (define (group-kvs kvs) (group-ckvs (kvs->ckvs (filter (lambda (kv) (not (no-value? (car kv)))) kvs)))) ;; (trace group-kvs) (provide group-kvs no-value?)