diff --git a/private/compile.rkt b/private/compile.rkt
index c6d72d7..f79bd25 100644
--- a/private/compile.rkt
+++ b/private/compile.rkt
@@ -1,6 +1,8 @@
#lang racket
-;; compiler
+;; compiler:
+;; infrastructure for incrementally compiling blog contents from source to html/json/etc
+;; lots of graphs (it's all graphs)
(provide (struct-out rule)
generate-operations
diff --git a/private/prefs.rkt b/private/prefs.rkt
index 5fc5e3f..80f6926 100644
--- a/private/prefs.rkt
+++ b/private/prefs.rkt
@@ -1,5 +1,8 @@
#lang racket
+;; prefs:
+;; utilities for reading and writing preferences
+
(require net/url-string)
(provide prefs-save prefs-load prefs-get prefs-update DEFAULT-PREFS)
@@ -17,31 +20,39 @@
(define (pronoun-list? x)
(and (list? x) (= 5 (length x))))
+;; a preferences schema with validation functions
(define SCHEMA
(hash 'instance-url instance-url?
'display-name string?
'name id-string?
+ 'title string?
'make-discoverable boolean?
'is-cat boolean?
+ 'lang string?
'pronouns pronoun-list?))
(define DEFAULT-PREFS
'((instance-url "https://myinstance.tld/")
(display-name "Display Name(tm)")
(name "username")
+ (title "My Shiny New Blog")
+ (lang "en")
(make-discoverable #t)
(is-cat #t)
(pronouns ("they" "them" "their" "theirs" "themselves"))))
+;; saves preferences to the given port (or current out)
(define (prefs-save prefs [port (current-output-port)])
(pretty-write prefs port))
+;; validates a preference entry against the schema
(define (validate-one k v)
(unless (hash-has-key? SCHEMA k)
(error "unknown preference name" k))
(unless (apply (hash-ref SCHEMA k) (list v))
(error "invalid preference value" v (hash-ref SCHEMA k))))
+;; validates a whole prefs object
(define (validate x)
(unless (list? x)
(error "preferences must be list"))
@@ -50,16 +61,20 @@
[(list k v) (validate-one k v)]
[_ (error "invalid preference")]))
x)
+;; check the defaults
(void (validate DEFAULT-PREFS))
+;; reads and validates preferences from the given port (or current in)
(define (prefs-load [port (current-input-port)])
(validate (read port)))
+;; finds a preference by name
(define (prefs-get prefs what)
(match prefs
[(list _ ... (list (? (curry symbol=? what)) value) _ ...) value]
[_ (error "no such pref" prefs what)]))
+;; updates one key/value pair in the preferences list
(define (prefs-update prefs key value)
(validate-one key value)
(define (upd p)
diff --git a/private/rules.rkt b/private/rules.rkt
index d2f8277..c533164 100644
--- a/private/rules.rkt
+++ b/private/rules.rkt
@@ -1,6 +1,7 @@
#lang racket
-;; static generation rules
+;; rules:
+;; the actual rules that generate the blog contents
(require json
net/url-string
@@ -11,6 +12,7 @@
"compile.rkt"
"prefs.rkt")
+;; actor context object
(define ACTOR-CONTEXT
(list "https://www.w3.org/ns/activitystreams"
"https://w3id.org/security/v1"
@@ -64,6 +66,7 @@
(reverse (cons (substring str last-pos) items))]))
(first (process+ xexpr)))
+;; creates the index.json file (an actor object for this blog)
(define compile-index-json
(rule '("db/actorkey.pub" "src/instance.rktd" "src/bio.md") "public/index.json"
(lambda (in out)
@@ -82,6 +85,7 @@
(match p
[(list a b _ ...) (format "~a/~a" a b)]
[_ "any"]))
+
(define actor (hash
'@context ACTOR-CONTEXT
'Type "Person"
@@ -92,35 +96,40 @@
'isCat (prefs-get prefs 'is-cat)
'pronouns (hash 'en (prefs-get prefs 'pronouns))
'icon (hash 'type "Image"
- 'url "something"
+ 'url "something" ;; TODO
'sensitive #f)
'image (hash 'type "Image"
- 'url "something"
+ 'url "something" ;; TODO
'sensitive #f)
'tag (for/list ([hashtag (in-set bio-hashtags)])
(hash 'type "Hashtag"
'href (string-append instance-url "tags/"
(substring hashtag 1))
'name hashtag))
- 'manuallyApprovesFollowers #f
+ 'manuallyApprovesFollowers #f ;; TODO
'summary bio
- 'attachment (list (hash 'type "PropertyValue"
+ 'attachment (list (hash 'type "PropertyValue" ;; TODO
'name "pronouns"
'value (render-pronouns)))
'url instance-url
'inbox (string-append instance-url "inbox")
'sharedInbox (string-append instance-url "inbox")
+ ;; there's only one inbox
'endpoints (hash 'sharedInbox (string-append instance-url "inbox"))
'outbox (string-append instance-url "outbox")
+ ;; currently we don't support actually following anyone
'following 'null
'followers (string-append instance-url "followers")
+ ;; liking posts is similarly not supported
'liked 'null
+ ;; TODO key rotation or something idk
'publicKey (hash 'id (string-append instance-url "#main-key")
'type "Key"
'owner instance-url
'publicKeyPem key)))
(write-json actor out))))
+;; builds the webfinger endpoint for the instance actor
(define compile-webfinger
(rule '("src/instance.rktd") "public/webfinger.json"
(lambda (in out)
@@ -137,7 +146,9 @@
'href instance-url))))
(write-json webfinger out))))
+;; generates render rules for each post that is present
(define (generate-post-render-rules)
+ ;; creates a rule that builds common post info into cache
(define (make-post-cache-rule post-src post-dst)
(rule `("src/instance.rktd" ,post-src) post-dst
(lambda (in out)
@@ -156,12 +167,14 @@
(s-exp->fasl
(hash 'is-meow (hash-ref src-meta 'is-meow #t)
'title (hash-ref src-meta 'title "unknown")
+ 'summary (hash-ref src-meta 'summary "unknown")
'date (hash-ref src-meta 'date '(0 0 0))
'hashtags (set->list hashtags)
'toc (toc post-htmls)
'content post-htmls))
out))))
+ ;; add all cache rules
(define-values [posts-set cache-set]
(for/fold ([posts (set)] [caches (set)]) ([post-name (in-list (directory-list "src/posts"))]
#:when (regexp-match? #px"\\.md$" post-name))
@@ -185,12 +198,14 @@
(write-bytes (s-exp->fasl (for/hash ([(k v) (in-hash index)])
(values k (set->list v)))) out)))))
+;; build the main blog css
(define compile-css
(rule '("src/style.sass") "public/style.css"
(lambda (in out)
(define str (port->string (hash-ref in "src/style.sass")))
(write-string (sass-compile/string str #t) out))))
+;; collect all compiler rules
(define compiler-rules
(set-union
(generate-post-render-rules)
diff --git a/private/taskq.rkt b/private/taskq.rkt
index cf208b0..07755ae 100644
--- a/private/taskq.rkt
+++ b/private/taskq.rkt
@@ -1,5 +1,10 @@
#lang racket
+;; taskq:
+;; infrastructure for a persistent task queue that guarantees each entry will execute to completion
+;; at least once. entries are responsible for implementing idempotency in the case of interrupted
+;; operations (due to a crash, for example)
+
(require db crypto racket/fasl)
(provide make-taskq taskq-shutdown taskq-enqueue taskq-dequeue taskq-complete taskq-resched)
diff --git a/scripts/init b/scripts/init
index 4f53588..83d151f 100755
--- a/scripts/init
+++ b/scripts/init
@@ -55,6 +55,27 @@
(void)))
(with-output-to-file "src/style.sass"
(lambda () (write-string "// styles go here :P\n") (void)))
+;; TODO index template
+(with-output-to-file "src/template-post.html"
+ (lambda ()
+ (write-string ;; TODO add more meta elements / semantic web type stuff
+ ;; add an embedded json-LD object maybe
+"
+
+
+
+
+
+ {{post.title}} &em; {{prefs.title}}
+
+
+
+ {{post.content}}
+
+
+"
+) (void)))
+
(make-directory "src/posts")
(make-directory "src/drafts")
diff --git a/scripts/new-post b/scripts/new-post
index 1e88c3b..080be18 100755
--- a/scripts/new-post
+++ b/scripts/new-post
@@ -24,6 +24,7 @@
(lambda ()
(pretty-write `((date (,(date-year now) ,(date-month now) ,(date-day now)))
(title ,name)
+ (summary "a new post on this blog")
(is-meow #t)))
(printf "\n# ~a\n\nHello world\n" name))))
(void))