#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; NET.plt
;;
;; abstraction of common network behaviors and services
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; Licensed under LGPL.
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; kvs.ss - reader & writer for key/value sets
;; yc 2/13/2010 - first version
;; yc 7/7/2010 - fixed make-kvs-registry to use the bzlib/base:1:6's registry change.
(require "depend.ss"
         "comment.ss"
         )

;; an spair is where the car is a string...
;; this is used prevalently in most of the internet-based objects...
(define (kv? v)
  (and (pair? v)
       (string? (car v))))

(define (kvlist? lst)
  (or (null? lst)
      (and (pair? lst)
           (andmap kv? lst))))

(define-struct kvs ((inner #:mutable))) 

(define (kvlist-ref lst key (default #f))
  (define (helper v)
    (if (pair? v)
        (cdr v)
        default))
  (helper (assf (lambda (k)
                  (string-ci=? k key)) 
                lst))) 

(define (kvlist-ref* lst key (default '())) 
  (define (helper v)
    (if (null? v)
        default
        (map cdr v)))
  (helper (filter (lambda (kv) 
                    (string-ci=? (car kv) key)) 
                  lst)))

(define (kvlist-del lst key) 
  (remove key lst (lambda (key kv) 
                    (string-ci=? key (car kv)))))

(define (kvlist-del* lst key) 
  (filter (lambda (kv) 
            (not (string-ci=? key (car kv)))) 
          lst)) 

(define (kvlist-set lst key val)
  (cons (cons key val) 
        (kvlist-del lst key))) 

(define (kvlist-push lst key val)
  (cons (cons key val) lst)) 

(define (kvs-ref kvs key (default #f)) 
  (kvlist-ref (kvs-inner kvs) key default)) 

(define (kvs-ref* kvs key (default '())) 
  (kvlist-ref (kvs-inner kvs) key default)) 

(define (kvs-del! kvs key) 
  (set-kvs-inner! kvs (kvlist-del (kvs-inner kvs) key))
  kvs) 

(define (kvs-del*! kvs key) 
  (set-kvs-inner! kvs (kvlist-del* (kvs-inner kvs) key))
  kvs) 

(define (kvs-set! kvs key val)
  (set-kvs-inner! kvs (kvlist-set (kvs-inner kvs) key val))
  kvs)

(define (kvs-push! kvs key val)
  (set-kvs-inner! kvs (kvlist-push (kvs-inner kvs) key val))
  kvs)

(define (kvs/list? kvs)
  (or (kvs? kvs)
      (kvlist? kvs))) 

(define (kvs/list->kvlist (kvs '()))
  (if (kvs? kvs)
      (kvs-inner kvs)
      kvs))

(define (kvs/list-ref kvs key (default #f)) 
  ((if (kvs? kvs)
       kvs-ref
       kvlist-ref) kvs key default))

(define (kvs/list-ref* kvs key (default '())) 
  ((if (kvs? kvs)
       kvs-ref*
       kvlist-ref*) kvs key default))

(define (kvs/list-set! kvs key val)
  ((if (kvs? kvs)
       kvs-set!
       kvlist-set) kvs key val))

(define (kvs/list-push! kvs key val)
  ((if (kvs? kvs)
       kvs-push! 
       kvlist-push) kvs key val)) 

(define (kvs/list-del! kvs key) 
  ((if (kvs? kvs)
       kvs-del!
       kvlist-del) kvs key))

(define (kvs/list-del*! kvs key)
  ((if (kvs? kvs)
       kvs-del*!
       kvlist-del*) kvs key))

(define (make-kvs-registry (kvs '())) 
  (make-registry kvlist-ref kvlist-set kvlist-del kvs/list->kvlist (kvs/list->kvlist kvs)))

(provide kvs)
(provide/contract 
 (kv? (-> any/c any))
 (kvlist? (-> any/c any))
 (struct:kvs struct-type?)
 (kvs? (-> any/c any)) 
 (make-kvs (-> kvlist? kvs?))
 (kvs-inner (-> kvs? any)) ;; kvlist?
 (set-kvs-inner! (-> kvs? kvlist? any))
 (kvlist-ref (-> kvlist? string? any/c any)) 
 (kvlist-ref* (-> kvlist? string? any/c any)) 
 (kvlist-del (-> kvlist? string? any)) 
 (kvlist-del* (-> kvlist? string? any)) 
 (kvlist-set (-> kvlist? string? any/c any)) 
 (kvlist-push (-> kvlist? string? any/c any))
 (kvs-ref (->* (kvs? string?)
               (any/c) 
               any))
 (kvs-ref* (->* (kvs? string?)
                (any/c)
                any))
 (kvs-del! (-> kvs? string? any)) 
 (kvs-del*! (-> kvs? string? any)) 
 (kvs-set! (-> kvs? string? any/c any)) 
 (kvs-push! (-> kvs? string? any/c any))
 (kvs/list? (-> any/c any)) 
 (kvs/list->kvlist (->* ()
                        (kvs/list?) 
                        any))
 (kvs/list-ref (->* (kvs/list? string?)
                    (any/c)
                    any))
 (kvs/list-ref* (->* (kvs/list? string?)
                     (any/c)
                     any))
 (kvs/list-set! (-> kvs/list? string? any/c any))
 (kvs/list-push! (-> kvs/list? string? any/c any))
 (kvs/list-del! (-> kvs/list? string? any))
 (kvs/list-del*! (-> kvs/list? string? any))
 (make-kvs-registry (->* ()
                         (kvs/list?)
                         registry?))
 )

;;

;; shall I move the readertable further down?
(define kvs-readertable (make-parameter '())) 

(define kvs-writertable (make-parameter '())) 

(define (kvs-reader-ref name (reader identity))
  (kvlist-ref (kvs-readertable) name reader))

(define (kvs-writer-ref name (writer (curry format "~a")))
  (kvlist-ref (kvs-writertable) name writer)) 

(define (make-kv-parser KEY separator VALUE (tokenizer p:comment-tokenizer-ci))
  (tokens/by tokenizer 
             key <- KEY
             separator
             value <- VALUE 
             (return (cons key 
                           ((kvs-reader-ref key) value)))))

(define (make-kv-reader key delim value 
                           (tokenizer p:comment-tokenizer-ci))
  (make-reader (make-kv-parser key delim value tokenizer)))

(define (make-kvs-parser KEY separator VALUE set-separator 
                        (tokenizer p:comment-tokenizer-ci))
  (delimited (make-kv-parser KEY separator VALUE tokenizer) (tokenizer set-separator)))

(define (make-kvs-reader key value delim set-delim 
                               (tokenizer p:comment-tokenizer-ci))
  (make-reader (make-kvs-parser key delim value set-delim tokenizer)))

;; writing out kvss... we need quite a bit of stuffs to make this work...
;; what does it take to do so???
;; there are a couple of things...
;; one is that we need to have the writing based on the type of object... which
;; will convert it to string.
;; second thing is that we need to run it through some sort of filter...
;; hmm...
;; assuming each of the type are unique...
;; then we would want to do it by type instead of by the actual value itself...
;; hmm...
(define (kv->string kv 
                       #:delim (delim "=")
                       #:encode-val (encode-val identity) 
                       #:encode-key (encode-key identity))
  (stringify* (encode-key (any->string (car kv))) 
              delim 
              (encode-val (any->string (cdr kv))))) 

(define (kvs->string set 
                        #:one (kv->string kv->string)
                        #:delim (delim ";")
                        )
  (string-join (map kv->string (kvs/list->kvlist set)) delim)) 

(provide/contract 
 (kvs-readertable (parameter/c (listof (cons/c string? (-> Input/c any)))))
 (kvs-writertable (parameter/c (listof (cons/c string? (-> any/c any)))))
 (make-kv-reader (->* (Literal-Parser/c Literal-Parser/c Literal-Parser/c)
                      (Parser/c)
                      Reader/c))
 (make-kvs-reader (->* (Literal-Parser/c Literal-Parser/c Literal-Parser/c Literal-Parser/c)
                       (Parser/c)
                       Reader/c))
 (kvs-reader-ref (->* (string?)
                      (procedure?)
                      any))
 (kvs-writer-ref (->* (string?)
                      (procedure?)
                      any))
 (kv->string (->* (kv?)
                  (#:delim any/c
                           #:encode-val procedure?
                           #:encode-key procedure?)
                  string?))
 (kvs->string (->* (kvs/list?)
                   (#:one procedure?
                          #:delim any/c)
                   string?))
 (make-kv-parser (->* (Literal-Parser/c Literal-Parser/c Literal-Parser/c)
               (Parser/c)
               Parser/c))
 (make-kvs-parser 
  (->* (Literal-Parser/c Literal-Parser/c Literal-Parser/c Literal-Parser/c)
       (Parser/c)
       Parser/c))
 )