haskal
/
chomp
2
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Render bio

This commit is contained in:
xenia 2020-05-05 00:16:46 -04:00
parent 8814e642f2
commit 4fe95783b2
2 changed files with 41 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
private/prefs.rkt
View File

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

45
private/rules.rkt
View File

@ -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"