diff --git a/library/decode-tools.rkt b/library/decode-tools.rkt index f6e4065..c397b5b 100644 --- a/library/decode-tools.rkt +++ b/library/decode-tools.rkt @@ -108,31 +108,36 @@ #:single-prepend [single-pp '(squo)] #:double-prepend [double-pp '(dquo)]) ((tagged-xexpr?) (#:single-prepend list? #:double-prepend list?) . ->* . tagged-xexpr?) - (define two-char-string? (λ(i) (and (string? i) (>= (len i) 2)))) + (define two-or-more-char-string? (λ(i) (and (string? i) (>= (len i) 2)))) (define-values (tag attr elements) (break-tagged-xexpr nx)) - (define new-car-elements - (match (car elements) - [(? two-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])] - [(? tagged-xexpr? nx) (wrap-hanging-quotes nx)] - [else (car elements)])) - (make-tagged-xexpr tag attr (cons new-car-elements (cdr elements)))) + (make-tagged-xexpr 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])] + [(? tagged-xexpr? nx) (wrap-hanging-quotes nx)] + [else (car elements)])]) + (cons new-car-elements (cdr elements))) + elements))) + (module+ test (check-equal? (wrap-hanging-quotes '(p "\"Hi\" there")) '(p (dquo "“" "Hi\" there"))) (check-equal? (wrap-hanging-quotes '(p "'Hi' there")) '(p (squo "‘" "Hi' there"))) (check-equal? (wrap-hanging-quotes '(p "'Hi' there") #:single-prepend '(foo ((bar "ino")))) - '(p (foo ((bar "ino")) "‘" "Hi' there")))) + '(p (foo ((bar "ino")) "‘" "Hi' there"))) + ;; make sure tagged-xexpr without elements passes through unscathed + (check-equal? (wrap-hanging-quotes '(div ((style "height:2em")))) '(div ((style "height:2em"))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/main-helper.rkt b/main-helper.rkt index 2b2caef..362d37a 100644 --- a/main-helper.rkt +++ b/main-helper.rkt @@ -10,43 +10,27 @@ (module+ test (require rackunit)) -;; use define-for-syntax because this function supports -;; the two syntax transformers below -(define-for-syntax (make-files-in-require-form file-directory) - ;; This will be resolved in the context of current-directory. - ;; So when called from outside the project directory, - ;; current-directory must be properly set with 'parameterize' - (define (insert-directory-into-path path) - ;; todo: document why this function is necessary (it definitely is, but I forgot why) - (define-values (start_dir name _ignore) (split-path (path->complete-path path))) - (build-path start_dir file-directory name)) - (define files (map insert-directory-into-path (filter (λ(i) (has-ext? i 'rkt)) (directory-list file-directory)))) - ; this puts files in require form - (map (λ(file) `(file ,(->string file))) files)) - +(define-for-syntax (put-file-in-require-form file) + `(file ,(->string file))) -;; Look for an EXTRAS_DIR directory local to the source file. -;; and require all the .rkt files therein. -;; optionally provide them. - -(define-syntax (require-and-provide-extras stx) - (cond - [(directory-exists? EXTRAS_DIR) - (let ([files-in-require-form (make-files-in-require-form EXTRAS_DIR)]) +(define-syntax (require-and-provide-extras stx) + (define project-require-files (get-project-require-files)) + (if project-require-files + (let ([files-in-require-form (map put-file-in-require-form project-require-files)]) (datum->syntax stx `(begin (require ,@files-in-require-form) - (provide (all-from-out ,@files-in-require-form)))))] + (provide (all-from-out ,@files-in-require-form))))) ; if no files to import, do nothing - [else #'(begin)])) + #'(begin))) -(define-syntax (require-extras stx) - (cond - [(directory-exists? EXTRAS_DIR) - (let ([files-in-require-form (make-files-in-require-form EXTRAS_DIR)]) +(define-syntax (require-extras stx) + (define project-require-files (get-project-require-files)) + (if project-require-files + (let ([files-in-require-form (map put-file-in-require-form project-require-files)]) (datum->syntax stx `(begin - (require ,@files-in-require-form))))] + (require ,@files-in-require-form)))) ; if no files to import, do nothing - [else #'(begin)])) + #'(begin))) ;; here = path of this file, relative to current directory. diff --git a/regenerate.rkt b/regenerate.rkt index 741294c..350a5bd 100644 --- a/regenerate.rkt +++ b/regenerate.rkt @@ -36,7 +36,11 @@ ;; therefore, use function by just listing out the paths (define/contract (store-refresh-in-mod-dates . rest-paths) (() #:rest (listof path?) . ->* . void?) - (hash-set! mod-dates rest-paths (map path->mod-date-value rest-paths))) + (report (current-directory)) + ;; todo next: make this work + (let* ([project-require-files (or (get-project-require-files) empty)] + [all-files-used-in-key (append rest-paths project-require-files)]) + (hash-set! mod-dates (report all-files-used-in-key) (map path->mod-date-value all-files-used-in-key)))) (module+ test (reset-mod-dates) diff --git a/tools.rkt b/tools.rkt index 28d7087..ccaf20e 100644 --- a/tools.rkt +++ b/tools.rkt @@ -5,7 +5,7 @@ (require (only-in racket/string string-join)) (require (only-in xml xexpr? xexpr/c)) -(require "readability.rkt" "debug.rkt" "predicates.rkt") +(require "readability.rkt" "debug.rkt" "predicates.rkt" "world.rkt") (provide (all-defined-out) (all-from-out "readability.rkt" "debug.rkt" "predicates.rkt")) ;; setup for test cases @@ -13,6 +13,18 @@ +;; list of all eligible requires in project require directory +;; assumes current working directory is project directory +;; either for real, or via parameterize +;; todo: is it possible to check this via contract? +;; I don't think so: not possible to know ex ante whether you're in a project folder +(define (get-project-require-files) + (and (directory-exists? EXTRAS_DIR) + ;; todo: allow more than just .rkt files? + (let ([files (filter (λ(i) (has-ext? i 'rkt)) (directory-list EXTRAS_DIR #:build? #t))]) + (and (not (empty? files)) files)))) + + ;; helper for comparison of values ;; normal function won't work for this. Has to be syntax-rule (define-syntax-rule (values->list vs)