commit d8216b1f0b193adb8bd76ff8a6512ab8f8ba8a91
parent 740df319cd7a429ba77a766b5870aae7809d2be6
Author: Daniel Barlow <dan@telent.net>
Date: Mon, 21 Jul 2025 22:16:35 +0100
extract post indexing code to site.fnl
Diffstat:
| M | Makefile | | | 2 | +- |
| M | main.fnl | | | 130 | ++++++++----------------------------------------------------------------------- |
| A | site.fnl | | | 125 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
3 files changed, 138 insertions(+), 119 deletions(-)
diff --git a/Makefile b/Makefile
@@ -2,7 +2,7 @@ FENNEL?=fennel
PREFIX?=/usr/local
NAME?=cripslock
-MODULES=main.fnl textile.fnl
+MODULES=main.fnl textile.fnl site.fnl
%.lua : %.fnl
$(FENNEL) --compile $< > $@
diff --git a/main.fnl b/main.fnl
@@ -6,118 +6,13 @@
(local http-version (require :http.version))
(local ce (require :cqueues.errno))
(local lcmark (require :lcmark))
-
+
(local server (require :server))
(local textile (require :textile))
+(local site (require :site))
(local { : view } (require :fennel))
-(fn frontmatter [stream]
- (var bail? false)
- (collect [l (stream:lines)
- &until (or (= l "") bail?)]
- (let [(k v) (string.match l "(.-): *(.+)")]
- (if k
- (values (string.lower k) v)
- (set bail? true)))))
-
-(define-tests :frontmatter
- (with-open [stream (io.open "tests/post-with-headers.textile" :r)]
- (let [headers (frontmatter stream)]
- (expect= headers.title "What I miss most about Lisp")
- (expect= headers.author "Daniel Barlow")
- ;; headers names are downcased
- (expect= headers.x-parrot "norweigan blue")
- (expect= headers.date "Sat Apr 30 23:23:33 2011")
- ;; leaves stream position at first body line
- (expect= (stream:read "l") "first content line"))))
-
-
-;; there are two date formats used in most of the extant posts:
-;; "Fri Jun 29 14:17:56 2018" (emacs current-time-string)
-;; and "Fri, 18 Oct 2013 10:18:34 +0100" (*rfc2822")
-
-(local months
- {"jan" 1
- "feb" 2
- "mar" 3
- "apr" 4
- "may" 5
- "jun" 6
- "jul" 7
- "aug" 8
- "sep" 9
- "oct" 10
- "nov" 11
- "dec" 12
- })
-
-(fn parse-rfc2822-timestamp [date-str]
- (let [(s _ weekday day month year hour min sec offset)
- (string.find date-str "(%a+), (%d+) (%a+) (%d+) (%d+):(%d+):(%d+) ([+-]%d+)" 1)]
- (and s
- (os.time {
- : year
- :month (. months (string.lower month))
- : day
- : hour
- : min
- : sec
- :isdst (not (= offset "+0000")) ;; massive cheating here
- }))))
-
-(fn parse-emacs-timestamp [date-str]
- (let [(s _ weekday month day hour min sec year)
- (string.find date-str "(%a+) (%a+) (%d+) (%d+):(%d+):(%d+) (%d+)" 1)]
- (and s
- (os.time {
- : year
- :month (. months (string.lower month))
- : day
- : hour
- : min
- : sec
- :isdst true ; probably?
- }))))
-
-(fn parse-timestamp [s]
- (or (parse-rfc2822-timestamp s)
- (parse-emacs-timestamp s)))
-
-(define-tests :date-parsing
- (expect= (parse-rfc2822-timestamp "Fri, 18 Oct 2013 10:18:34 +0100")
- 1382087914)
- (expect= (parse-rfc2822-timestamp "Tue, 28 Dec 2004 21:41:24 +0000")
- 1104270084)
- (expect= (parse-emacs-timestamp "Sat Jul 19 23:53:21 2025") 1752965601)
- (expect= (parse-rfc2822-timestamp "Sat Jul 19 23:53:21 2025") nil)
- (expect= (parse-timestamp "Sat Jul 19 23:53:21 2025") 1752965601)
- )
-
-(fn slug [title]
- (-> title
- (string.gsub "[^A-Za-z0-9]+" "_")
- (string.gsub "_+$" "")
- string.lower))
-
-(fn index-posts [path]
- (collect [name (lfs.dir path)]
- (let [fullname (.. path "/" name)
- (attr err) (lfs.attributes fullname)]
- (when (not attr) (print :err err))
- (if (and attr
- (= attr.mode :file)
- (or
- (string.match name "%.textile$")
- (string.match name "%.md$")))
- (with-open [f (io.open fullname)]
- (let [fields (frontmatter f)]
- (values (slug (or fields.subject fields.title))
- (doto fields
- (tset :path name)
- (tset :full-path fullname)
- (tset :date (and fields.date (parse-timestamp fields.date)))))))))))
-
(local handlers
[
#(if (= $2 "/")
@@ -180,30 +75,29 @@
)
-(local post-index (index-posts "data/blogs/telent.blog/posts/"))
-; (print (view (icollect [k v (pairs post-index)] k)))
+(local post-index (site.for-pathname "data/blogs/telent.blog/posts/"))
(fn dispatch [route stream]
(let [s { :write #(stream:write_chunk $2) } ]
(case route.command
:show
- (let [post (. post-index route.slug)
+ (let [post (post-index:get route.slug)
path (. post :full-path)]
(print :path path)
(with-open [f (io.open path )]
(when f
- (let [_ (frontmatter f)]
- (if (string.match path "%.textile$")
- (each [_ el (ipairs (textile.parse f))]
- (textile.to-html s el))
- (stream:write_chunk
- (lcmark.convert (f:read "*a") "html" { :yaml_parser #($1) }))
- ))))
+ (f:seek :set post.body-offset)
+ (if (string.match path "%.textile$")
+ (each [_ el (ipairs (textile.parse f))]
+ (textile.to-html s el))
+ (stream:write_chunk
+ (lcmark.convert (f:read "*a") "html" { :yaml_parser #($1) }))
+ )))
(stream:write_chunk "" true))
:search
(do
(stream:write_chunk "<p><ul>")
- (each [slug post (pairs post-index)]
+ (each [slug post (pairs (post-index:search))]
(stream:write_chunk
(string.format
"<li><a href=%q>%s</a></li>"
diff --git a/site.fnl b/site.fnl
@@ -0,0 +1,125 @@
+(import-macros { : define-tests : expect : expect= } :assert)
+(local lfs (require :lfs))
+
+;; there are two date formats used in most of the extant posts:
+;; "Fri Jun 29 14:17:56 2018" (emacs current-time-string)
+;; and "Fri, 18 Oct 2013 10:18:34 +0100" (*rfc2822")
+
+(local months
+ {"jan" 1
+ "feb" 2
+ "mar" 3
+ "apr" 4
+ "may" 5
+ "jun" 6
+ "jul" 7
+ "aug" 8
+ "sep" 9
+ "oct" 10
+ "nov" 11
+ "dec" 12
+ })
+
+(fn parse-rfc2822-timestamp [date-str]
+ (let [(s _ weekday day month year hour min sec offset)
+ (string.find date-str "(%a+), (%d+) (%a+) (%d+) (%d+):(%d+):(%d+) ([+-]%d+)" 1)]
+ (and s
+ (os.time {
+ : year
+ :month (. months (string.lower month))
+ : day
+ : hour
+ : min
+ : sec
+ :isdst (not (= offset "+0000")) ;; massive cheating here
+ }))))
+
+(fn parse-emacs-timestamp [date-str]
+ (let [(s _ weekday month day hour min sec year)
+ (string.find date-str "(%a+) (%a+) (%d+) (%d+):(%d+):(%d+) (%d+)" 1)]
+ (and s
+ (os.time {
+ : year
+ :month (. months (string.lower month))
+ : day
+ : hour
+ : min
+ : sec
+ :isdst true ; probably?
+ }))))
+
+(fn parse-timestamp [s]
+ (or (parse-rfc2822-timestamp s)
+ (parse-emacs-timestamp s)))
+
+(define-tests :date-parsing
+ (expect= (parse-rfc2822-timestamp "Fri, 18 Oct 2013 10:18:34 +0100")
+ 1382087914)
+ (expect= (parse-rfc2822-timestamp "Tue, 28 Dec 2004 21:41:24 +0000")
+ 1104270084)
+ (expect= (parse-emacs-timestamp "Sat Jul 19 23:53:21 2025") 1752965601)
+ (expect= (parse-rfc2822-timestamp "Sat Jul 19 23:53:21 2025") nil)
+ (expect= (parse-timestamp "Sat Jul 19 23:53:21 2025") 1752965601)
+ )
+
+
+(fn frontmatter [stream]
+ (var bail? false)
+ (collect [l (stream:lines)
+ &until (or (= l "") bail?)]
+ (let [(k v) (string.match l "(.-): *(.+)")]
+ (if k
+ (values (string.lower k) v)
+ (set bail? true)))))
+
+(define-tests :frontmatter
+ (with-open [stream (io.open "tests/post-with-headers.textile" :r)]
+ (let [headers (frontmatter stream)]
+ (expect= headers.title "What I miss most about Lisp")
+ (expect= headers.author "Daniel Barlow")
+ ;; headers names are downcased
+ (expect= headers.x-parrot "norweigan blue")
+ (expect= headers.date "Sat Apr 30 23:23:33 2011")
+ ;; leaves stream position at first body line
+ (expect= (stream:read "l") "first content line"))))
+
+(fn slug-for [title]
+ (-> title
+ (string.gsub "[^A-Za-z0-9]+" "_")
+ (string.gsub "_+$" "")
+ string.lower))
+
+(fn index-posts [path]
+ (collect [name (lfs.dir path)]
+ (let [fullname (.. path "/" name)
+ (attr err) (lfs.attributes fullname)]
+ (when (not attr) (print :err err))
+ (if (and attr
+ (= attr.mode :file)
+ (or
+ (string.match name "%.textile$")
+ (string.match name "%.md$")))
+ (with-open [f (io.open fullname)]
+ (let [fields (frontmatter f)
+ title (or fields.subject fields.title)
+ slug (slug-for title)]
+ (values slug
+ (doto fields
+ (tset :path name)
+ (tset :full-path fullname)
+ (tset :url-path (.. "/" slug))
+ (tset :title title)
+ (tset :body-offset (f:seek :cur 0))
+ (tset :date (and fields.date (parse-timestamp fields.date)))))))))))
+
+
+(fn for-pathname [path]
+ (let [posts (index-posts path)]
+ {
+ :get #(. posts $2)
+ :search (fn [_] posts)
+ :path path
+ :static-file (fn [name] (.. path "/" name))
+ }))
+
+{ : for-pathname }
