simplify main-helper

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")))))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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. 

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)

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)