mbutterick
/
pollen
3
3
Fork 0
Code Issues 1 Pull Requests Projects Releases Wiki Activity

working mostly

Browse Source
pull/9/head
Matthew Butterick 10 years ago
parent e8fc8db202
commit a7e6bcc73f
4 changed files with 95 additions and 75 deletions
Show Stats Download Patch File Download Diff File

99
decode.rkt
Unescape Escape View File

@ -7,6 +7,19 @@
(provide (except-out (all-defined-out) decode register-block-tag))
;; general way of coercing to string
(define (to-string x)
(if (string? x)
x ; fast exit for strings
(with-handlers ([exn:fail? (λ(exn) (error "Can't convert ~a to ~a" x 'string))])
(cond
[(equal? '() x) ""]
[(symbol? x) (symbol->string x)]
[(number? x) (number->string x)]
[(path? x) (path->string x)]
[(char? x) (format "~a" x)]
[else (error)])))) ; put this last so other xexprish things don't get caught
;; add a block tag to the list
;; this function is among the predicates because it alters a predicate globally.
@ -20,26 +33,26 @@
;; decoder wireframe
(define+provide/contract (decode nx
#:exclude-xexpr-tags [excluded-xexpr-tags '()]
#:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)]
#:xexpr-attrs-proc [xexpr-attrs-proc (λ(x)x)]
#:xexpr-elements-proc [xexpr-elements-proc (λ(x)x)]
#:block-xexpr-proc [block-xexpr-proc (λ(x)x)]
#:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
#:string-proc [string-proc (λ(x)x)])
#:exclude-xexpr-tags [excluded-xexpr-tags '()]
#:xexpr-tag-proc [xexpr-tag-proc (λ(x)x)]
#:xexpr-attrs-proc [xexpr-attrs-proc (λ(x)x)]
#:xexpr-elements-proc [xexpr-elements-proc (λ(x)x)]
#:block-xexpr-proc [block-xexpr-proc (λ(x)x)]
#:inline-xexpr-proc [inline-xexpr-proc (λ(x)x)]
#:string-proc [string-proc (λ(x)x)])
((xexpr/c) ;; use xexpr/c for contract on nx because it gives better error messages
;; todo: how to write more specific contracts for these procedures?
;; e.g., string-proc should be restricted to procs that accept a string as input
;; and return a string as output
(#:exclude-xexpr-tags list?
#:xexpr-tag-proc procedure?
#:xexpr-attrs-proc procedure?
#:xexpr-elements-proc procedure?
#:block-xexpr-proc procedure?
#:inline-xexpr-proc procedure?
#:string-proc procedure?)
. ->* . txexpr?)
;; todo: how to write more specific contracts for these procedures?
;; e.g., string-proc should be restricted to procs that accept a string as input
;; and return a string as output
(#:exclude-xexpr-tags list?
#:xexpr-tag-proc procedure?
#:xexpr-attrs-proc procedure?
#:xexpr-elements-proc procedure?
#:block-xexpr-proc procedure?
#:inline-xexpr-proc procedure?
#:string-proc procedure?)
. ->* . txexpr?)
(when (not (txexpr? nx))
(error (format "decode: ~v not a full txexpr" nx)))
@ -47,13 +60,13 @@
(define (&decode x)
(cond
[(txexpr? x) (let-values([(tag attr elements) (txexpr->values x)])
(if (tag . in? . excluded-xexpr-tags)
x ; let x pass through untouched
(let ([decoded-xexpr (apply make-txexpr
(map &decode (list tag attr elements)))])
((if (block-xexpr? decoded-xexpr)
block-xexpr-proc
inline-xexpr-proc) decoded-xexpr))))]
(if (tag . in? . excluded-xexpr-tags)
x ; let x pass through untouched
(let ([decoded-xexpr (apply make-txexpr
(map &decode (list tag attr elements)))])
((if (block-xexpr? decoded-xexpr)
block-xexpr-proc
inline-xexpr-proc) decoded-xexpr))))]
[(txexpr-tag? x) (xexpr-tag-proc x)]
[(txexpr-attrs? x) (xexpr-attrs-proc x)]
;; need this for operations that may depend on context in list
@ -171,23 +184,23 @@
(define two-or-more-char-string? (λ(i) (and (string? i) (>= (len i) 2))))
(define-values (tag attr elements) (txexpr->values nx))
(make-txexpr tag attr
(if (and (list? elements) (not (empty? elements)))
(let ([new-car-elements (match (car elements)
[(? two-or-more-char-string? tcs)
(define str-first (get tcs 0))
(define str-rest (get tcs 1 'end))
(cond
[(str-first . in? . '("\"" "“"))
;; can wrap with any inline tag
;; so that linebreak detection etc still works
`(,@double-pp ,(->string #\“) ,str-rest)]
[(str-first . in? . '("\'" "‘"))
`(,@single-pp ,(->string #\‘) ,str-rest)]
[else tcs])]
[(? txexpr? nx) (wrap-hanging-quotes nx)]
[else (car elements)])])
(cons new-car-elements (cdr elements)))
elements)))
(if (and (list? elements) (not (empty? elements)))
(let ([new-car-elements (match (car elements)
[(? two-or-more-char-string? tcs)
(define str-first (get tcs 0))
(define str-rest (get tcs 1 'end))
(cond
[(str-first . in? . '("\"" "“"))
;; can wrap with any inline tag
;; so that linebreak detection etc still works
`(,@double-pp ,(->string #\“) ,str-rest)]
[(str-first . in? . '("\'" "‘"))
`(,@single-pp ,(->string #\‘) ,str-rest)]
[else tcs])]
[(? txexpr? nx) (wrap-hanging-quotes nx)]
[else (car elements)])])
(cons new-car-elements (cdr elements)))
elements)))

2
lang/lang-helper.rkt
Unescape Escape View File

@ -5,6 +5,8 @@
(provide (all-defined-out) (all-from-out racket/contract/region))
(define-for-syntax (put-file-in-require-form file)
`(file ,(path->string file)))

41
main.rkt
Unescape Escape View File

@ -43,8 +43,7 @@
(cons `(meta "here" ,inner-here) meta-elements)))))
;; set up the 'main export
(require pollen/decode)
(require (only-in racket/list filter-not))
@ -53,25 +52,25 @@
;(print (cdr main-without-metas))
(define main (apply (cond
[(equal? here-ext "ptree") (λ xs (decode (cons 'ptree-root xs)
#:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))]
#:xexpr-elements-proc (λ(xs) (filter-not whitespace? xs))))]
;; 'root is the hook for the decoder function.
;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...)
[wants-decoder? root]
;; for preprocessor output, just make a string. Converts x-expressions to HTML.
[else (λ xs (apply string-append (map (dynamic-require 'xml 'xexpr->string) xs)))])
(cdr main-without-metas))) ;; cdr strips placeholder-root tag
;; derive 'here & 'here-path from the hash (because they might have been overridden in the source)
(define here (hash-ref metas "here"))
(define here-path (hash-ref metas "here-path"))
(provide metas main here here-path
;; hide the exports that were only for internal use.
(except-out (all-from-out 'inner) inner-here inner-here-path main-raw #%top))
;; for output in DrRacket
(module+ main
(if wants-decoder?
(print main)
(display main)))))
;; for preprocessor output, just make a string.
[else (λ xs (apply string-append (map to-string xs)))])
(cdr main-without-metas))) ;; cdr strips placeholder-root tag
;; derive 'here & 'here-path from the hash (because they might have been overridden in the source)
(define here (hash-ref metas "here"))
(define here-path (hash-ref metas "here-path"))
(provide metas main here here-path
;; hide the exports that were only for internal use.
(except-out (all-from-out 'inner) inner-here inner-here-path main-raw #%top))
;; for output in DrRacket
(module+ main
(if wants-decoder?
(print main)
(display main)))))

28
render.rkt
Unescape Escape View File

@ -233,10 +233,12 @@
(list
;; path based on template-name
(and template-name (build-path source-dir template-name))
;; path based on metas
(let ([source-metas (dynamic-require source-path 'metas)])
(and (TEMPLATE_META_KEY . in? . source-metas)
(build-path source-dir (get source-metas TEMPLATE_META_KEY))))
;; path based on metas. Need to parameterize a source file for it to find pollen-requires.
;; If you want standard behavior, requires can be declared explicitly.
(parameterize ([current-directory PROJECT_ROOT])
(let ([source-metas (dynamic-require source-path 'metas)])
(and (TEMPLATE_META_KEY . in? . source-metas)
(build-path source-dir (get source-metas TEMPLATE_META_KEY)))))
;; path using default template name =
;; "-main" + extension from output path (e.g. foo.xml.p -> -main.xml)
(build-path source-dir (add-ext DEFAULT_TEMPLATE_PREFIX (get-ext (->output-path source-path)))))))
@ -277,15 +279,17 @@
;; cache some modules inside this namespace so they can be shared by namespace for eval
;; todo: macrofy this to avoid repeating names
(require web-server/templates
(require web-server/templates
xml/path
racket/port
racket/file
racket/rerequire
racket/contract
racket/list
xml/path
pollen/debug
pollen/decode
pollen/file-tools
;; commented out so we don't get #%top in this file
; pollen/main-imports
; pollen/main-preproc-imports
pollen/predicates
pollen/ptree
sugar
@ -315,15 +319,15 @@
pollen/debug
pollen/decode
pollen/file-tools
; pollen/main-imports
; pollen/main-preproc-imports
pollen/predicates
pollen/ptree
sugar
pollen/template
pollen/tools
pollen/world))
pollen/world
pollen/project-requires))
(namespace-require 'racket/base) ; use namespace-require for FIRST require, then eval after
(eval eval-string (current-namespace))))
(define/contract (render-source-with-template source-path template-path)
@ -340,6 +344,8 @@
(define string-to-eval
`(begin
;; enables macrofication
(require (for-syntax racket/base))
;; for include-template (used below)
(require web-server/templates)
;; for ptree navigation functions, and template commands

Write Preview
Loading…
Cancel
Save