(module news-macros
    (generate-path-parameters)

(import chicken scheme)
(use srfi-1 data-structures srfi-13)

;; The [tree] argument is a path-spec.
;; See generate-path-parameters for details.
(define-for-syntax (path-tree->symbol-paths tree symbol-prefix)
  (define (_path-tree->symbol-paths tree symbol-prefix)
    (map (lambda (l)
           (let ((path-val (conc (eval (third tree)) (eval (third l)))))
             (if (null? (cdddr l))
                 `(,(symbol-append symbol-prefix (second l)) ,path-val)
                 (append
                  `(,(symbol-append symbol-prefix (second l)) ,path-val)
                  (path-tree->symbol-paths
                   `(,(first l) ,(second l) ,path-val ,@(cdddr l))
                   symbol-prefix)))))
         (cdddr tree)))
  ;; Convert a flat list to a list of pairs
  ;; '(a b c d) => '((a b) (c d))
  (define (pairize lis)
    (if (null? lis)
        '()
        (cons (list (car lis) (cadr lis)) (pairize (cddr lis)))))
  (pairize
   (flatten
    (_path-tree->symbol-paths tree symbol-prefix))))

;; Usage:
;;   (generate-path-parameters
;;     (/ res "res"
;;        (/ css "css))
;;     values
;;     path-
;;     js-uri-var)
;;   => (define path-res (make-parameter "/res"))
;;      (define path-css (make-parameters "/res/css"))
;;      (define js-uri-var
;;              "var uri = {}; uri.uriRes = '/res'; uri.uriCss =
;;              '/res/css';")
;;
;; Signature:
;;   (generate-path-parameters [path-spec] init-proc prefix-symbol js-var)
;; Output:
;;   A set of parameters that define paths and a variable containing a
;;   string defining the URIs for a javascript.
;; [path-spec]:
;;   A path-spec is a hierarchical tree. The first element in a list
;;   is ignored. It is for formatting only. The second element is a symbol
;;   representing the name of the parameter to be generated. The third
;;   element is the part of the path for that parameter. The full path
;;   is built by concatenating the parent paths to the path for the
;;   current item. The parent item is the first three values in the
;;   root node of the child. So each path is a combination of the
;;   paths generated from each anscetor's node. The third element of
;;   each node is 'eval'ed.
(define-syntax generate-path-parameters
  (er-macro-transformer
   (lambda (exp r cmp)
     `(,(r 'begin)
       ;; Prepend a dummy node [*root*] since
       ;; path-tree->symbol-paths expects that.
        ,@(let ((symbol/paths (path-tree->symbol-paths `("" *root* "" ,(cadr exp))
                                                       (cadddr exp)))
                (symbol->camelcase-string
                 (lambda (sym)
                   (let ((symbols (string-split (symbol->string sym) "-")))
                     (fold (lambda (s o) (string-append o (string-titlecase s)))
                           (car symbols)
                           (cdr symbols))))))
            (append
             (map (lambda (symbol/path)
                    `(,(r 'define) ,(first symbol/path)
                      (,(r 'make-parameter)
                       (,(r 'apply) ,(caddr exp) `(,,(second symbol/path))))))
                  symbol/paths)
             `((,(r 'define)
                ,(fifth exp)
                ,(string-append
                  "var uri = {};"
                  (fold (lambda (symbol/path o)
                          (string-append o
                                         "uri."
                                         (symbol->camelcase-string (car symbol/path))
                                         " = '" (cadr symbol/path) "';"))
                        ""
                        symbol/paths))))))))))

)