haskal
/
capybara
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

use template to generate page

This commit is contained in:
xenia 2021-06-06 23:09:23 -04:00
parent 45f4f4f0ac
commit 1d9c60bb28
6 changed files with 57 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ext-mathml/main.rkt
View File

@ -5,7 +5,7 @@
(define-runtime-path *js-path* "./mathml-render.js")
(provide transform-xexprs get-styles)
(provide transform-xexprs scss-files)
(define (mathtex-type? s)
(and (string? s) (regexp-match #rx"^math/tex" s) #t))
@ -52,4 +52,4 @@
(cons tag (cons attrs (map transform-xexpr body)))]
[(? string? str) str]))
(define (get-styles) "")
(define scss-files '())

11
ext-syntax/css/syntax.scss
View File

@ -7,6 +7,17 @@ pre.highlight, .highlight {
color: $mono-1;
}
.highlighttable {
background: $syntax-gutter-background-color;
color: $syntax-gutter-text-color;
margin: 0.5em;
pre {
margin: 0;
}
}
.highlight {
pre { background: $syntax-bg; }
.hll { background: $syntax-bg; }

8
ext-syntax/main.rkt
View File

@ -1,12 +1,11 @@
#lang racket/base
(require racket/list racket/match racket/port racket/runtime-path racket/string
xml sass)
(require racket/list racket/match racket/port racket/runtime-path racket/string xml)
(define-runtime-path *python-path* "syntax-render.py")
(define-runtime-path *css-path* "css")
(provide transform-xexprs get-styles)
(provide transform-xexprs scss-files)
(define (brush-class? s)
(and (string? s) (regexp-match #rx"^brush:" s) #t))
@ -53,5 +52,4 @@
(cons tag (cons attrs (map transform-xexpr body)))]
[(? string? str) str]))
(define (get-styles)
(compile/file (build-path *css-path* "syntax.scss") #t))
(define scss-files (list (build-path *css-path* "syntax.scss")))

49
render.rkt
View File

@ -1,8 +1,10 @@
#lang racket
(require markdown markdown/display-xexpr markdown/toc
(prefix-in sass: sass)
(prefix-in mathml: "ext-mathml/main.rkt")
(prefix-in syntax: "ext-syntax/main.rkt"))
(prefix-in syntax: "ext-syntax/main.rkt")
(prefix-in article: "templates/article.html.rkt"))
(define metadata?
(listof (or/c
@ -39,41 +41,20 @@
(define output-cooked (mathml:transform-xexprs (syntax:transform-xexprs output-raw)))
(define output-toc (toc output-cooked))
(define styles (string-append (mathml:get-styles) (syntax:get-styles)))
(define scss-files (append mathml:scss-files syntax:scss-files))
(define top-level-style
(string-join (map (λ (x) (format "@import \"~a\";" (path->string x))) scss-files) "\n"))
(define styles (sass:compile/string top-level-style #t))
(define document
`(html
([lang "en"])
(head
()
,*banner*
(meta ([charset "utf-8"]))
(title () ,(metadata-ref+ md 'title "<untitled article>"))
(meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
,@(match (metadata-ref+ md 'summary)
[#f '()]
[summary
`((meta ([name "description"] [content ,summary])))])
,@(match (metadata-ref md 'authors)
[(or #f '()) '()]
[authors
`((meta ([name "author"] [content ,(string-join authors ", ")])))])
,@(match (metadata-ref md 'date)
[#f '()]
[(list y m d)
`((meta ([name "DC.Date.created"] [content ,(format "~a-~a~a" y m d)])))])
(meta ([name "generator"] [content "meow meow meow meow"]))
;<link rel="shortcut icon" type="image/png" href="haskal.png"/>
(style ([type "text/css"]) ,styles))
(body
()
(nav
()
,output-toc)
(main
()
,@output-cooked)
,*mathjax-placeholder*)))
(article:execute (hash 'metadata-ref metadata-ref
'metadata-ref+ metadata-ref+
'*banner* *banner*
'*mathjax-placeholder* *mathjax-placeholder*
'metadata md
'page-styles styles
'content-toc output-toc
'content output-cooked)))
(with-output-to-string (λ () (display "<!doctype html>") (display-xexpr document))))

22
templates/article.html.rkt
View File

@ -6,29 +6,33 @@
()
,*banner*
(meta ([charset "utf-8"]))
(title () ,(metadata-ref+ md 'title "<untitled article>"))
(title () ,(metadata-ref+ metadata 'title "<untitled article>"))
(meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
,@(match (metadata-ref+ md 'summary)
,@(match (metadata-ref+ metadata 'summary)
[#f '()]
[summary
`((meta ([name "description"] [content ,summary])))])
,@(match (metadata-ref md 'authors)
,@(match (metadata-ref metadata 'authors)
[(or #f '()) '()]
[authors
`((meta ([name "author"] [content ,(string-join authors ", ")])))])
,@(match (metadata-ref md 'date)
,@(match (metadata-ref metadata 'date)
[#f '()]
[(list y m d)
`((meta ([name "DC.Date.created"] [content ,(format "~a-~a~a" y m d)])))])
[(list yn mn dn)
`((meta ([name "DC.Date.created"]
[content ,(format "~a-~a-~a"
(~r yn #:min-width 4 #:pad-string "0")
(~r mn #:min-width 2 #:pad-string "0")
(~r dn #:min-width 2 #:pad-string "0"))])))])
(meta ([name "generator"] [content "meow meow meow meow"]))
;<link rel="shortcut icon" type="image/png" href="haskal.png"/>
(style ([type "text/css"]) ,styles))
(style ([type "text/css"]) ,page-styles))
(body
()
(nav
()
,output-toc)
,content-toc)
(main
()
,@output-cooked)
,@content)
,*mathjax-placeholder*))

20
xtemplate.rkt
View File

@ -1,12 +1,12 @@
#lang racket/base
(require racket/base racket/list racket/match racket/string
(require racket/base racket/format racket/list racket/match racket/string
syntax/parse syntax/parse/define
(for-syntax racket/base racket/match racket/set))
(provide (rename-out [x:#%module-begin #%module-begin]
[x:#%top #%top])
(except-out (all-from-out racket/base racket/list racket/match racket/string)
(except-out (all-from-out racket/base racket/format racket/list racket/match racket/string)
#%module-begin #%top))
(define-for-syntax *unbound-prop* 'xtemplate:unbound)
@ -28,10 +28,16 @@
(define-syntax-parse-rule (x:#%module-begin body)
#:with #%template-args (datum->syntax #'body '#%template-args)
#:with execute-fn #'(λ (#%template-args) body)
#:with expanded-execute-fn (local-expand #'execute-fn (syntax-local-context) '())
#:with (unbound-ids ...)
(map (λ (stx) #`(quote #,stx)) (set->list (collect-unbounds #'expanded-execute-fn)))
#:with expanded-execute-fn #'execute-fn
; #:with expanded-execute-fn (begin
; (displayln "expanding!")
; (local-expand #'execute-fn (syntax-local-context) '()))
; #:with (unbound-ids ...)
; (begin
; (displayln "collecting unbounds")
; (map (λ (stx) #`(quote #,stx)) (set->list (collect-unbounds #'expanded-execute-fn))))
(#%module-begin
(provide execute required-ids)
(define required-ids (list unbound-ids ...))
;(provide required-ids)
;(define required-ids (list unbound-ids ...))
(provide execute)
(define execute expanded-execute-fn)))