diff --git a/private/prefs.rkt b/private/prefs.rkt index 055e783..5fc5e3f 100644 --- a/private/prefs.rkt +++ b/private/prefs.rkt @@ -6,6 +6,7 @@ (define (instance-url? x) (and (string? x) + (char=? (last (string->list x)) #\/) (with-handlers ([exn? (lambda (e) #f)]) (let ([u (string->url x)]) (string=? "https" (url-scheme u)))))) diff --git a/private/rules.rkt b/private/rules.rkt index 9baeca3..f17e9b2 100644 --- a/private/rules.rkt +++ b/private/rules.rkt @@ -4,6 +4,8 @@ (require json net/url-string + markdown + markdown/toc "compile.rkt" "prefs.rkt") @@ -36,18 +38,49 @@ ;; yeah ok why not lol 'pronouns "awoo:pronouns"))) +;; transforms the xexpr into an xexpr that includes links to hashtags +(define (process-hashtags xexpr instance-url hashtags) + (define (process+ xexpr) + (match xexpr + [(list tag attrs children ...) + (list (cons tag (cons attrs + (apply append + (map (lambda (child) (process+ child)) children)))))] + [(? string? str) + (define posns (regexp-match-positions* #px"#(\\p{L}|\\p{N})+" str)) + (define-values [items last-pos] + (for/fold ([items '()] [last-pos 0]) ([pos (in-list posns)]) + (define hashtag (substring str (car pos) (cdr pos))) + (set-add! hashtags hashtag) + (values (cons `(a ((href ,(string-append + instance-url + "tags/" + (substring hashtag 1)))) + ,hashtag) + (cons (substring str last-pos (car pos)) items)) + (cdr pos)))) + (reverse (cons (substring str last-pos) items))])) + (first (process+ xexpr))) + + (define compile-index-json (rule '("db/actorkey.pub" "src/instance.rktd" "src/bio.md") "public/index.json" (lambda (in out) (define key (port->string (hash-ref in "db/actorkey.pub"))) (define prefs (prefs-load (hash-ref in "src/instance.rktd"))) - (define bio (port->string (hash-ref in "src/bio.md"))) + (define instance-url (prefs-get prefs 'instance-url)) + (define bio-md (port->string (hash-ref in "src/bio.md"))) + + (define bio-hashtags (mutable-set)) + (define bio-xs (map (lambda (b) (process-hashtags b instance-url bio-hashtags)) + (parse-markdown bio-md))) + (define bio (apply string-append (map xexpr->string bio-xs))) + (define (render-pronouns) (define p (prefs-get prefs 'pronouns)) (match p [(list a b _ ...) (format "~a/~a" a b)] [_ "any"])) - (define instance-url (prefs-get prefs 'instance-url)) (define actor (hash '@context ACTOR-CONTEXT 'Type "Person" @@ -63,9 +96,11 @@ 'image (hash 'type "Image" 'url "something" 'sensitive #f) - 'tag (list (hash 'type "Hashtag" - 'href (string-append instance-url "tags/blahaj") - 'name "#blahaj")) + 'tag (for/list ([hashtag (in-set bio-hashtags)]) + (hash 'type "Hashtag" + 'href (string-append instance-url "tags/" + (substring hashtag 1)) + 'name hashtag)) 'manuallyApprovesFollowers #f 'summary bio 'attachment (list (hash 'type "PropertyValue"