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