You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
93 lines
3.6 KiB
Scheme
93 lines
3.6 KiB
Scheme
(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))))))))))
|
|
|
|
)
|
|
|