add pict lang and also make it a real package

This commit is contained in:
xenia 2021-06-11 04:00:42 -04:00
parent 86bb36fe49
commit 14f20da9fb
11 changed files with 112 additions and 23 deletions

3
.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
*.zo
*.dep
compiled

3
README.md Normal file
View File

@ -0,0 +1,3 @@
# meow
meow

View File

@ -2,7 +2,7 @@
(require racket/contract racket/list racket/match)
(provide metadata? metadata-ref metadata-ref+)
(provide metadata? config? assoc-ref assoc-ref+)
(define metadata?
(listof (or/c
@ -13,12 +13,16 @@
(list/c 'summary string?)
(cons/c 'authors (listof string?)))))
(define (metadata-ref md key [default (λ () (error "no such key"))])
(define config?
(listof (or/c
(list/c 'base string?))))
(define (assoc-ref md key [default (λ () (error "no such key"))])
(match (assoc key md)
[#f (if (procedure? default) (default) default)]
[(cons _ rst) rst]))
(define (metadata-ref+ md key [default (λ () (error "no such key"))])
(define (assoc-ref+ md key [default (λ () (error "no such key"))])
(match (assoc key md)
[#f (if (procedure? default) (default) default)]
[(list _ snd) snd]))

9
fasl-reader.rkt Normal file
View File

@ -0,0 +1,9 @@
#lang racket/base
(module+ main
(require racket/fasl racket/pretty racket/cmdline)
(command-line
#:program "capybara-fasl"
#:args (file)
(pretty-write
(fasl->s-exp (open-input-file file)))))

26
info.rkt Normal file
View File

@ -0,0 +1,26 @@
#lang info
(define collection "capybara")
(define pkg-desc "haskal site generator")
(define version "0.1")
(define pkg-authors '(haskal))
(define deps '("base" "draw-lib" "pict-lib"
"crypto" "html-parsing" "markdown" "ppict" "threading-lib"))
(define build-deps '("scribble-lib" "racket-doc" "rackunit-lib"))
; (define compile-omit-paths '("something"))
; (define scribblings '(("scribblings/capybara.scrbl" ())))
(define racket-launcher-names '("capybara-render"))
(define racket-launcher-libraries '("render"))
(define raco-commands
'(("capybara"
(submod capybara/render main)
"run capybara"
#f)
("capybara-fasl"
(submod capybara/fasl-reader main)
"run capybara fasl inspector"
#f)))

3
main.rkt Normal file
View File

@ -0,0 +1,3 @@
#lang racket/base
;; nothing here yet

20
pict.rkt Normal file
View File

@ -0,0 +1,20 @@
#lang racket/base
(require racket/base racket/contract syntax/parse/define syntax/wrap-modbeg
(for-syntax racket/base)
racket/draw pict ppict/2)
(provide (rename-out [x:#%module-begin #%module-begin])
(except-out (all-from-out racket/base racket/contract racket/draw pict ppict/2)
#%module-begin))
(define-syntax x:#%module-begin
(make-wrapping-module-begin #'x:wrap-object))
(define-syntax-parse-rule (x:wrap-object body:expr)
#:with id (datum->syntax #'body 'icon-pict)
#:do [(syntax-local-lift-provide #'id)]
(define/contract id pict? body))
(module reader syntax/module-reader
capybara/pict)

View File

@ -1,7 +1,7 @@
#lang racket/base
(require racket/fasl racket/list racket/match racket/port racket/path racket/set racket/string
racket/runtime-path net/url-string
(require racket/class racket/draw racket/fasl racket/list racket/match racket/port racket/path
racket/set racket/string racket/runtime-path net/url-string pict
markdown markdown/display-xexpr markdown/toc
"compiler.rkt" "defs.rkt" "fetch.rkt"
threading
@ -16,6 +16,7 @@
(define-runtime-path *render.scss* "render.scss")
(define *index.md* (build-path "index.md"))
(define *config.rktd* (build-path "config.rktd"))
(define *reserved-slugs* (set (build-path "hashtag") (build-path "user") (build-path "tech")))
@ -139,15 +140,18 @@
[(? string? str) str]))
(lower-specials* xexpr))
(define (ir-doc->page doc)
(define (ir-doc->page doc site-config)
(match-define (ir-doc md xref-name content) doc)
(let ([content (lower-specials content "https://awoo.systems")])
(define base-url (assoc-ref+ site-config 'base))
(let ([content (lower-specials content base-url)])
(define content-toc (toc content))
(define document
(page:execute
(hash 'metadata md
'site-config site-config
'xref-name xref-name
'base-url base-url
'content-toc content-toc
'content content)))
@ -166,7 +170,14 @@
[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)))
(~> (compile-index-scss (port->string in)) (write-string out)))
(define favicon.rkt (build-path src-dir "favicon.rkt"))
(define-rule (favicon [out (build-path output-dir "favicon.png")]
[in favicon.rkt])
(define icon-pict (dynamic-require favicon.rkt 'icon-pict))
(define icon-bitmap (pict->bitmap icon-pict))
(send icon-bitmap save-file out 'png))
(struct rule-spec [src intermediate output xref-name] #:transparent)
@ -187,13 +198,15 @@
(build-path build-dir fasl-file)
(build-path output-dir out-file)
xref-name))))
(define config.rktd (build-path src-dir *config.rktd*))
(define xrefs-repo
(for/set ([spec (in-list rule-specs)])
(define exploded (explode-path (rule-spec-xref-name spec)))
(when (and (> (length exploded) 1)
(set-member? *reserved-slugs* (second exploded)))
(error "file is using a reserved slug" (rule-spec-src spec)))))
(error "file is using a reserved slug" (rule-spec-src spec)))
exploded))
(define intermediate-rules
(for/list ([spec (in-list rule-specs)])
@ -207,14 +220,18 @@
(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)))
[in (rule-spec-intermediate spec)]
[config-in config.rktd])
(define config (read config-in))
(unless (config? config)
(error "invalid config in config.rktd!"))
(~> (port->bytes in) fasl->s-exp (ir-doc->page config) (write-string out)))
output-rule))
(append intermediate-rules output-rules (list scss)))
(append intermediate-rules output-rules (list scss favicon)))
(module+ main
(require racket/cmdline)
(command-line
#:program "meow"
#:program "capybara-render"
#:args ()
(generate/execute (scan-for-rules))))

View File

@ -29,6 +29,7 @@
(syntax-local-lift-require #`(rename what execute-temp execute) #'execute-temp)
(execute-fn tem))
;; TODO : maybe use make-wrapping-module-begin
(define-syntax-parse-rule (x:#%module-begin body)
(#%module-begin
(provide execute required-keys)
@ -43,3 +44,6 @@
#:with (items ...)
(map (λ (stx) #`(quote #,stx)) (set->list (syntax-parameter-value #'template-vars)))
(list items ...))
(module reader syntax/module-reader
capybara/template)

View File

@ -1,5 +1,5 @@
#lang s-exp "../xtemplate.rkt"
#lang capybara/template
`(p ()
"this was included from another file #uwu the summary is: "
,(or (metadata-ref+ metadata 'summary) "no summary :("))
,(or (assoc-ref+ metadata 'summary) "no summary :("))

View File

@ -1,29 +1,29 @@
#lang s-exp "../xtemplate.rkt"
#lang capybara/template
`(html
([lang ,(metadata-ref+ metadata 'lang "en")])
([lang ,(assoc-ref+ metadata 'lang "en")])
(head
()
(!HTML-COMMENT () " this page made with: trans rights 🏳️‍⚧️ ")
(meta ([charset "utf-8"]))
(title () ,(metadata-ref+ metadata 'title "<untitled page>"))
(title () ,(assoc-ref+ metadata 'title "<untitled page>"))
(meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
,@(match (metadata-ref+ metadata 'summary #f)
,@(match (assoc-ref+ metadata 'summary #f)
[#f '()]
[summary
`((meta ([name "description"] [content ,summary])))])
,@(match (metadata-ref metadata 'authors #f)
,@(match (assoc-ref metadata 'authors #f)
[(or #f '()) '()]
[authors
`((meta ([name "author"] [content ,(string-join authors ", ")])))])
,@(match (metadata-ref metadata 'date #f)
,@(match (assoc-ref metadata 'date #f)
[#f '()]
[(list yn mn dn)
`((meta ([name "DC.Date.created"]
[content ,(format "~a-~a-~a" (~r/pad yn 4) (~r/pad mn 2) (~r/pad dn 2))])))])
(meta ([name "generator"] [content "meow meow meow meow"]))
;<link rel="shortcut icon" type="image/png" href="haskal.png"/>
(link ([rel "stylesheet"] [type "text/css"] [href "index.css"])))
(link ([rel "shortcut icon"] [type "image/png"] [href ,(format "~a/favicon.png" base-url)]))
(link ([rel "stylesheet"] [type "text/css"] [href ,(format "~a/index.css" base-url)])))
(body
()
(nav