From da689e4a51a5636807f81fc9a5dca2255c0e8bee Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 17 Mar 2014 18:21:48 -0700 Subject: [PATCH] modularize langs --- lang/reader.rkt | 2 +- main-base.rkt | 101 +++++++++++++++++++++++++++++++++++++++ main.rkt | 91 +---------------------------------- markdown.rkt | 8 ++++ markdown/lang/reader.rkt | 2 +- markup.rkt | 8 ++++ markup/lang/reader.rkt | 2 +- pagetree/lang/reader.rkt | 2 +- pre.rkt | 8 +++- pre/lang/reader.rkt | 2 +- ptree.rkt | 8 ++++ tests/test-langs.rkt | 56 ++++++++++++++++++++++ world.rkt | 10 ++-- 13 files changed, 199 insertions(+), 101 deletions(-) create mode 100644 main-base.rkt create mode 100644 markdown.rkt create mode 100644 markup.rkt create mode 100644 ptree.rkt create mode 100644 tests/test-langs.rkt diff --git a/lang/reader.rkt b/lang/reader.rkt index fbd8d7e..33a2153 100644 --- a/lang/reader.rkt +++ b/lang/reader.rkt @@ -1,4 +1,4 @@ #lang racket/base (require pollen/lang/reader-base) -(make-reader-with-mode world:reader-mode-auto) \ No newline at end of file +(make-reader-with-mode world:mode-auto) \ No newline at end of file diff --git a/main-base.rkt b/main-base.rkt new file mode 100644 index 0000000..0bdb9b2 --- /dev/null +++ b/main-base.rkt @@ -0,0 +1,101 @@ +#lang racket/base +(require (for-syntax racket/base racket/syntax) "world.rkt") + +(provide (all-defined-out) (all-from-out "world.rkt")) + +(define-syntax (make-new-module-begin stx) + (syntax-case stx () + [(_ mode-arg) + (with-syntax ([new-module-begin (format-id stx "new-module-begin")]) + #`(define-syntax (new-module-begin stx-arg) + (syntax-case stx-arg () + [(_ body-exprs (... ...)) + (syntax-protect + #`(#%module-begin + (module inner pollen/lang/doclang-raw + ;; doclang_raw is a version of scribble/doclang with the decoder disabled + ;; first three lines are positional arguments for doclang-raw + doc-raw ; id of export + (λ(x) x) ; post-process function + () ; prepended exprs + + ;; Change behavior of undefined identifiers with #%top + ;; Get project values from world + (require pollen/top pollen/world) + (provide (all-from-out pollen/top pollen/world)) + + ;; for anything defined in pollen source file + (provide (all-defined-out)) + + body-exprs (... ...)) + + (require 'inner) + + + ;; if reader-here-path is undefined, it will become a proc courtesy of #%top + ;; therefore that's how we can detect if it's undefined + (define here-path (if (procedure? reader-here-path) "anonymous-module" reader-here-path)) + + + ;; set the parser mode based on reader mode + ;; todo: this won't work with inline submodules + (define parser-mode + (if (not (procedure? reader-mode)) + (if (equal? reader-mode world:mode-auto) + (let* ([file-ext-pattern (pregexp "\\w+$")] + [here-ext (string->symbol (car (regexp-match file-ext-pattern here-path)))]) + (cond + [(equal? here-ext world:pagetree-source-ext) world:mode-pagetree] + [(equal? here-ext world:markup-source-ext) world:mode-markup] + [(equal? here-ext world:markdown-source-ext) world:mode-markdown] + [else world:mode-preproc])) + reader-mode) + mode-arg)) + + + ;; Split out the metas. + (require txexpr) + (define (split-metas-to-hash tx) ; helper function + ;; return tx without metas, and meta hash + (define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x))))) + (define-values (doc-without-metas meta-elements) + (splitf-txexpr tx is-meta-element?)) + (define meta-element->assoc (λ(x) (let ([key (car (caadr x))][value (cadr (caadr x))]) (cons key value)))) + (define metas (make-hash (map meta-element->assoc meta-elements))) + (values doc-without-metas metas)) + + + (define doc-txexpr + (let ([doc-raw (if (equal? parser-mode world:mode-markdown) + (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw) + doc-raw)]) + `(placeholder-root + ,@(cons (meta 'here-path: here-path) + ;; cdr strips initial linebreak, but make sure doc-raw isn't blank + (if (and (list? doc-raw) (> 0 (length doc-raw))) (cdr doc-raw) doc-raw))))) + + (define-values (doc-without-metas metas) (split-metas-to-hash doc-txexpr)) + + + ;; set up the 'doc export + (require pollen/decode) + (define doc (apply (cond + [(equal? parser-mode world:mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))] + ;; 'root is the hook for the decoder function. + ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) + [(or (equal? parser-mode world:mode-markup) + (equal? parser-mode world:mode-markdown)) root] + ;; for preprocessor output, just make a string. + [else (λ xs (apply string-append (map to-string xs)))]) + (cdr doc-without-metas))) ;; cdr strips placeholder-root tag + + + (provide metas doc + ;; hide the exports that were only for internal use. + (except-out (all-from-out 'inner) doc-raw #%top)) + + ;; for output in DrRacket + (module+ main + (if (equal? parser-mode world:mode-preproc) + (display doc) + (print doc)))))])))])) diff --git a/main.rkt b/main.rkt index a5b6d6e..7a22dde 100644 --- a/main.rkt +++ b/main.rkt @@ -1,95 +1,8 @@ #lang racket/base (require (for-syntax racket/base)) +(require "main-base.rkt") (provide (except-out (all-from-out racket/base) #%module-begin) (rename-out [new-module-begin #%module-begin])) - -(define-syntax (new-module-begin stx) - (syntax-case stx () - [(_ body-exprs ...) - (syntax-protect - #`(#%module-begin - (module inner pollen/lang/doclang-raw - ;; doclang_raw is a version of scribble/doclang with the decoder disabled - ;; first three lines are positional arguments for doclang-raw - doc-raw ; id of export - (λ(x) x) ; post-process function - () ; prepended exprs - - ;; Change behavior of undefined identifiers with #%top - ;; Get project values from world - (require pollen/top pollen/world) - (provide (all-from-out pollen/top pollen/world)) - - ;; for anything defined in pollen source file - (provide (all-defined-out)) - - body-exprs ...) - - (require 'inner) - - - ;; if reader-here-path is undefined, it will become a proc courtesy of #%top - ;; therefore that's how we can detect if it's undefined - (define here-path (if (procedure? reader-here-path) "anonymous-module" reader-here-path)) - - ;; set the parser mode based on reader mode - ;; todo: this won't work with inline submodules - (define parser-mode (if (equal? reader-mode world:reader-mode-auto) - (let* ([file-ext-pattern (pregexp "\\w+$")] - [here-ext (string->symbol (car (regexp-match file-ext-pattern here-path)))]) - (cond - [(equal? here-ext world:pagetree-source-ext) world:reader-mode-pagetree] - [(equal? here-ext world:markup-source-ext) world:reader-mode-markup] - [(equal? here-ext world:markdown-source-ext) world:reader-mode-markdown] - [else world:reader-mode-preproc])) - reader-mode)) - - - ;; Split out the metas. - (require txexpr) - (define (split-metas-to-hash tx) ; helper function - ;; return tx without metas, and meta hash - (define is-meta-element? (λ(x) (and (txexpr? x) (equal? 'meta (car x))))) - (define-values (doc-without-metas meta-elements) - (splitf-txexpr tx is-meta-element?)) - (define meta-element->assoc (λ(x) (let ([key (car (caadr x))][value (cadr (caadr x))]) (cons key value)))) - (define metas (make-hash (map meta-element->assoc meta-elements))) - (values doc-without-metas metas)) - - - (define doc-txexpr - (let ([doc-raw (if (equal? parser-mode world:reader-mode-markdown) - (apply (compose1 (dynamic-require 'markdown 'parse-markdown) string-append) doc-raw) - doc-raw)]) - `(placeholder-root - ,@(cons (meta 'here-path: here-path) - ;; cdr strips initial linebreak, but make sure doc-raw isn't blank - (if (and (list? doc-raw) (> 0 (length doc-raw))) (cdr doc-raw) doc-raw))))) - - (define-values (doc-without-metas metas) (split-metas-to-hash doc-txexpr)) - - - ;; set up the 'doc export - (require pollen/decode) - (define doc (apply (cond - [(equal? parser-mode world:reader-mode-pagetree) (λ xs ((dynamic-require 'pollen/pagetree 'decode-pagetree) xs))] - ;; 'root is the hook for the decoder function. - ;; If it's not a defined identifier, it just hits #%top and becomes `(root ,@body ...) - [(or (equal? parser-mode world:reader-mode-markup) - (equal? parser-mode world:reader-mode-markdown)) root] - ;; for preprocessor output, just make a string. - [else (λ xs (apply string-append (map to-string xs)))]) - (cdr doc-without-metas))) ;; cdr strips placeholder-root tag - - - (provide metas doc - ;; hide the exports that were only for internal use. - (except-out (all-from-out 'inner) doc-raw #%top)) - - ;; for output in DrRacket - (module+ main - (if (equal? parser-mode world:reader-mode-preproc) - (display doc) - (print doc)))))])) +(make-new-module-begin world:mode-preproc) \ No newline at end of file diff --git a/markdown.rkt b/markdown.rkt new file mode 100644 index 0000000..a16dbdf --- /dev/null +++ b/markdown.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require (for-syntax racket/base)) +(require "main-base.rkt") + +(provide (except-out (all-from-out racket/base) #%module-begin) + (rename-out [new-module-begin #%module-begin])) + +(make-new-module-begin world:mode-markdown) \ No newline at end of file diff --git a/markdown/lang/reader.rkt b/markdown/lang/reader.rkt index 8a8016d..ed9bb65 100644 --- a/markdown/lang/reader.rkt +++ b/markdown/lang/reader.rkt @@ -1,4 +1,4 @@ #lang racket/base (require pollen/lang/reader-base) -(make-reader-with-mode world:reader-mode-markdown) \ No newline at end of file +(make-reader-with-mode world:mode-markdown) \ No newline at end of file diff --git a/markup.rkt b/markup.rkt new file mode 100644 index 0000000..860ca27 --- /dev/null +++ b/markup.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require (for-syntax racket/base)) +(require "main-base.rkt") + +(provide (except-out (all-from-out racket/base) #%module-begin) + (rename-out [new-module-begin #%module-begin])) + +(make-new-module-begin world:mode-markup) \ No newline at end of file diff --git a/markup/lang/reader.rkt b/markup/lang/reader.rkt index bec56aa..5a9abe4 100644 --- a/markup/lang/reader.rkt +++ b/markup/lang/reader.rkt @@ -1,4 +1,4 @@ #lang racket/base (require pollen/lang/reader-base) -(make-reader-with-mode world:reader-mode-markup) \ No newline at end of file +(make-reader-with-mode world:mode-markup) \ No newline at end of file diff --git a/pagetree/lang/reader.rkt b/pagetree/lang/reader.rkt index cf16d87..32c175d 100644 --- a/pagetree/lang/reader.rkt +++ b/pagetree/lang/reader.rkt @@ -1,4 +1,4 @@ #lang racket/base (require pollen/lang/reader-base) -(make-reader-with-mode world:reader-mode-pagetree) \ No newline at end of file +(make-reader-with-mode world:mode-pagetree) \ No newline at end of file diff --git a/pre.rkt b/pre.rkt index 2152b83..7a22dde 100644 --- a/pre.rkt +++ b/pre.rkt @@ -1,4 +1,8 @@ #lang racket/base +(require (for-syntax racket/base)) +(require "main-base.rkt") -(require "main.rkt") -(provide (all-from-out "main.rkt")) \ No newline at end of file +(provide (except-out (all-from-out racket/base) #%module-begin) + (rename-out [new-module-begin #%module-begin])) + +(make-new-module-begin world:mode-preproc) \ No newline at end of file diff --git a/pre/lang/reader.rkt b/pre/lang/reader.rkt index de2c5ad..38223cd 100644 --- a/pre/lang/reader.rkt +++ b/pre/lang/reader.rkt @@ -1,4 +1,4 @@ #lang racket/base (require pollen/lang/reader-base) -(make-reader-with-mode world:reader-mode-preproc) \ No newline at end of file +(make-reader-with-mode world:mode-preproc) \ No newline at end of file diff --git a/ptree.rkt b/ptree.rkt new file mode 100644 index 0000000..f88cff5 --- /dev/null +++ b/ptree.rkt @@ -0,0 +1,8 @@ +#lang racket/base +(require (for-syntax racket/base)) +(require "main-base.rkt") + +(provide (except-out (all-from-out racket/base) #%module-begin) + (rename-out [new-module-begin #%module-begin])) + +(make-new-module-begin world:mode-pagetree) \ No newline at end of file diff --git a/tests/test-langs.rkt b/tests/test-langs.rkt new file mode 100644 index 0000000..7073b41 --- /dev/null +++ b/tests/test-langs.rkt @@ -0,0 +1,56 @@ +#lang racket/base + + + +(module test-default pollen + "hello world") + +(require (prefix-in default: 'test-default)) + +default:doc ; should be "hello world" + + +(module test-pre pollen/pre + "hello world") + +(require (prefix-in pre: 'test-pre)) + +pre:doc ; should be "hello world" + + +(module test-markup pollen/markup + "hello world") + +(require (prefix-in markup: 'test-markup)) + +markup:doc ; should be '(root "hello world") + +(module test-markdown pollen/markdown + "hello world") + +(require (prefix-in markdown: 'test-markdown)) + +markdown:doc ; should be '(root (p "hello world")) + + +(module test-ptree pollen/ptree + '(index (brother sister))) + +(require (prefix-in ptree: 'test-ptree)) + +ptree:doc ; should be '(pagetree-root (index (brother sister))) + + +(begin + (require racket/rerequire) + (dynamic-rerequire (string->path "/Users/mb/git/bpt/test.html.pm") #:verbosity 'reload) + (dynamic-require (string->path "/Users/mb/git/bpt/test.html.pm") 'doc)) + + + +(eval + '(begin + (require racket/rerequire) + (dynamic-rerequire (string->path "/Users/mb/git/bpt/test.html.pm") #:verbosity 'reload) + (dynamic-require (string->path "/Users/mb/git/bpt/test.html.pm") 'doc)) (make-base-namespace)) + diff --git a/world.rkt b/world.rkt index da9bc45..f2292b9 100644 --- a/world.rkt +++ b/world.rkt @@ -13,11 +13,11 @@ (define scribble-source-ext 'scrbl) -(define reader-mode-auto 'auto) -(define reader-mode-preproc 'pre) -(define reader-mode-markup 'markup) -(define reader-mode-markdown 'markdown) -(define reader-mode-pagetree 'ptree) +(define mode-auto 'auto) +(define mode-preproc 'pre) +(define mode-markup 'markup) +(define mode-markdown 'markdown) +(define mode-pagetree 'ptree) (define decodable-extensions (list markup-source-ext pagetree-source-ext))