diff options
Diffstat (limited to 'desk/lib/boke.hoon')
| -rw-r--r-- | desk/lib/boke.hoon | 207 |
1 files changed, 207 insertions, 0 deletions
diff --git a/desk/lib/boke.hoon b/desk/lib/boke.hoon new file mode 100644 index 0000000..aecfabb --- /dev/null +++ b/desk/lib/boke.hoon @@ -0,0 +1,207 @@ +/- *boke, tp=trill-post, c=tlon-channels +/+ sr=sortug, kaji, sigil=sigil-sigil, plib=trill-utils, ui=trill-ui, const=constants, kaji, cjk, wall +|% +:: state data structures +++ get-name +|= p=@p ^- tape +?: (lth p (bex 64)) + ?: (is-admin p) "Spandrell" + (scow %p p) +=/ oldie (sub p (bex 64)) +?: ((sane %t) oldie) (trip oldie) +"anon" + + + :: +++ tags-by-size +|= [tt=tags-table who=@p] ^- (list [@t count=@ud]) + =/ wal ~(. wall who) + =/ l %+ roll ~(tap by tt) |= [[tag=@t p=pidmap] acc=(list [@t @ud])] + ?. (tag-filter:wal tag) acc :_ acc + :- tag (wyt:porm:tp p) + %+ sort l |= [a=[tag=@t c=@ud] b=[tag=@t c=@ud]] + (gte c.a c.b) + +++ tags-by-date +|= [tt=tags-table who=@p] ^- (list [@t pidmap]) + =/ wal ~(. wall who) + =/ l %+ skim ~(tap by tt) |= [tag=@t *] (tag-filter:wal tag) + %+ sort l |= $: + a=[tag=@t pids=pidmap] + b=[tag=@t pids=pidmap] == + =/ first-a (pry:porm:tp pids.a) + =/ first-b (pry:porm:tp pids.b) + ?~ first-a .n + ?~ first-b .y + =/ id-a=@da +>.u.first-a + =/ id-b=@da +>.u.first-b + (gth id-a id-b) + + +++ is-admin +|= p=@p ^- ? +?| .=(p ~docteg-mothep) + .=((^sein:title p) ~docteg-mothep) +== +++ is-subscribed +|= p=@p ^- ? +?| (is-admin p) + (~(has in subscribers:const) p) +== +++ is-blog +|= t=thread:tp ^- ? + (~(has in tags.t) 'blog') +:: +++ get-path +|= [pat=path blog-view=? is-blog=?] ^- path +?: is-blog + ?: blog-view pat (weld /board/blog pat) + ?: blog-view (weld /blog/b pat) (weld /board pat) + +++ board-path +|= =thread:tp ^- path + ?. (is-blog thread) (weld /board path.thread) + (weld /board/blog path.thread) +++ blog-path +|= =thread:tp ^- path + ?: (is-blog thread) path.thread + (weld /blog/b path.thread) + +++ naive-board-path +|= [title=@t tags=(set @t)] ^- [@t @t] + =/ boards ~(key by categories:const) + =/ int (~(int in tags) boards) + =/ lint ~(tap in int) + =/ first-tag ?~ lint 'public' i.lint + =/ kebab (crip (enkebab3:string:sr title)) + [first-tag kebab] + +++ find-board-path +|= [pm=pathmap =post:tp] ^- tape + =/ max 5 + =/ [tag=@t kebab=@t] (naive-board-path title.post tags.post) + =/ pat=path [tag kebab ~] + =/ ok=? + =/ has (~(get by pm) pat) ?~ has .n + .=(u.has [author.post id.post]) + ?: ok (trip kebab) + =/ num 2 + |- + ?: .=(num max) "esc/{(enc:kaji [author.post id.post])}" + ~& incrementing-find-board-path=[title.post num] + =/ nclean (enkebab2:string:sr (cat 3 title.post (cat 3 '-' (scot %ud num)))) + =/ npat=path ~[(crip nclean)] + =/ ok=? + =/ has (~(get by pm) npat) ?~ has .n + .=(u.has [author.post id.post]) + ?: ok nclean + $(num +(num)) + +++ make-board-path +|= [pm=pathmap title=@t tags=(set @t)] ^- path + =/ [tag=@t kebab=@t] (naive-board-path title tags) + =/ pat=path [tag kebab ~] + =/ has (~(get by pm) pat) + ?~ has pat + =/ num 2 + |- + =/ nkebab (cat 3 kebab (cat 3 '-' (scot %ud num))) + =/ npat=path [tag nkebab ~] + =/ has (~(get by pm) npat) + ?~ has npat + $(num +(num)) + +:: ++ board-path +:: |= =post:tp ^- tape +:: =/ uid (scow:parsing:sr %uw (jam [author.post id.post])) +:: =/ title (enkebab2:string:sr title.post) +:: "{uid}--{title}" +++ title-to-path + |= [title=@t date=@da] ^- path + =/ pat1 (date-to-path:string:sr date) + =/ pat2 (enpath:string:sr title) + =/ pat-string %^ foldi:sr pat2 '' |= [i=@ud it=@t acc=@t] + =/ s=@t ?: .=(i (dec (lent pat2))) it + (rap 3 ~[it '-']) + =/ a=(list @t) ~[acc s] + (rap 3 a) + (weld pat1 ~[pat-string]) + +++ make-blogpost-path + |= [tim=@da t=@t] ^- path + =/ dat=path (date-to-path:string:sr tim) + (snoc dat (crip (enkebab2:string:sr t))) +:: +++ edit-post + |= [p=post:tp ncontents=content-list:tp tags=(set @t) now=@da] + ^- post:tp + =/ contents (put:corm:tp contents.p now ncontents) + %= p + contents contents + tags tags + == +++ build-thread +|= [title=@t =post:tp paths=pathmap is-blog=?] ^- thread:tp + =/ pat ?: is-blog + (make-blogpost-path id.post title) + (make-board-path paths title tags.post) + =/ snip-size ?: is-blog 500 200 + =/ snip (abbreviate-post:plib contents.post snip-size) + =| t=thread:tp + %= t + pid [author.post id.post] + title title + path pat + tags tags.post + snip snip + == +++ build-post + |= [contents=content-list:tp tags=(set @t) =pid:tp] + ^- post:tp + =/ contents (gas:corm:tp *content-map:tp [id.pid contents]~) + =/ p *post:tp + %= p + id id.pid + thread pid + author ship.pid + contents contents + tags tags + == +++ set-parents + |= [p=post:tp thread=pid:tp parent=pid:tp] + %= p + parent (some parent) + thread thread + == +++ random-avatar +|= hash=@ ^- tape +=/ top (dec (lent soyjaks:const)) +=/ ind (mod hash top) +=/ file (snag ind soyjaks:const) +"{s3.const}/soyjaks/{file}" + +++ is-anon +|= p=@p ^- ? +?= %pawn (clan:title p) +:: Fetch posts by tag or board + +++ post-date-ago +|= [d=@da now=@da length=?(%tam %yau)] ^- tape +=/ diff=@dr (sub now d) +?: (lth diff ~m1) %+ weld (scow:parsing:sr %ud (div diff ~s1)) +?: ?=(%tam length) "m" " seconds" +?: (lth diff ~h1) %+ weld (scow:parsing:sr %ud (div diff ~m1)) +?: ?=(%tam length) "m" " minutes" +?: (lth diff ~d1) %+ weld (scow:parsing:sr %ud (div diff ~h1)) +?: ?=(%tam length) "h" " hours" +?: (lth diff ~d30) %+ weld (scow:parsing:sr %ud (div diff ~d1)) +?: ?=(%tam length) "d" " days" +?: (lth diff ~d365) %+ weld (scow:parsing:sr %ud (div diff ~d30)) +?: ?=(%tam length) "mo" " months" + %+ weld (scow:parsing:sr %ud (div diff ~d365)) +?: ?=(%tam length) "y" " years" +++ last-reply +|= p=full-node:tp ^- (unit pid:tp) + =/ pry (pry:form:tp children.p) + ?~ pry ~ `key.u.pry +-- |