From 59598f42c16cf12e544e5bf2ce9c873fba94238e Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 6 Sep 2023 22:45:45 -0500 Subject: A newerer beginning --- lib/config.sld | 45 ------------------------ lib/schmaltz.sld | 17 --------- lib/schmaltz.sls | 103 ------------------------------------------------------- lib/types.sld | 24 ------------- lib/types.sls | 72 -------------------------------------- lib/util.sld | 50 --------------------------- 6 files changed, 311 deletions(-) delete mode 100644 lib/config.sld delete mode 100644 lib/schmaltz.sld delete mode 100644 lib/schmaltz.sls delete mode 100644 lib/types.sld delete mode 100644 lib/types.sls delete mode 100644 lib/util.sld (limited to 'lib') diff --git a/lib/config.sld b/lib/config.sld deleted file mode 100644 index bdd6ef5..0000000 --- a/lib/config.sld +++ /dev/null @@ -1,45 +0,0 @@ -;;; (boudin config) --- default values for configuration options -;; -;; To change these, make a `config.scm' in your site's root directory and change -;; these. They're all parameters so .. change em like that. - -(define-library (boudin config) - (import (scheme base) - (boudin schmaltz) - ;; not portable - (chicken pathname) - (html-parser) - ) - - (export site-url site-dest - page-path-transformers page-text-transformers - page-template index-template feed-template) - - (begin - ;; Site information - (define site-url - (make-parameter "example.com")) - (define site-dest - (make-parameter "out/")) - ;; Transformers - (define page-path-transformers - (make-parameter - (list (lambda (path) (make-pathname (site-dest) path))))) - (define page-text-transformers - (make-parameter - (list wrap-paragraphs - render-string - html->sxml))) - ;; Templates --- note that we use quote but include unquote forms here. - ;; This is to simplify the configuration and to avoid a cyclical dependency - ;; with (boudin types). - (define page-template - (make-parameter - '(html (@ (lang "en-us")) - (head (title (or (page-ref pg "title") "[untitled]"))) - (body ,@(page-sxml pg))))) - (define index-template - (make-parameter 'todo)) - (define feed-template - (make-parameter 'todo)) - )) diff --git a/lib/schmaltz.sld b/lib/schmaltz.sld deleted file mode 100644 index d54d53e..0000000 --- a/lib/schmaltz.sld +++ /dev/null @@ -1,17 +0,0 @@ -(define-library (boudin schmaltz) - (export render - render-string - wrap-paragraphs) - - (import (scheme base) - (scheme case-lambda) ; case-lambda - (scheme eval) ; eval - (scheme read) ; read - (scheme repl) ; interaction-environment - (scheme write) ; display - (only (html-parser) - sxml->html) - (only (srfi 152) - string-split string-trim)) - - (include "lib/schmaltz.sls")) diff --git a/lib/schmaltz.sls b/lib/schmaltz.sls deleted file mode 100644 index 623191f..0000000 --- a/lib/schmaltz.sls +++ /dev/null @@ -1,103 +0,0 @@ -;;; (boudin schmaltz) --- transform almost-html plus scheme into html - -;;; Embedded scheme code - -(define (->string x) - (call-with-port (open-output-string) - (lambda (port) - (display x port) - (get-output-string port)))) - -(define render-string - (case-lambda - ((s) (render-string s (interaction-environment))) - ((s env) - (call-with-port (open-input-string s) - (lambda (port) - (render port env)))))) - -(define (render port env) - ;; A few rough edges: - ;; #, x will try to render x - (define (burn-char) - ;; Throw a character away. I've defined this for clarity below. - (read-char port)) - - (let loop ((ch (read-char port)) - (acc '())) - (define (proceed) (loop (read-char port) (cons ch acc))) - (cond - ((not ch) - (loop (read-char port) acc)) - ((eof-object? ch) - (list->string (reverse acc))) - ((eq? ch #\#) ; special processing to come - (case (peek-char port) - ((#\\) ; inhibit processing of the next char - (burn-char) - (loop (read-char port) (cons ch acc))) - ((#\,) ; scheme eval expansion - (burn-char) - (loop #f - (append (let ((s (->string - (eval (read port) - env)))) - (cond - ((equal? s "#") ; XXX NOT PORTABLE - '()) - ((equal? s "#!eof") ; XXX NOT PORTABLE - '(#\, #\#)) - (else (reverse (string->list s))))) - acc))) - ((#\@) ; embedded sxml - (burn-char) - (loop #f - (append (let ((h (eval `(sxml->html ,(list 'quasiquote - (read port))) - env))) - (cond - ((equal? h "#!eof") ; XXX NOT PORTABLE - '(#\@ #\#)) - (else (reverse (string->list h))))) - acc))) - (else (proceed)))) - (else (proceed))))) - -;;; Wrap paragraphs - -(define (split-paragraphs str) - (let loop ((lines (string-split str "\n")) - (par '()) - (acc '())) - (cond - ((and (null? lines) ; base case: no more lines - (null? par)) ; ... or pending paragraph - (reverse acc)) - ((null? lines) ; add the final paragraph - (loop '() '() (cons (apply string-append (reverse par)) acc))) - ((equal? (car lines) "") ; paragraph break - (loop (cdr lines) - '() - (cons (apply string-append (reverse par)) acc))) - (else ; line break - (loop (cdr lines) - (cons (string-append (car lines) "\n") par) - acc))))) - -(define (wrap-paragraphs str) - (let loop ((pars (split-paragraphs str)) - (acc '())) - (cond - ((null? pars) - (apply string-append (reverse acc))) - ((zero? (string-length (car pars))) - (loop (cdr pars) - acc)) - ((eq? #\< (string-ref (string-trim (car pars)) 0)) - (loop (cdr pars) - (cons (car pars) - acc))) - (else - (loop (cdr pars) - (cons (string-append "

" (car pars) "

\n") - acc)))))) diff --git a/lib/types.sld b/lib/types.sld deleted file mode 100644 index 791ff53..0000000 --- a/lib/types.sld +++ /dev/null @@ -1,24 +0,0 @@ -(define-library (boudin types) - (import (scheme base) - (scheme case-lambda) - (scheme file) - (boudin config) - (boudin util) - ;; non-portable bits - (chicken pathname) - (html-parser) - ) - - (export - ;; pages - make-page page? - page-path page-dest page-text page-sxml page-meta - set-page-dest! set-page-text! set-page-sxml! set-page-meta! - extract-metadata page-ref page-set! - page-url page-slug - read-page write-page - ;; indeces - ;; static files - ) - - (include "lib/types.sls")) diff --git a/lib/types.sls b/lib/types.sls deleted file mode 100644 index 2b4da5d..0000000 --- a/lib/types.sls +++ /dev/null @@ -1,72 +0,0 @@ -;;; (boudin types) --- pages, indeces, and static files - -;; All paths are relative to the site directory unless otherwise noted - -(define-record-type page - (make-page path ; Input path - dest ; Output path (rel. to output directory) - text ; Input text - sxml ; Rendered sxml - meta ; Metadata (title, etc.) - ) - page? - (path page-path) - (dest page-dest set-page-dest!) - (text page-text set-page-text!) - (sxml page-sxml set-page-sxml!) - (meta page-meta set-page-meta!)) - -(define (page-ref pg key) - (assoc-ref key (page-meta pg) (identity #f))) - -(define (page-set! pg key val) - (set-page-meta! pg (cons (cons key val) - (page-meta pg)))) - -(define (extract-metadata sxml) - #f) - -(define (*urlify path) - (normalize-pathname - (make-pathname (list (site-url) - (pathname-strip-extension path)) - "index.html"))) - -(define (page-url pg) ; foo.html => http://site.com/foo/index.html - (or (page-ref pg "url") ; memoization - (let ((url (*urlify (page-path pg)))) - (page-set! pg "url" url) - url))) - -(define (*slugify url) ; I don't love how this is written.. - (let-values (((_ _ dirs) (decompose-directory url))) - (let loop ((this (car dirs)) - (rest (cdr dirs))) - (if (null? (cdr rest)) - (make-pathname (list "/" this) #f) - (loop (car rest) - (cdr rest)))))) - -(define (page-slug pg) ; http://site.com/foo/index.html => /foo/ - (or (page-ref pg "slug") ; memoization - (let ((slug (*slugify (page-url pg)))) - (page-set! pg "slug" slug) - slug))) - -(define (read-page path) - (let ((pg (make-page path #f #f #f #f))) - (set-page-dest! pg ((apply o (page-path-transformers)) path)) - (set-page-text! pg (with-input-from-file path slurp)) - (set-page-sxml! pg ((apply o (page-text-transformers)) (page-text pg))) - (set-page-meta! pg (extract-metadata (page-sxml pg))) - pg)) - -(define write-page - (case-lambda - ((pg) (call-with-output-file (page-dest pg) - (lambda (port) (write-page pg port)))) - ((pg port) - (sxml-display-as-html ((eval/q (page-template)) pg) port)))) - - - diff --git a/lib/util.sld b/lib/util.sld deleted file mode 100644 index 64c633e..0000000 --- a/lib/util.sld +++ /dev/null @@ -1,50 +0,0 @@ -;;; (boudin util) --- utility functions - -(define-library (boudin util) - (import (scheme base) - (scheme case-lambda) - (scheme eval)) - - (export identity - o - assoc-ref - slurp - eval/q) - - (begin - (define (identity x) x) - - (define (o . procs) ; stole from chicken core - (if (null? procs) - identity - (let loop ((procs procs)) - (let ((h (car procs)) - (t (cdr procs))) - (if (null? t) - h - (lambda (x) (h ((loop t) x)))))))) - - (define assoc-ref - (case-lambda - ((key alist) - (assoc-ref alist - key - (lambda () (error "Unrecognized key." key)))) - ((key alist failure) - (cond ((assoc key alist) => cdr) - (else (failure)))))) - - (define slurp - (case-lambda - (() (slurp (current-input-port))) - ((port) - (let loop ((ch (read-char)) - (acc '())) - (if (eof-object? ch) - (list->string (reverse acc)) - (loop (read-char) (cons ch acc))))))) - - (define (eval/q form env) ; this is probably a bad idea - (eval (list 'quasiquote form) env)) - - )) -- cgit 1.4.1-21-gabe81