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

meow

This commit is contained in:
xenia 2021-06-10 18:48:29 -04:00
parent 1116e9fc9c
commit 50ca84d515
2 changed files with 44 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler.rkt
View File

@ -123,10 +123,11 @@
(thread-wait (thread-wait
(thread (thread
(λ () (λ ()
(call-with-atomic-output-file (make-parent-directory* out)
out (call-with-atomic-output-file
(λ (out-port tmp-path) out
(apply func out-port (map open-input-file ins)))))))) (λ (out-port tmp-path)
(apply func out-port (map open-input-file ins))))))))
(custodian-shutdown-all cust)) (custodian-shutdown-all cust))
;; Runs an ordered operations list ;; Runs an ordered operations list

48
render.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require racket/list racket/match racket/port racket/pretty racket/set racket/string (require racket/fasl racket/list racket/match racket/port racket/path racket/set racket/string
racket/runtime-path racket/runtime-path
markdown markdown/display-xexpr markdown/toc markdown markdown/display-xexpr markdown/toc
"compiler.rkt" "defs.rkt" "fetch.rkt" "compiler.rkt" "defs.rkt" "fetch.rkt"
@ -11,7 +11,7 @@
(prefix-in page: "templates/page.html.rkt")) (prefix-in page: "templates/page.html.rkt"))
(struct input-doc [metadata text] #:transparent) (struct input-doc [metadata text] #:transparent)
(struct ir-doc [metadata html] #:transparent) (struct ir-doc [metadata html] #:prefab)
(define-runtime-path *render.scss* "render.scss") (define-runtime-path *render.scss* "render.scss")
@ -104,7 +104,7 @@
[(list 'tech (list (list 'key key)) (? string? body)) [(list 'tech (list (list 'key key)) (? string? body))
`(a ([class "tech"] [href ,(format "~a/tech/~a" base-url key)]) ,body)] `(a ([class "tech"] [href ,(format "~a/tech/~a" base-url key)]) ,body)]
;; masto ;; masto
;; TODO ;; TODO make this not janky
[(list 'p _ (list 'masto _ (? string? url))) [(list 'p _ (list 'masto _ (? string? url)))
(masto-fetch-embed url)] (masto-fetch-embed url)]
;; everything else ;; everything else
@ -134,13 +134,43 @@
"\n")) "\n"))
(sass:compile/string top-level-style #t)) (sass:compile/string top-level-style #t))
(define (scan-for-rules [output-dir (build-path "target")]
[build-dir (build-path "build")]
[src-dir (build-path "src")])
(define-rule (scss [out (build-path output-dir "index.css")]
[in (build-path src-dir "index.scss")])
(~> (compile-index-scss (port->string in)) (write-string out)))
(struct rule-spec [src intermediate output] #:transparent)
(define rule-specs
(parameterize ([current-directory src-dir])
(for/list ([md-file (in-directory #f)]
#:when (bytes=? (path-get-extension md-file) #".md"))
(define fasl-file (path-replace-extension md-file #".fasl"))
(define out-file (path-replace-extension md-file #".html"))
(rule-spec (build-path src-dir md-file)
(build-path build-dir fasl-file)
(build-path output-dir out-file)))))
(define intermediate-rules
(for/list ([spec (in-list rule-specs)])
(define-rule (intermediate-rule [out (rule-spec-intermediate spec)]
[in (rule-spec-src spec)])
(~> (read-input-doc in) input-doc->ir-doc s-exp->fasl (write-bytes out)))
intermediate-rule))
(define output-rules
(for/list ([spec (in-list rule-specs)])
(define-rule (output-rule [out (rule-spec-output spec)]
[in (rule-spec-intermediate spec)])
(~> (port->bytes in) fasl->s-exp ir-doc->page (write-string out)))
output-rule))
(append intermediate-rules output-rules (list scss)))
(module+ main (module+ main
(require racket/cmdline) (require racket/cmdline)
(command-line (command-line
#:program "meow" #:program "meow"
#:args (infile outfile) #:args ()
(define-rule (scss [out "index.css"] [in "index.scss"]) (generate/execute (scan-for-rules))))
(~> (compile-index-scss (port->string in)) (write-string out)))
(define-rule (render [out outfile] [in infile])
(~> (read-input-doc in) input-doc->ir-doc ir-doc->page (write-string out)))
(generate/execute (list render scss))))