diff --git a/fetch-util.rkt b/fetch-util.rkt index 569fc64..0cce3fe 100644 --- a/fetch-util.rkt +++ b/fetch-util.rkt @@ -36,9 +36,9 @@ [(? string?) sxml] ['(& nbsp) "\u00a0"] [(list '& _) (error "unhandled &-code" sxml)] - [(list tag (cons '@ attrs) body ...) + [(list (? symbol? tag) (cons '@ attrs) body ...) (cons tag (cons (map sxml-attr->xexpr-attr attrs) (map sxml->xexpr body)))] - [(list tag body ...) + [(list (? symbol? tag) body ...) (cons tag (cons '() (map sxml->xexpr body)))])) (define (check-xexpr x) diff --git a/fetch.rkt b/fetch.rkt index 74cb5a0..7615a4a 100644 --- a/fetch.rkt +++ b/fetch.rkt @@ -94,7 +94,7 @@ (define filtered (filter (λ (x) (not (eq? (first x) 'href))) attrs)) (apply list 'a (cons (list 'href (url->string (combine-url/relative base href))) filtered) (map (curry transform-links base) body))])] - [(list tag attrs body ...) + [(list (? symbol? tag) attrs body ...) (apply list tag attrs (map (curry transform-links base) body))] [(? string?) xexpr])) diff --git a/info.rkt b/info.rkt index 5e37ba9..6f8da59 100644 --- a/info.rkt +++ b/info.rkt @@ -12,13 +12,17 @@ ; (define compile-omit-paths '("something")) ; (define scribblings '(("scribblings/capybara.scrbl" ()))) -(define racket-launcher-names '("capybara-render")) -(define racket-launcher-libraries '("render")) +(define racket-launcher-names '("capybara-render" "capybara-init")) +(define racket-launcher-libraries '("render" "init")) (define raco-commands - '(("capybara" + '(("capybara-render" (submod capybara/render main) - "run capybara" + "run capybara-render" + #f) + ("capybara-init" + (submod capybara/init main) + "run capybara-init" #f) ("capybara-fasl" (submod capybara/fasl-reader main) diff --git a/init.rkt b/init.rkt new file mode 100644 index 0000000..6dfcfc0 --- /dev/null +++ b/init.rkt @@ -0,0 +1,47 @@ +#lang racket/base + +(require racket/file racket/path racket/pretty + "compiler.rkt" "render.rkt" "util.rkt") + +(provide init-project) + +(define (init-project name [dir (build-path (current-directory) name)]) + (when (directory-exists? dir) + (error "directory already exists!" (path->string dir))) + (define src (simple-form-path (build-path dir "src"))) + (define target (simple-form-path (build-path dir "target"))) + (make-directory* src) + (with-output-to-file + (build-path src "index.md") + (λ () + (pretty-write + (list (list 'title name) + (list 'summary "a cool site") + (apply list 'date (get-date-ymd)) + (list 'tags "tag1" "tag2") + (list 'lang "en") + (list 'authors "you"))) + (write-string "\n# trans rights\n\nmeow"))) + (with-output-to-file + (build-path src "index.scss") + (λ () (write-string "/* your cool SCSS goes here */"))) + (with-output-to-file + (build-path src "favicon.png.rkt") + (λ () (write-string "#lang capybara/pict\n\n(standard-cat 128 128)"))) + (with-output-to-file + (build-path src "config.rktd") + (λ () (pretty-write (list (list 'base (path->string target)))))) + + (parameterize ([current-directory dir]) + (generate/execute (scan-for-rules))) + + (void)) + +(module+ main + (require racket/cmdline) + (command-line + #:program "capybara-init" + #:args (name) + (with-handlers ([exn? (λ (e) (printf "error: ~a\n" (exn-message e)))]) + (init-project name) + (printf "created project ~a\n" name)))) diff --git a/pict.rkt b/pict.rkt index 0edec1e..cea7b8c 100644 --- a/pict.rkt +++ b/pict.rkt @@ -2,10 +2,11 @@ (require racket/base racket/contract syntax/parse/define syntax/wrap-modbeg (for-syntax racket/base) - racket/draw pict ppict/2) + racket/draw pict ppict/pict ppict/tag ppict/align) (provide (rename-out [x:#%module-begin #%module-begin]) - (except-out (all-from-out racket/base racket/contract racket/draw pict ppict/2) + (except-out (all-from-out racket/base racket/contract racket/draw pict + ppict/pict ppict/tag ppict/align) #%module-begin)) (define-syntax x:#%module-begin diff --git a/render.rkt b/render.rkt index 612e027..3471890 100644 --- a/render.rkt +++ b/render.rkt @@ -10,6 +10,8 @@ (prefix-in syntax: "ext-syntax/main.rkt") (prefix-in page: "templates/page.html.rkt")) +(provide scan-for-rules) + (struct input-doc [metadata xref-name text] #:transparent) (struct ir-doc [metadata xref-name html] #:prefab) @@ -39,7 +41,7 @@ ;; do not descend into other special tags [(list (or 'code 'math 'tech 'deftech 'masto 'user 'xref) attrs children ...) (list xexpr)] ;; recursive - [(list tag attrs children ...) + [(list (? symbol? tag) attrs children ...) (list (cons tag (cons attrs (apply append (map (lambda (child) (process+ child)) children)))))] @@ -69,7 +71,7 @@ (define target (substring value 1)) `(,tag-name ([target ,target]) ,@(map extract-prefixed-links+ body))] [_ (apply list 'a attrs (map extract-prefixed-links+ body))])] - [(list tag attrs children ...) + [(list (? symbol? tag) attrs children ...) (apply list tag attrs (map extract-prefixed-links+ children))] [(? string? str) str])) (extract-prefixed-links+ xexpr)) @@ -92,7 +94,7 @@ (error "invalid xref!" target)) (apply list 'xref (list (list 'target (path->string abs-target))) (map check-xrefs-help body))] - [(list tag attrs body ...) + [(list (? symbol? tag) attrs body ...) (cons tag (cons attrs (map check-xrefs-help body)))] [(? string?) xexpr])) (map check-xrefs-help xexprs)) @@ -135,10 +137,10 @@ [(list 'p _ (list 'masto _ (? string? url))) (masto-fetch-embed url)] ;; everything else - [(list tag attrs children ...) + [(list (? symbol? tag) attrs children ...) (apply list tag attrs (map lower-specials* children))] [(? string? str) str])) - (lower-specials* xexpr)) + (map lower-specials* xexpr)) (define (ir-doc->page doc site-config) (match-define (ir-doc md xref-name content) doc) @@ -172,7 +174,7 @@ [in (build-path src-dir "index.scss")]) (~> (compile-index-scss (port->string in)) (write-string out))) - (define favicon.rkt (build-path src-dir "favicon.rkt")) + (define favicon.rkt (build-path src-dir "favicon.png.rkt")) (define-rule (favicon [out (build-path output-dir "favicon.png")] [in favicon.rkt]) (define icon-pict (dynamic-require favicon.rkt 'icon-pict)) diff --git a/util.rkt b/util.rkt index cb195f7..9389b0e 100644 --- a/util.rkt +++ b/util.rkt @@ -1,8 +1,12 @@ #lang racket/base -(require racket/format racket/string racket/port) +(require racket/date racket/format racket/string racket/port) -(provide ~r/pad run-external) +(provide ~r/pad run-external get-date-ymd) + +(define (get-date-ymd) + (define date (current-date)) + (list (date-year date) (date-month date) (date-day date))) (define (~r/pad num pad-to) (~r num #:min-width pad-to #:pad-string "0"))