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
---
.repl | 3 +-
Makefile | 18 ++++++++
boudin.egg | 65 ++++++++++++--------------
boudin.page.instances.scm | 79 ++++++++++++++++++++++++++++++++
boudin.page.scm | 78 +++++++++++++++++++++++++++++++
boudin.page.write.scm | 114 ++++++++++++++++++++++++++++++++++++++++++++++
boudin.scm | 71 +++++++++++++++++++++++++----
boudin.site.scm | 46 +++++++++++++++++++
boudin.sld | 7 ---
boudin.util.scm | 68 +++++++++++++++++++++++++++
lib/config.sld | 45 ------------------
lib/schmaltz.sld | 17 -------
lib/schmaltz.sls | 103 -----------------------------------------
lib/types.sld | 24 ----------
lib/types.sls | 72 -----------------------------
lib/util.sld | 50 --------------------
test/foo.html | 3 ++
test/out/feed.xml | 25 ++++++++++
test/out/foo/index.html | 5 ++
test/out/index.html | 1 +
20 files changed, 532 insertions(+), 362 deletions(-)
create mode 100644 Makefile
create mode 100644 boudin.page.instances.scm
create mode 100644 boudin.page.scm
create mode 100644 boudin.page.write.scm
create mode 100644 boudin.site.scm
delete mode 100644 boudin.sld
create mode 100644 boudin.util.scm
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
create mode 100644 test/foo.html
create mode 100644 test/out/feed.xml
create mode 100644 test/out/foo/index.html
create mode 100644 test/out/index.html
diff --git a/.repl b/.repl
index 229237b..b8f4fc9 100644
--- a/.repl
+++ b/.repl
@@ -1,4 +1,5 @@
;; -*- scheme -*-
(import (beaker system))
-(print "> (load-system \"boudin.egg\")")
+(define (setup-repl)
+ (load-system "boudin.egg"))
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..bd8289d
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,18 @@
+# boudin
+
+.PHONY: build
+build:
+ chicken-install -n
+
+.PHONY: install
+install:
+ chicken-install
+
+.PHONY: test
+test: build
+ cd test; ../boudin *.html && (cd out; python -m http.server)
+
+.PHONY: clean
+clean:
+ rm -f boudin
+ rm -f *.build.sh *.install.sh *.import.scm *.link *.so *.o
diff --git a/boudin.egg b/boudin.egg
index e9ca2dc..353d1d4 100644
--- a/boudin.egg
+++ b/boudin.egg
@@ -1,42 +1,37 @@
-;;; boudin -*- scheme -*-
+;;; boudin
-((synopsis "A small tasty ssg.")
+((synopsis "a small, tasty ssg.")
(author "Case Duckworth")
- (version "0.0.0")
- (license "God Willing License")
-
- (dependencies chicanery r7rs utf8
+ (license "God Willing")
+ (version "0.1.1")
+ (dependencies atom
html-parser
- srfi-152)
-
+ module-declarations
+ schmaltz
+ srfi-1
+ srfi-152
+ sxml-serializer
+ utf8)
(component-options
- (csc-options "-X" "r7rs" "-R" "r7rs"
- "-X" "utf8" "-R" "utf8"
- "-no-warnings"))
-
+ (csc-options -X module-declarations -X utf8))
(components
(program boudin
- (component-dependencies boudin-lib))
-
- (extension boudin-lib
- (source boudin.sld)
- (modules boudin)
- (install-name boudin)
- (component-dependencies boudin.schmaltz))
-
- (extension boudin.config
- (source lib/config.sld)
- (component-dependencies boudin.schmaltz))
-
- (extension boudin.schmaltz
- (source lib/schmaltz.sld)
- (source-dependencies lib/schmaltz.sls))
-
- (extension boudin.types
- (source lib/types.sld)
- (source-dependencies lib/types.sls)
- (component-dependencies boudin.config
+ (component-dependencies boudin.page
+ boudin.page.instances
+ boudin.page.write
+ boudin.site
+ boudin.util))
+ (extension boudin.page
+ (component-dependencies boudin.site
boudin.util))
-
- (extension boudin.util
- (source lib/util.sld))))
+ (extension boudin.page.instances
+ (component-dependencies boudin.page
+ boudin.page.write
+ boudin.site
+ boudin.util))
+ (extension boudin.page.write
+ (component-dependencies boudin.page
+ boudin.site))
+ (extension boudin.site
+ (component-dependencies boudin.util))
+ (extension boudin.util)))
diff --git a/boudin.page.instances.scm b/boudin.page.instances.scm
new file mode 100644
index 0000000..1a3a12e
--- /dev/null
+++ b/boudin.page.instances.scm
@@ -0,0 +1,79 @@
+(declare (module (boudin page instances))
+ (export make-feed
+ make-index
+ make-post
+ post-path-transformers
+ post-text-transformers))
+
+(import (boudin page write)
+ (boudin page)
+ (boudin site)
+ (boudin util)
+ (chicken pathname)
+ (html-parser)
+ (except (schmaltz)
+ render-specials
+ render-unprintables)
+ (schmaltz chicken)
+ (srfi 152))
+
+(define (make-post path)
+ (let ((sxml ((apply o (post-text-transformers))
+ (with-input-from-file path slurp))))
+ (make-page sxml
+ ((apply o (post-path-transformers)) path)
+ (post-template)
+ (post-writer)
+ (cons (cons "source" path)
+ (*extract-metadata sxml)))))
+
+(define (*extract-metadata sxml)
+ (let loop ((tree sxml)
+ (acc '()))
+ (cond
+ ((not (pair? tree))
+ (reverse acc))
+ ((and (list? (car tree))
+ (eq? (caar tree) '*COMMENT*))
+ (loop (cdr tree)
+ (map (lambda (ln)
+ (let ((kv (string-split ln ":" 'infix 1)))
+ (cons (string-trim-both (car kv))
+ (string-trim (cdr kv)))))
+ (string-split (cadar tree) "\n"))))
+ ((list? (car tree))
+ (loop (cdr tree)
+ (let ((subtree (loop (car tree) '())))
+ (if (null? subtree)
+ acc
+ (cons subtree acc)))))
+ (else (loop (cdr tree) acc)))))
+
+(define (make-index pgs)
+ (make-page ((index-template) pgs)
+ (make-pathname (site-output) "index.html")
+ page-content
+ (index-writer)
+ `()))
+
+(define (make-feed pgs)
+ (make-page ((feed-template) pgs)
+ (make-pathname (site-output) "feed.xml")
+ page-content
+ (feed-writer)
+ `()))
+
+;; Configurables
+
+(define post-text-transformers
+ (make-parameter
+ (list html->sxml
+ wrap-paragraphs
+ render-string->string)))
+
+(define post-path-transformers
+ (make-parameter
+ (list (lambda (path)
+ (make-pathname (list (site-output)
+ (pathname-strip-extension path))
+ "index.html")))))
diff --git a/boudin.page.scm b/boudin.page.scm
new file mode 100644
index 0000000..004e750
--- /dev/null
+++ b/boudin.page.scm
@@ -0,0 +1,78 @@
+(declare (module (boudin page))
+ (export make-page
+ page-content
+ page-meta
+ page-meta-set!
+ page-output
+ page-ref
+ page-set!
+ page-slug
+ page-template
+ page-updated
+ page-url
+ page-writer
+ page?)
+ (import (boudin site)
+ (boudin util)
+ (chicken file posix)
+ (chicken file)
+ (chicken pathname)
+ (chicken time posix)
+ (srfi 1)))
+
+(define-record-type page
+ (make-page content output template writer meta)
+ page?
+ (content page-content)
+ (output page-output)
+ (template page-template)
+ (writer page-writer)
+ (meta page-meta page-meta-set!))
+
+(define (page-ref pg k)
+ (assoc-ref k (or (page-meta pg) '())))
+
+(define (page-set! pg k v)
+ (page-meta-set! pg (cons (cons k v)
+ (page-meta pg))))
+
+(define (*urlify path)
+ (normalize-pathname
+ (make-pathname (list (string-append "https://" (site-host))
+ (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-ref pg "source"))))
+ (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 (*page-mtime pg)
+ (let ((file (page-ref pg "source")))
+ (and file
+ (file-exists? file)
+ (time->string (seconds->utc-time (file-modification-time file))))))
+
+(define (page-updated pg)
+ (let ((meta-date (page-ref pg "date")))
+ (or (and meta-date ; memoization
+ (find (lambda (fmt) (string->time meta-date fmt))
+ (site-date-formats)))
+ (*page-mtime pg)
+ (site-build-time))))
diff --git a/boudin.page.write.scm b/boudin.page.write.scm
new file mode 100644
index 0000000..eb719b7
--- /dev/null
+++ b/boudin.page.write.scm
@@ -0,0 +1,114 @@
+(declare (module (boudin page write))
+ (export feed-template
+ feed-writer
+ html-head
+ index-template
+ index-writer
+ post-template
+ post-writer
+ write-page))
+
+(import (atom)
+ (boudin page)
+ (boudin site)
+ (chicken file)
+ (chicken pathname)
+ (html-parser)
+ (sxml-serializer))
+
+(define (write-page pg)
+ (let ((outfile (page-output pg)))
+ (create-directory (pathname-directory outfile)
+ 'parents)
+ (with-output-to-file outfile
+ (lambda ()
+ ((page-writer pg)
+ ((page-template pg)
+ pg))))))
+
+(define html-head
+ (make-parameter
+ `((meta (@ (charset "utf-8")))
+ (meta (@ (name "viewport")
+ (content "initial-scale=1.0")))
+ (link (@ (href "/style.css")
+ (rel "stylesheet"))))))
+
+(define post-writer
+ (make-parameter
+ sxml-display-as-html))
+
+(define post-template
+ (make-parameter
+ (lambda (pg)
+ (let ((title (page-ref pg "title")))
+ `(html (@ (lang "en-us"))
+ (head ,@(html-head)
+ (title ,(or title "[untitled]")))
+ (body ,(if title `(h1 ,title) "")
+ ,@(cdr (page-content pg))))))))
+
+(define index-writer
+ (make-parameter
+ sxml-display-as-html))
+
+(define index-template
+ (make-parameter
+ (lambda (pgs)
+ `(html (@ (lang "en-us"))
+ (head ,@(html-head)
+ (title ,(site-name)))
+ (body (h1 ,(site-name))
+ (ul ,@(map (lambda (pg)
+ `(li (a (@ (href ,(page-slug pg)))
+ ,(or (page-ref pg "title")
+ (page-slug pg)))))
+ ((site-sort) pgs))))))))
+
+(define feed-writer
+ (make-parameter
+ (lambda (sxml)
+ (serialize-sxml sxml
+ output: (current-output-port)
+ cdata-section-elements: '(atom:content)
+ ns-prefixes:
+ `((*default* . "http://www.w3.org/2005/Atom")
+ (*default* . "http://www.w3.org/1999/xhtml")
+ ,@(atom-ns-prefixes))
+ allow-prefix-redeclarations: #t))))
+
+(define feed-template
+ (make-parameter
+ (lambda (pgs)
+ (make-atom-doc
+ (make-feed
+ title: (make-title (site-name))
+ id: (site-host)
+ updated: (site-build-time)
+ authors: (list (make-author name: (site-author)
+ uri: (site-host)))
+ links: (list (make-link type: 'html
+ uri-language: "en"
+ uri: (site-host))
+ (make-link relation: "self"
+ type: "application/atom+xml"
+ uri: (make-pathname
+ (site-host) "feed" "xml")))
+ rights: (make-rights (force (site-rights)))
+ generator: (make-generator "Boudin"
+ uri: "https://git.acdw.net/boudin"
+ version: "rice")
+ entries: (map (lambda (pg)
+ (make-entry
+ title: (make-title
+ (or (page-ref pg "title") "[untitled]"))
+ links: (list (make-link type: 'html
+ uri: (page-url pg)))
+ id: (page-url pg)
+ updated: (page-updated pg)
+ ;;published:
+ content: (make-content
+ (sxml->html
+ (page-content pg))
+ type: 'html)))
+ ((site-sort) pgs)))))))
diff --git a/boudin.scm b/boudin.scm
index 7bd741d..4f6a1b3 100644
--- a/boudin.scm
+++ b/boudin.scm
@@ -1,14 +1,69 @@
-;;; (boudin) --- A small tasty ssg
+;;; boudin
-(import (boudin))
+(import (boudin page)
+ (boudin page instances)
+ (boudin page write)
+ (boudin site)
+ (boudin util)
+ (chicken file)
+ (chicken pathname)
+ (chicken process-context))
-(define foo (render-string "#,hello from Boudin!"
- (interaction-environment)))
+(define site-posts
+ (make-parameter '()))
-(define (main . args)
- (print foo)
- (for-each print args))
+(define site-files
+ (make-parameter '()))
+
+(define (copy-static file)
+ (copy-file file (pathname-replace-directory file (site-dest))))
+
+(define (with-progress message thunk)
+ (edisplay message)
+ (edisplay "...")
+ (thunk)
+ (eprint "Ok."))
+
+(define (go!)
+ (eprint "Building " (site-name) "...")
+ (when (file-exists? (site-config))
+ (with-progress (string-append "Config found, loading: " (site-config))
+ (lambda () (load (site-config)))))
+ (for-each (lambda (f)
+ (with-progress (string-append "Copying " f " to " (site-output))
+ (lambda () (copy-static f)))) (site-files))
+ (let ((posts (map make-post (site-posts))))
+ (for-each (lambda (pg)
+ (with-progress (string-append "Writing " (page-output pg))
+ (lambda () (write-page pg))))
+ (append posts
+ (list (make-index posts)
+ (make-feed posts)))))
+ (eprint "Done!"))
+
+(define (main args)
+ (define *current #f)
+ (let loop ((args args))
+ (cond
+ ((null? args) (go!))
+ ((equal? (car args) "-c")
+ (site-config (cadr args))
+ (loop (cddr args)))
+ ((not *current) ; add to posts by default
+ (site-posts (cons (car args) (site-posts)))
+ (loop (cdr args)))
+ ((equal? (car args) "-p")
+ (set! *current site-posts)
+ (loop (cdr args)))
+ ((equal? (car args) "-f")
+ (set! *current site-files)
+ (loop (cdr args)))
+ (else
+ (*current (cons (car args) (*current)))
+ (loop (cdr args))))))
(cond-expand
- (compiling (apply main (command-line)))
+ ((or chicken-script compiling)
+ (import (chicken process-context))
+ (main (command-line-arguments)))
(else))
diff --git a/boudin.site.scm b/boudin.site.scm
new file mode 100644
index 0000000..ee94b9b
--- /dev/null
+++ b/boudin.site.scm
@@ -0,0 +1,46 @@
+(declare (module (boudin site))
+ (export site-author
+ site-build-time
+ site-config
+ site-host
+ site-name
+ site-date-formats
+ site-output
+ site-rights
+ site-sort)
+ (import (boudin util)
+ (chicken time posix)))
+
+;; Configurables
+
+(define site-sort
+ (make-parameter identity))
+
+(define site-name
+ (make-parameter "a boudin site"))
+
+(define site-host
+ (make-parameter "example.com"))
+
+(define site-author
+ (make-parameter "nobody"))
+
+(define site-rights
+ (make-parameter
+ (delay (string-append "(C) " (site-author)))))
+
+(define site-output
+ (make-parameter "out/"))
+
+(define site-config
+ (make-parameter "config.scm"))
+
+(define site-date-formats
+ (make-parameter '("%Y-%m-%d"
+ "%d/%m/%Y")))
+
+;; State variables
+
+(define site-build-time
+ (make-parameter
+ (time->string (seconds->utc-time) "%FT%TZ")))
diff --git a/boudin.sld b/boudin.sld
deleted file mode 100644
index 8129659..0000000
--- a/boudin.sld
+++ /dev/null
@@ -1,7 +0,0 @@
-(define-library (boudin)
- (import (scheme base)
- (scheme repl)
- (boudin schmaltz))
- (export hello)
- (begin
- (define hello "Hi")))
diff --git a/boudin.util.scm b/boudin.util.scm
new file mode 100644
index 0000000..2683730
--- /dev/null
+++ b/boudin.util.scm
@@ -0,0 +1,68 @@
+(declare (module (boudin util))
+ (export assoc-ref
+ slurp
+ wrap-paragraphs
+ edisplay
+ eprint))
+
+(import (srfi 1)
+ (srfi 152))
+
+(define (edisplay x)
+ (parameterize ((current-output-port (current-error-port)))
+ (display x)))
+
+(define (eprint . xs)
+ (parameterize ((current-output-port (current-error-port)))
+ (for-each display xs)
+ (newline)))
+
+(define (assoc-ref k alist)
+ (let ((k/v (and (pair? alist)
+ (assoc k alist))))
+ (if k/v (cdr k/v) #f)))
+
+(define (wrap-paragraphs text)
+ (let loop ((ps (map string-trim (*split-paragraphs text)))
+ (acc '()))
+ (cond
+ ((null? ps)
+ (apply string-append (reverse acc)))
+ ((zero? (string-length (car ps)))
+ (loop (cdr ps) acc))
+ ((eq? #\< (string-ref (car ps) 0))
+ (loop (cdr ps) (cons (car ps) acc)))
+ (else
+ (loop (cdr ps)
+ (cons (string-append "" (car ps) "
\n")
+ acc))))))
+
+(define (*split-paragraphs text)
+ (define (*end-buf buf acc)
+ (cons (apply string-append (reverse buf)) acc))
+ (let loop ((ls (string-split text "\n"))
+ (buf '())
+ (acc '()))
+ (cond
+ ((and (null? ls)
+ (null? buf))
+ (reverse acc))
+ ((null? ls)
+ (loop '() '() (*end-buf buf acc)))
+ ((zero? (string-length (car ls)))
+ (loop (cdr ls) '() (*end-buf buf acc)))
+ (else
+ (loop (cdr ls)
+ (cons (string-append (car ls) "\n") buf)
+ acc)))))
+
+(define slurp
+ (case-lambda
+ (() (slurp (current-input-port)))
+ ((port)
+ (let loop ((ch (read-char port))
+ (acc '()))
+ (if (eof-object? ch)
+ (list->string (reverse acc))
+ (loop (read-char port)
+ (cons ch acc)))))))
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))
-
- ))
diff --git a/test/foo.html b/test/foo.html
new file mode 100644
index 0000000..c21e761
--- /dev/null
+++ b/test/foo.html
@@ -0,0 +1,3 @@
+a test file
+
+#,(+ 1 2)
diff --git a/test/out/feed.xml b/test/out/feed.xml
new file mode 100644
index 0000000..2f1f29f
--- /dev/null
+++ b/test/out/feed.xml
@@ -0,0 +1,25 @@
+
+
+
+ nobody
+ example.com
+
+ Boudin
+ example.com
+ (C) nobody
+ a boudin site
+ 2023-09-07T03:42:00Z
+
+ a test file
+
+3
+
+]]>
+ https:/example.com/foo/index.html
+ [untitled]
+ Wed Sep 6 04:59:10 2023
+
+
\ No newline at end of file
diff --git a/test/out/foo/index.html b/test/out/foo/index.html
new file mode 100644
index 0000000..7d408f6
--- /dev/null
+++ b/test/out/foo/index.html
@@ -0,0 +1,5 @@
+[untitled] a test file
+
+3
+
+
\ No newline at end of file
diff --git a/test/out/index.html b/test/out/index.html
new file mode 100644
index 0000000..2267cf0
--- /dev/null
+++ b/test/out/index.html
@@ -0,0 +1 @@
+a boudin site a boudin site
\ No newline at end of file
--
cgit 1.4.1-21-gabe81