add comments, create post template

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

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)

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)

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)

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
+"<!DOCTYPE html>
+<html lang='{{prefs.lang}}'>
+<head>
+  <meta charset='UTF-8' />
+  <meta name='viewport' content='width=device-width, initial-scale=1' />
+  <meta name='description' content='{{post.summary}}'>
+  <title>{{post.title}} &em; {{prefs.title}}</title>
+</head>
+<body>
+  <article>
+    {{post.content}}
+  </article>
+</body>
+</html>"
+) (void)))
+
 (make-directory "src/posts")
 (make-directory "src/drafts")
 

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))