diff --git a/app/proxy.hoon b/app/proxy.hoon new file mode 100644 index 0000000..52b3bc9 --- /dev/null +++ b/app/proxy.hoon @@ -0,0 +1,751 @@ +/- spider +/+ libstrand=strand, default-agent, verb, server, dbug +=, strand=strand:libstrand +~% %spider-top ..part ~ +|% ++$ card card:agent:gall ++$ thread thread:spider ++$ tid tid:spider ++$ input input:spider ++$ yarn (list tid) ++$ thread-form _*eval-form:eval:(strand ,vase) ++$ trying ?(%build %none) ++$ state + $: starting=(map yarn [=trying =vase]) + running=(axal thread-form) + tid=(map tid yarn) + serving=(map tid [(unit [rid=@ta take=?(%json %noun)]) =mark =desk]) + scrying=(jug tid [=wire =ship =path]) + == +:: ++$ clean-slate-any + $^ clean-slate-ket + $% clean-slate-sig + clean-slate-1 + clean-slate-2 + clean-slate-3 + clean-slate-4 + clean-slate-5 + clean-slate-6 + clean-slate + == +:: ++$ clean-slate + $: %7 + starting=(map yarn [=trying =vase]) + running=(list yarn) + tid=(map tid yarn) + serving=(map tid [(unit [rid=@ta take=?(%json %noun)]) =mark =desk]) + scrying=(jug tid [wire ship path]) + == +:: ++$ clean-slate-6 + $: %6 + starting=(map yarn [=trying =vase]) + running=(list yarn) + tid=(map tid yarn) + serving=(map tid [(unit @ta) =mark =desk]) + scrying=(jug tid [wire ship path]) + == +:: ++$ clean-slate-5 + $: %5 + starting=(map yarn [=trying =vase]) + running=(list yarn) + tid=(map tid yarn) + serving=(map tid [(unit @ta) =mark =desk]) + scrying=(map tid [ship path]) + == +:: ++$ clean-slate-4 + $: %4 + starting=(map yarn [=trying =vase]) + running=(list yarn) + tid=(map tid yarn) + serving=(map tid [(unit @ta) =mark =desk]) + == +:: ++$ clean-slate-3 + $: %3 + starting=(map yarn [=trying =vase]) + running=(list yarn) + tid=(map tid yarn) + serving=(map tid [@ta =mark =desk]) + == +:: ++$ clean-slate-2 + $: %2 + starting=(map yarn [=trying =vase]) + running=(list yarn) + tid=(map tid yarn) + serving=(map tid [@ta =mark]) + == +:: ++$ clean-slate-1 + $: %1 + starting=(map yarn [=trying =vase]) + running=(list yarn) + tid=(map tid yarn) + == +:: ++$ clean-slate-ket + $: starting=(map yarn [trying=?(%build %find %none) =vase]) + running=(list yarn) + tid=(map tid yarn) + == +:: ++$ clean-slate-sig + $: starting=~ + running=(list yarn) + tid=(map tid yarn) + == +-- +:: +%- agent:dbug +^- agent:gall +=| =state +=< + %+ verb | + ~% %spider-agent ..bind-eyre ~ + |_ =bowl:gall + +* this . + spider-core +> + sc ~(. spider-core bowl) + def ~(. (default-agent this %|) bowl) + bec byk.bowl(r da+now.bowl) + :: + ++ on-init + ^- (quip card _this) + :_ this + ~[bind-eyre:sc] + ++ on-save clean-state:sc + ++ on-load + |^ + |= old-state=vase + =+ !<(any=clean-slate-any old-state) + =? any ?=(^ -.any) (old-to-1 any) + =? any ?=(~ -.any) (old-to-1 any) + =^ upgrade-cards any + (old-to-2 any) + =. any (old-to-3 any) + =. any (old-to-4 any) + =. any (old-to-5 any) + =. any (old-to-6 any) + =. any (old-to-7 any) + ?> ?=(%7 -.any) + :: + =. tid.state tid.any + =/ yarns=(list yarn) + %+ welp running.any + ~(tap in ~(key by starting.any)) + |- ^- (quip card _this) + ?~ yarns + [~[bind-eyre:sc] this] + =^ cards-1 state + %. [(yarn-to-tid i.yarns) nice=%.n] + :: the |sc core needs to now about the previous + :: scrying state in order to send $yawns to %ames + :: + %*(handle-stop-thread sc scrying.state scrying.any) + =^ cards-2 this + $(yarns t.yarns) + [:(weld upgrade-cards cards-1 cards-2) this] + :: + ++ old-to-1 + |= old=clean-slate-ket + ^- clean-slate-1 + 1+old(starting (~(run by starting.old) |=([* v=vase] none+v))) + :: + ++ old-to-2 + |= old=clean-slate-any + ^- (quip card clean-slate-any) + ?> ?=(?(%1 %2 %3 %4 %5 %6 %7) -.old) + ?: ?=(?(%2 %3 %4 %5 %6 %7) -.old) + `old + :- ~[bind-eyre:sc] + :* %2 + starting.old + running.old + tid.old + ~ + == + :: + ++ old-to-3 + |= old=clean-slate-any + ^- clean-slate-any + ?> ?=(?(%2 %3 %4 %5 %6 %7) -.old) + ?: ?=(?(%3 %4 %5 %6 %7) -.old) + old + :* %3 + starting.old + running.old + tid.old + (~(run by serving.old) |=([id=@ta =mark] [id mark q.byk.bowl])) + == + :: + ++ old-to-4 + |= old=clean-slate-any + ^- clean-slate-any + ?> ?=(?(%3 %4 %5 %6 %7) -.old) + ?: ?=(?(%4 %5 %6 %7) -.old) + old + :* %4 + starting.old + running.old + tid.old + (~(run by serving.old) |=([id=@ta =mark =desk] [`id mark q.byk.bowl])) + == + :: + ++ old-to-5 + |= old=clean-slate-any + ^- clean-slate-any + ?> ?=(?(%4 %5 %6 %7) -.old) + ?: ?=(?(%5 %6 %7) -.old) old + [%5 +.old(serving [serving.old ~])] + :: + ++ old-to-6 + |= old=clean-slate-any + ^- clean-slate-any + ?> ?=(?(%5 %6 %7) -.old) + ?: ?=(?(%6 %7) -.old) old + :- %6 + %= +.old + scrying + %- ~(run by scrying.old) + |= [=ship =path] + %- ~(gas in *(set [wire ^ship ^path])) + :: XX +keen:strandio used /keen as the default wire + :: this assumes that any old thread used that as well + :: + [/keen ship path]~ + == + :: + ++ old-to-7 + |= old=clean-slate-any + ^- clean-slate-any + ?> ?=(?(%6 %7) -.old) + ?: ?=(%7 -.old) old + =- old(- %7, serving -) + %- ~(run by serving.old) + |= [request=(unit @ta) =mark =desk] + [(bind request (late %json)) mark desk] + -- + :: + ++ on-poke + ~/ %on-poke + |= [=mark =vase] + ^- (quip card _this) + :: ?> (team:title [our src]:bowl) + ?: ?=(%spider-kill mark) + (on-load on-save) + =^ cards state + ?+ mark (on-poke:def mark vase) + %spider-input (on-poke-input:sc !<(input vase)) + %spider-start (handle-start-thread:sc !<(start-args:spider vase)) + %spider-inline (handle-inline-thread:sc !<(inline-args:spider vase)) + %spider-stop (handle-stop-thread:sc !<([tid ?] vase)) + %handle-http-request + (handle-http-request:sc !<([@ta =inbound-request:eyre] vase)) + == + [cards this] + :: + ++ on-watch + ~/ %on-watch + |= =path + ^- (quip card _this) + =^ cards state + ?+ path (on-watch:def path) + [%thread @ *] (on-watch:sc t.path) + [%thread-result @ ~] (on-watch-result:sc i.t.path) + [%http-response *] `state + == + [cards this] + :: + ++ on-leave on-leave:def + ++ on-peek + ~/ %on-peek + |= =path + ^- (unit (unit cage)) + ?+ path (on-peek:def path) + [%x %tree ~] + ``noun+!>((turn ~(tap of running.state) head)) + :: + [%x %starting @ ~] + ``noun+!>((~(has of running.state) (~(got by tid.state) i.t.t.path))) + :: + [%x %saxo @ ~] + ``noun+!>((~(got by tid.state) i.t.t.path)) + == + :: + ++ on-agent + ~/ %on-agent + |= [=wire =sign:agent:gall] + ^- (quip card _this) + =^ cards state + ?+ wire !! + [%thread @ *] (on-agent:sc i.t.wire t.t.wire sign) + == + [cards this] + :: + ++ on-arvo + ~/ %on-arvo + |= [=wire =sign-arvo] + ^- (quip card _this) + =^ cards state + ?+ wire (on-arvo:def wire sign-arvo) + [%thread @ *] (handle-sign:sc i.t.wire t.t.wire sign-arvo) + [%build @ ~] (handle-build:sc i.t.wire sign-arvo) + [%bind ~] `state + == + [cards this] + :: On unexpected failure, kill all outstanding strands + :: + ++ on-fail + |= [=term =tang] + ^- (quip card _this) + %- (slog leaf+"spider crashed, killing all strands: {}" tang) + (on-load on-save) + -- +:: +~% %spider-helper ..card ~ +|_ =bowl:gall +++ bec `beak`byk.bowl(r da+now.bowl) +++ bind-eyre + ^- card + [%pass /bind %arvo %e %connect [~ /kumo] %proxy] +:: +++ new-thread-id + |= file=term + :((cury cat 3) file '--' (scot %uv (sham eny.bowl))) +:: +++ handle-http-request + ~/ %handle-http-request + |= [eyre-id=@ta =inbound-request:eyre] + ^- (quip card _state) + :: ?> authenticated.inbound-request + =/ url + (parse-request-line:server url.request.inbound-request) + ?> ?=([%kumo @t @t @t @t ~] site.url) + =* desk i.t.site.url + =* input-mark i.t.t.site.url + =* thread i.t.t.t.site.url + =* output-mark i.t.t.t.t.site.url + :: TODO: speed this up somehow. we spend about 15ms in this arm alone + :: + ?> ?=(^ body.request.inbound-request) + =/ test=$-(@t ?(%json %noun)) + |= head=@t + =; type=(unit @t) + ?:(=(`'application/x-urb-jam' type) %noun %json) + %+ bind + (get-header:http head header-list.request.inbound-request) + :(cork trip cass crip) + =/ give (test 'content-type') + =/ take (test 'accept') + :: + =/ =tid (new-thread-id thread) + =. serving.state + (~(put by serving.state) tid [`[eyre-id take] output-mark desk]) + :: + =/ input=vase + %+ slop !>(~) + ?- give + %json + =/ tube (convert-tube %json input-mark desk bowl) + =/ body=json (need (de:json:html q.u.body.request.inbound-request)) + (tube !>(body)) + :: + %noun + =/ tube (convert-tube %noun input-mark desk bowl) + =/ body=noun (cue q.u.body.request.inbound-request) + (tube !>(body)) + == + =/ boc bec + =/ =start-args:spider [~ `tid boc(q desk, r da+now.bowl) thread input] + (handle-start-thread start-args) +:: +++ on-poke-input + |= input + =/ yarn (~(got by tid.state) tid) + (take-input yarn ~ %poke cage) +:: +++ on-watch + |= [=tid =path] + (take-input (~(got by tid.state) tid) ~ %watch path) +:: +++ on-watch-result + |= =tid + ^- (quip card ^state) + `state +:: +++ handle-sign + ~/ %handle-sign + |= [=tid =wire =sign-arvo] + =/ yarn (~(get by tid.state) tid) + ?~ yarn + %- (slog leaf+"spider got sign for non-existent {}" ~) + `state + (take-input u.yarn ~ %sign wire sign-arvo) +:: +++ on-agent + |= [=tid =wire =sign:agent:gall] + =/ yarn (~(get by tid.state) tid) + ?~ yarn + %- (slog leaf+"spider got agent for non-existent {}" ~) + `state + (take-input u.yarn ~ %agent wire sign) +:: +++ handle-start-thread + ~/ %handle-start-thread + |= [parent-tid=(unit tid) use=(unit tid) =beak file=term =vase] + (prep-thread parent-tid use beak %| file vase) +:: +++ handle-inline-thread + ~/ %handle-inline-thread + |= [parent-tid=(unit tid) use=(unit tid) =beak =shed:khan] + (prep-thread parent-tid use beak %& shed) +:: +++ prep-thread + |= $: parent-tid=(unit tid) use=(unit tid) =beak + source=(each shed:khan [file=term =vase]) + == + ^- (quip card ^state) + =/ parent-yarn=yarn + ?~ parent-tid + / + (~(got by tid.state) u.parent-tid) + =/ new-tid + ?^ use + u.use + %- new-thread-id + ?- -.source + %& (cat 3 'inline-' q.beak) + %| file.p.source + == + :: + =/ =yarn (snoc parent-yarn new-tid) + :: + ?: (~(has of running.state) yarn) + ~| [%already-started yarn] + !! + ?: (~(has by starting.state) yarn) + ~| [%already-starting yarn] + !! + :: + =? serving.state !(~(has by serving.state) new-tid) + (~(put by serving.state) new-tid [~ %noun q.beak]) + :: + =. tid.state (~(put by tid.state) new-tid yarn) + ?- -.source + %& (begin-shed yarn p.source) + %| + =. starting.state (~(put by starting.state) yarn [%build vase.p.source]) + =/ pax=path + ~| no-file-for-thread+file.p.source + (need (get-fit:clay beak %ted file.p.source)) + :_ state + :_ ~ + :+ %pass /build/[new-tid] + [%arvo %c %warp p.beak q.beak ~ %sing %a r.beak pax] + == +:: +++ handle-build + ~/ %handle-build + |= [=tid =sign-arvo] + ^- (quip card ^state) + =/ =yarn (~(got by tid.state) tid) + =. starting.state + (~(jab by starting.state) yarn |=([=trying =vase] [%none vase])) + ~| sign+[- +<]:sign-arvo + ?> ?=([?(%behn %clay) %writ *] sign-arvo) + =/ =riot:clay p.sign-arvo + ?~ riot + (thread-fail-not-running tid %build-thread-error *tang) + ?. ?=(%vase p.r.u.riot) + (thread-fail-not-running tid %build-thread-strange >[p q]:u.riot< ~) + =/ maybe-thread (mule |.(!<(thread !<(vase q.r.u.riot)))) + ?: ?=(%| -.maybe-thread) + (thread-fail-not-running tid %thread-not-thread ~) + (slam-thread yarn p.maybe-thread) +:: +++ slam-thread + ~/ %slam-thread + |= [=yarn =thread] + ^- (quip card ^state) + =/ =vase vase:(~(got by starting.state) yarn) + =/ res (mule |.((thread vase))) + ?: ?=(%| -.res) + (thread-fail-not-running (yarn-to-tid yarn) %false-start p.res) + =. starting.state (~(del by starting.state) yarn) + (begin-shed yarn p.res) +:: +++ begin-shed + |= [=yarn =shed:khan] + ?< (~(has of running.state) yarn) + =/ m (strand ,vase) + =/ =eval-form:eval:m (from-form:eval:m shed) + =. running.state (~(put of running.state) yarn eval-form) + (take-input yarn ~) +:: +++ handle-stop-thread + |= [=tid nice=?] + ^- (quip card ^state) + =/ yarn=(unit yarn) (~(get by tid.state) tid) + ?~ yarn + ~& %stopping-nonexistent-thread + [~ state] + ?: (~(has of running.state) u.yarn) + ?. nice + (thread-fail u.yarn %cancelled ~) + =^ done-cards state (thread-done u.yarn *vase silent=%.n) + [done-cards state] + ?: (~(has by starting.state) u.yarn) + (thread-fail-not-running tid %stopped-before-started ~) + ~& [%thread-not-started u.yarn] + ?: nice + (thread-done u.yarn *vase silent=%.y) + (thread-fail u.yarn %cancelled ~) +:: +++ take-input + ~/ %take-input + |= [=yarn input=(unit input:strand)] + ^- (quip card ^state) + =/ m (strand ,vase) + ?. (~(has of running.state) yarn) + %- (slog leaf+"spider got input for non-existent {}" ~) + `state + =/ =eval-form:eval:m + (need fil:(~(dip of running.state) yarn)) + =| cards=(list card) + |- ^- (quip card ^state) + =^ r=[cards=(list card) =eval-result:eval:m] eval-form + =/ out + %- mule |. + (take:eval:m eval-form (convert-bowl yarn bowl) input) + ?- -.out + %& p.out + %| [[~ [%fail %crash p.out]] eval-form] + == + =. running.state (~(put of running.state) yarn eval-form) + =/ =tid (yarn-to-tid yarn) + =^ new-cards state + ^- [(list card) _state] + %+ roll cards.r + |= [=card cards=(list card) s=_state] + :_ =? scrying.s ?=([%pass ^ %arvo %a %keen ?(~ ^) @ *] card) + :: &2=wire &7=ship 7|=path + (~(put ju scrying.s) tid [&2 &7 |7]:card) + s + :_ cards + ^- ^card + ?+ card card + [%pass * *] [%pass [%thread tid p.card] q.card] + [%give ?(%fact %kick) *] + =- card(paths.p -) + %+ turn paths.p.card + |= =path + ^- ^path + [%thread tid path] + == + =. cards (weld cards (flop new-cards)) + =^ final-cards=(list card) state + ?- -.eval-result.r + %next `state + %fail (thread-fail yarn err.eval-result.r) + %done (thread-done yarn value.eval-result.r silent=%.y) + == + [(weld cards final-cards) state] +:: +++ thread-fail-not-running + |= [=tid =term =tang] + ^- (quip card ^state) + =/ =yarn (~(got by tid.state) tid) + :_ state(starting (~(del by starting.state) yarn)) + =/ moz (thread-say-fail tid term tang) + ?. ?=([~ %build *] (~(get by starting.state) yarn)) + moz + :_(moz [%pass /build/[tid] %arvo %c %warp our.bowl %base ~]) +:: +++ thread-say-fail + |= [=tid =term =tang] + ^- (list card) + :~ [%give %fact ~[/thread-result/[tid]] %thread-fail !>([term tang])] + [%give %kick ~[/thread-result/[tid]] ~] + == +:: +++ cancel-scry + |= [=tid silent=?] + ^- (quip card _state) + ?~ scrying=(~(get ju scrying.state) tid) + `state + :_ state(scrying (~(del by scrying.state) tid)) + ?: silent ~ + %- ~(rep in `(set [wire ship path])`scrying) + |= [[=wire =ship =path] cards=(list card)] + %- (slog leaf+"cancelling {}: [{<[wire ship path]>}]" ~) + :_ cards + [%pass (welp /thread/[tid] wire) %arvo %a %yawn ship path] +:: +++ thread-http-fail + |= [=tid =term =tang] + ^- (quip card ^state) + =- (fall - `state) + %+ bind + (~(get by serving.state) tid) + |= [request=(unit [rid=@ta take=?(%json %noun)]) output=mark =desk] + :_ state(serving (~(del by serving.state) tid)) + ?~ request + ~ + %+ give-simple-payload:app:server rid.u.request + ^- simple-payload:http + ?. ?=(http-error:spider term) + %- (slog tang) + ?- take.u.request + %json + =/ tube (convert-tube %tang %json desk bowl) + :- [500 [['content-type' 'application/json'] ~]] + =- `(as-octs:mimes:html (en:json:html -)) + o/(malt `(list [key=@t json])`[term+s/term tang+!<(json (tube !>(tang))) ~]) + :: + %noun + :- [500 [['content-type' 'application/x-urb-jam'] ~]] + `(as-octs:mimes:html (jam [term tang])) + == + :_ ~ :_ ~ + ?- term + %bad-request 400 + %forbidden 403 + %nonexistent 404 + %offline 504 + == +:: +++ thread-fail + |= [=yarn =term =tang] + ^- (quip card ^state) + ::%- (slog leaf+"strand {} failed" leaf+ tang) + =/ =tid (yarn-to-tid yarn) + =/ fail-cards (thread-say-fail tid term tang) + =^ http-cards state (thread-http-fail tid term tang) + =^ scry-card state (cancel-scry tid silent=%.n) + =^ cards state (thread-clean yarn) + :_ state + :(weld fail-cards cards http-cards scry-card) +:: +++ thread-http-response + |= [=tid =vase] + ^- (quip card ^state) + =- (fall - `state) + %+ bind + (~(get by serving.state) tid) + |= [request=(unit [rid=@ta take=?(%json %noun)]) output=mark =desk] + ?~ request + `state + ?- take.u.request + %json + =/ tube (convert-tube output %json desk bowl) + :_ state(serving (~(del by serving.state) tid)) + %+ give-simple-payload:app:server rid.u.request + (json-response:gen:server !<(json (tube vase))) + :: + %noun + :_ state(serving (~(del by serving.state) tid)) + %+ give-simple-payload:app:server rid.u.request + :- [200 ['content-type' 'application/x-urb-jam']~] + `(as-octs:mimes:html (jam q.vase)) + == +:: +++ thread-done + |= [=yarn =vase silent=?] + ^- (quip card ^state) + :: %- (slog leaf+"strand {} finished" (sell vase) ~) + =/ =tid (yarn-to-tid yarn) + =/ done-cards=(list card) + :~ [%give %fact ~[/thread-result/[tid]] %thread-done vase] + [%give %kick ~[/thread-result/[tid]] ~] + == + =^ http-cards state + (thread-http-response tid vase) + =^ scry-card state (cancel-scry tid silent) + =^ cards state (thread-clean yarn) + [:(weld done-cards cards http-cards scry-card) state] +:: +++ thread-clean + |= =yarn + ^- (quip card ^state) + =/ children=(list ^yarn) + %+ turn + ~(tap of (~(dip of running.state) yarn)) + |= [child=^yarn *] + (welp yarn child) + |- ^- (quip card ^state) + ?~ children + `state + =^ cards-children state $(children t.children) + =^ cards-our state + =/ =^yarn i.children + =/ =tid (yarn-to-tid yarn) + =: running.state (~(lop of running.state) yarn) + tid.state (~(del by tid.state) tid) + serving.state (~(del by serving.state) (yarn-to-tid yarn)) + == + :_ state + %+ murn ~(tap by wex.bowl) + |= [[=wire =ship =term] [acked=? =path]] + ^- (unit card) + ?. ?& ?=([%thread @ *] wire) + =(tid i.t.wire) + == + ~ + `[%pass wire %agent [ship term] %leave ~] + [(welp cards-children cards-our) state] +:: +++ convert-bowl + |= [=yarn =bowl:gall] + ^- bowl:spider + :* our.bowl + src.bowl + (yarn-to-tid yarn) + (yarn-to-parent yarn) + wex.bowl + sup.bowl + eny.bowl + now.bowl + (yarn-to-byk yarn bowl) + == +:: +++ yarn-to-tid + |= =yarn + ^- tid + =/ nary (flop yarn) + ?> ?=([@ *] nary) + i.nary +:: +++ yarn-to-parent + |= =yarn + ^- (unit tid) + =/ nary (flop yarn) + ?> ?=([@ *] nary) + ?~ t.nary + ~ + `i.t.nary +:: +++ yarn-to-byk + |= [=yarn =bowl:gall] + =/ [* * =desk] + ~| "no desk associated with {}" + %- ~(got by serving.state) (yarn-to-tid yarn) + =/ boc bec + boc(q desk) +:: +++ clean-state + !> ^- clean-slate + 7+state(running (turn ~(tap of running.state) head)) +:: +++ convert-tube + |= [from=mark to=mark =desk =bowl:gall] + .^ + tube:clay + %cc + /(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to] + == +-- diff --git a/app/ustj.hoon b/app/ustj.hoon index 75504f0..f4daf91 100644 --- a/app/ustj.hoon +++ b/app/ustj.hoon @@ -1,5 +1,5 @@ /- *forum -/+ dbug, lib=forum, const=constants +/+ dbug, sr=sortug, lib=forum, const=constants, seeds, cacher /= router /web/router |% ++ card card:agent:gall @@ -17,6 +17,8 @@ |_ =bowl:gall +* this . hd ~(. +> [state bowl]) + rout ~(. router:router [state bowl]) + cache ~(. cacher [state bowl]) ++ on-fail |~(* `this) ++ on-leave |~(* `this) ++ on-save !>(state) @@ -40,53 +42,131 @@ == ++ on-poke-noun |= a=* + ?: ?=([%ui *] a) (handle-ui a) + ?: ?=([%cache *] a) (handle-cache +.a) + ?: ?=(%test a) test ?: ?=(%print a) print - ?: ?=(%seed a) seed + ?: ?=(%seed a) teds:seed + ?: ?=(%seed2 a) coms:seed + ?: ?=(%seed3 a) reps:seed + ~& wtf=a + `this + ++ handle-cache |= a=* :_ this + =/ which ($?(%root %ted %sta %all) a) + ?- which + %root :~(cache-root:cache) + %sta cache-static:cache + %ted cache-threads:cache + %all cache-all:cache + == + ++ handle-ui |= noun=* + =^ cards state (handle-ui:cache noun) + [cards this] + ++ test + =/ teds (tap:torm threads) + ~& teds=(lent teds) + =/ coms (tap:gorm:tp comments) + ~& coms=(lent coms) `this ++ print ~& > state=state `this ++ seed - =/ authors=(list @p) :~ - ~zod - ~polwex - ~lagrev-nocfep - ~lagrev-nocfep - == - =/ titles=(list @t) - :~ - 'Helldivers 2 has caused over 20k Steam accounts to be banned' - 'UI elements with a hand-drawn, sketchy look' - '60 kHz (2022)' - 'Show HN: Every mountain, building and tree shadow mapped for any date and time' - 'Snowflake breach: Hacker confirms access through infostealer infection' - 'Heroku Postgres is now based on AWS Aurora' - 'Armor from Mycenaean Greece turns out to have been effective' - 'Why is no Laravel/Rails in JavaScript? Will there be one?' - 'Moving Beyond Type Systems' - 'Japanese \'My Number Card\' Digital IDs Coming to Apple\'s Wallet App' - 'How to copy a file from a 30-year-old laptop' - '(some) good corporate engineering blogs are written' - 'Debian KDE: Right Linux distribution for professional digital painting in 2024' - 'Go: Sentinel errors and errors.Is() slow your code down by 3000%' - '"Moveable Type" to end 17-year run in The New York Times\'s lobby' - 'London\'s Evening Standard axes daily print edition' - == =/ rng ~(. og eny.bowl) - |- ?~ titles `this - =^ r1 rng (rads:rng 1) - ~& >> rng=rng - =/ r (rad:rng 3) - =/ =content ?: .=(0 r1) - [%link 'https://urbit.org'] [%text ~] - =/ author (snag r authors) - =/ date (sub now.bowl (mul ~h1 (rad:rng 500))) - =/ ted (build-thread:lib i.titles author date content) - =/ tally (new:si [(? r1) (rad:rng 1.000)]) - =. ted ted(votes [tally ~]) - =. threads (put:torm threads [author date] ted) - + |% + ++ teds + =/ titles titles:seeds + =. state + |- ?~ titles state + =^ r1 rng (rads:rng 100) + =/ coinflip=? (lte 50 r1) + =/ =content ?: coinflip + =/ ind (rad:rng (lent links:seeds)) + =/ url (snag ind links:seeds) + [%link url] + =/ ind (rad:rng (lent md:seeds)) + =/ md (snag ind md:seeds) + =/ cl (build-content:lib md) + [%text cl] + =/ author + =/ ind (rad:rng (lent authors:seeds)) + (snag ind authors.seeds) + =/ date (sub now.bowl (mul ~h1 (rad:rng 500))) + =/ ted (build-thread:lib i.titles author date content) + =/ tally (new:si [coinflip (rad:rng 1.000)]) + =. ted ted(votes [tally ~]) + =. threads (put:torm threads [author date] ted) $(titles t.titles) + :_ this cache-all:cache + ++ reps + =/ coml (tap:gorm:tp comments) + =^ r rng (rads:rng 100) + =. state + |- ?~ coml state + =/ com=comment:tp +.i.coml + =/ ppid [author.com id.com] + =^ r0 rng (rads:rng 300) + =/ subcoms (make-seed-comments thread.com ppid) + =. state (save-replies subcoms com) + $(coml t.coml) + :_ this cache-all:cache + ++ coms + =/ tedl (tap:torm threads) + =^ r rng (rads:rng 100) + =. state + |- ?~ tedl state + =/ ted=thread +.i.tedl + =^ r0 rng (rads:rng 30) + :: important!! renew the rng before every function call + =/ coms (make-seed-comments pid.ted pid.ted) + =. state (save-comments coms ted) + $(tedl t.tedl) + :_ this cache-all:cache + + ++ save-replies |= [cl=(list comment:tp) par=comment:tp] ^+ state + |- ?~ cl state + =/ c i.cl + =/ cpid=pid:tp [author.c id.c] + =. comments (put:gorm:tp comments cpid c) + =/ nc (~(put in children.par) cpid) + =. par par(children nc) + =/ ppid [author.par id.par] + =. comments (put:gorm:tp comments ppid par) + $(cl t.cl) + + ++ save-comments |= [cl=(list comment:tp) ted=thread] ^+ state + |- ?~ cl state + =/ c i.cl + =/ cpid=pid:tp [author.c id.c] + =. comments (put:gorm:tp comments cpid c) + =/ nr [cpid replies.ted] + =/ nted ted(replies nr) + =. threads (put:torm threads pid.ted nted) + $(cl t.cl, ted nted) + + ++ make-seed-comments |= [tpid=pid:tp ppid=pid:tp] + =| coms=(list comment:tp) + =^ r0 rng (rads:rng 30) + :: ~& >> r0=r0 + =/ l (gulf 0 r0) + |- ?~ l coms + =^ r1 rng (rads:rng 100) + :: ~& r1=r1 + =/ coinflip=? (lte 50 r1) + =/ content + =/ ind (rad:rng (lent md:seeds)) + =/ md (snag ind md:seeds) + (build-content:lib md) + =/ author + =/ ind (rad:rng (lent authors:seeds)) + (snag ind authors.seeds) + =/ date (sub now.bowl (mul ~h1 (rad:rng 500))) + =. bowl bowl(src author, now date) + =/ com (build-comment:lib content bowl tpid ppid) + =/ tally (new:si [coinflip (rad:rng 1.000)]) + =. com com(votes [tally ~]) + $(l t.l, coms [com coms]) + -- :: ++ serve ^- (quip card _this) @@ -95,8 +175,7 @@ =/ address address.req.order :: ?: (~(has in banned.admin) address) `this :: ~& >>> malicious-request-alert=req.order `this - :_ this - %- route:router [order state bowl] + :_ this (eyre:rout order) -- ++ on-peek |= =(pole knot) ~ @@ -107,9 +186,10 @@ -- :: helper |_ [s=versioned-state =bowl:gall] -++ cache-card |= [pathc=@t pl=simple-payload:http] ^- card - =/ entry=cache-entry:eyre [.n %payload pl] - [%pass /root %arvo %e %set-response pathc `entry] +:: ++ static-caches ^- (list card) +:: :~ (cache-card '/forum/new-thread' (render:rout '/new-thread')) +:: :: (cache-card '/forum/new-thread') +:: == ++ root-path-card ^- card [%pass /root %arvo %e %connect [~ /forum] dap.bowl] ++ init-cards ^- (list card) diff --git a/desk.bill b/desk.bill index 7804e1c..af1f7d4 100644 --- a/desk.bill +++ b/desk.bill @@ -1,2 +1,3 @@ :~ %ustj + %proxy == diff --git a/lib/cacher.hoon b/lib/cacher.hoon new file mode 100644 index 0000000..c5c3530 --- /dev/null +++ b/lib/cacher.hoon @@ -0,0 +1,196 @@ +/- sur=forum, tp=post +/+ lib=forum, sr=sortug, cons=constants +/= router /web/router +|_ [state:sur bowl:gall] ++* this . + rout ~(. router:router +6) + state -.+6 + bowl +.+6 ++$ card card:agent:gall +++ handle-ui +|= noun=* ^- [(list card) _state] + =/ poke (pokes:sur noun) + ~& ui-poke=poke + =/ eyre-id eyre-id.poke + |^ + ?- -.p.poke + %submit-thread (handle-thread +.p.poke) + %submit-comment (handle-comment +.p.poke) + %submit-reply (handle-reply +.p.poke) + %vote (handle-vote +.p.poke) + == + ++ handle-thread |= [title=@t url=@t text=@t] + =/ =content:sur ?. .=('' url) [%link url] [%text (build-content:lib text)] + =/ ted (build-thread:lib title src now content) + =. state (save-ted ted) + :_ state :+ + cache-root + (cache-ted ted) + (redirect-ted ted) + + + ++ handle-comment |= [ted=thread:sur text=@t] + =/ cont (build-content:lib text) + =/ com (build-comment:lib cont bowl pid.ted pid.ted) + =. state (save-com com ted) + :_ state :+ + cache-root + (cache-ted ted) + (redirect-ted ted) + + + + ++ handle-reply |= [par=comment:tp text=@t] + =/ cont (build-content:lib text) + =/ ppid [author.par id.par] + =/ com (build-comment:lib cont bowl thread.par ppid) + =/ ted (get-thread:lib thread.par state) + ?~ ted `state + =. state (save-rep com par) + :_ state :* + cache-root + (cache-ted u.ted) + (cache-com com) + (cache-com par) + (redirect-com par) + == + ++ handle-vote |= [is-ted=? =pid:tp vote=?] + ~& handling-vote=[is-ted pid vote] + ?: is-ted + (handle-ted-vote pid vote) + (handle-com-vote pid vote) + ++ handle-ted-vote |= [=pid:tp vote=?] + =/ votesi=@si (new:si vote 1) + =/ uted (get-thread:lib pid state) + ?~ uted `state + =/ ted u.uted + =/ v votes.ted + =/ nv %= v + tally (sum:si tally.v votesi) + leger (~(put by leger.v) src.bowl vote) + == + =. ted ted(votes nv) + =. state (save-ted ted) + =. state (save-karma ship.pid.ted vote) + :_ state :~ + cache-root + (cache-ted ted) + (cache-user ship.pid.ted) + :: (redirect-ted ted) + == + ++ handle-com-vote |= [=pid:tp vote=?] + =/ votesi=@si (new:si vote 1) + =/ ucom (get-comment:lib pid state) + ?~ ucom `state + =/ com u.ucom + =/ v votes.com + =/ nv %= v + tally (sum:si tally.v votesi) + leger (~(put by leger.v) src.bowl vote) + == + =. com com(votes nv) + =. comments (put:gorm:tp comments pid com) + =. state (save-karma author.com vote) + :_ state :~ + cache-root + (cache-com com) + (cache-user author.com) + :: (redirect-com com) + == + + + :: redirectors + ++ redirect-root (redirect:router eyre-id "") + + ++ redirect-ted |= ted=thread:sur + =/ link (scow:sr %uw (jam pid.ted)) + =/ url "/ted/{link}" + (redirect:router eyre-id url) + ++ redirect-com |= com=comment:tp + =/ link (scow:sr %uw (jam [author.com id.com])) + =/ url "/com/{link}" + (redirect:router eyre-id url) + -- + :: cache builders + ++ cache-root (cache-card "") + ++ cache-ted |= ted=thread:sur + =/ link (scow:sr %uw (jam pid.ted)) + =/ url "/ted/{link}" + (cache-card url) + ++ cache-com |= com=comment:tp + =/ link (scow:sr %uw (jam [author.com id.com])) + =/ url "/com/{link}" + (cache-card url) + ++ cache-threads ^- (list card) + =| l=(list card) + :: threads + =/ teds (tap:torm:sur threads) + =. l |- ?~ teds l + =/ ted=thread:sur +.i.teds + =/ car (cache-ted ted) + $(teds t.teds, l [car l]) + :- cache-root l + ++ cache-user |= who=@p + =/ p (scow %p who) + (cache-card "/usr/{p}") + ++ cache-static ^- (list card) + :~ (cache-card "/log") + (cache-card "/add") + (cache-card "/style.css") + (cache-card "/imgs/favicon.ico") + (cache-card "/imgs/favicon-16x16.png") + (cache-card "/imgs/favicon-32x32.png") + (cache-card "/site.webmanifest") + == + ++ cache-all ^- (list card) + =| l=(list card) + :: threads + =/ teds (tap:torm:sur threads) + =. l |- ?~ teds l + =/ ted=thread:sur +.i.teds + =/ car (cache-ted ted) + $(teds t.teds, l [car l]) + =/ coms (tap:gorm:tp comments) + =. l |- ?~ coms l + =/ com=comment:tp +.i.coms + =/ car (cache-com com) + $(coms t.coms, l [car l]) + :- cache-root (weld cache-static l) + :: state updaters + ++ save-ted |= ted=thread:sur + =. threads (put:torm:sur threads pid.ted ted) + state + :: comments to threads + ++ save-com + |= [com=comment:tp ted=thread:sur] + =/ =pid:tp [author.com id.com] + =/ nr [pid replies.ted] + =. ted ted(replies nr) + =. threads (put:torm:sur threads pid.ted ted) + =. comments (put:gorm:tp comments pid com) + state + :: replies to comments + ++ save-rep + |= [com=comment:tp par=comment:tp] + =/ =pid:tp [author.com id.com] + =. comments (put:gorm:tp comments pid com) + =/ ppid [author.par id.par] + =/ nc (~(put in children.par) pid) + =. par par(children nc) + =. comments (put:gorm:tp comments ppid par) + state + ++ save-karma |= [who=@p vote=?] + =/ curr (~(get by karma) who) + =/ cur ?~ curr `@sd`0 u.curr + =/ votesd (new:si vote 1) + =/ new (sum:si cur votesd) + =. karma (~(put by karma) who new) + state + + ++ cache-card |= path=tape ^- card + =/ pathc (crip "{base-url:cons}{path}") + =/ router-path ?~ path '/' pathc + =/ pl=simple-payload:http (render:rout router-path) + =/ entry=cache-entry:eyre [.n %payload pl] + [%pass /root %arvo %e %set-response pathc `entry] +-- diff --git a/lib/constants.hoon b/lib/constants.hoon index 2ca81a8..e976850 100644 --- a/lib/constants.hoon +++ b/lib/constants.hoon @@ -1,3 +1,10 @@ |% ++ hi %hi +++ page-size 20 +++ base-url ^- tape "/forum" +++ admins ^- (set @p) + %- silt + :~ ~lagrev-nocfep + ~polwex + == -- diff --git a/lib/default-agent.hoon b/lib/default-agent.hoon new file mode 100644 index 0000000..319bf95 --- /dev/null +++ b/lib/default-agent.hoon @@ -0,0 +1,69 @@ +/+ skeleton +|* [agent=* help=*] +?: ?=(%& help) + ~| %default-agent-helpfully-crashing + skeleton +|_ =bowl:gall +++ on-init + `agent +:: +++ on-save + !>(~) +:: +++ on-load + |= old-state=vase + `agent +:: +++ on-poke + |= =cage + ~| "unexpected poke to {} with mark {}" + !! +:: +++ on-watch + |= =path + ~| "unexpected subscription to {} on path {}" + !! +:: +++ on-leave + |= path + `agent +:: +++ on-peek + |= =path + ~| "unexpected scry into {} on path {}" + !! +:: +++ on-agent + |= [=wire =sign:agent:gall] + ^- (quip card:agent:gall _agent) + ?- -.sign + %poke-ack + ?~ p.sign + `agent + %- (slog leaf+"poke failed from {} on wire {}" u.p.sign) + `agent + :: + %watch-ack + ?~ p.sign + `agent + =/ =tank leaf+"subscribe failed from {} on wire {}" + %- (slog tank u.p.sign) + `agent + :: + %kick `agent + %fact + ~| "unexpected subscription update to {} on wire {}" + ~| "with mark {}" + !! + == +:: +++ on-arvo + |= [=wire =sign-arvo] + ~| "unexpected system response {<-.sign-arvo>} to {} on wire {}" + !! +:: +++ on-fail + |= [=term =tang] + %- (slog leaf+"error in {}" >term< tang) + `agent +-- diff --git a/lib/forum.hoon b/lib/forum.hoon index 424f1fd..d7fa146 100644 --- a/lib/forum.hoon +++ b/lib/forum.hoon @@ -1,13 +1,14 @@ /- sur=forum, tp=post -/+ sr=sortug, parser +/+ sr=sortug, parser, cons=constants |% :: fetching ++ get-thread |= [=pid:tp =state:sur] ^- (unit thread:sur) (get:torm:sur threads.state pid) ++ get-thread-page |= [pag=@ud =state:sur] ^- (list thread:sur) =/ teds (tap:torm:sur threads.state) - =/ start ?: .=(pag 0) 0 (dec pag) - =/ end (add start 9) + =/ pagenum ?: .=(pag 0) 0 (dec pag) + =/ start (mul pagenum page-size:cons) + =/ end (add start page-size:cons) =| i=@ud =| res=(list thread:sur) |- ?~ teds (flop res) @@ -15,6 +16,86 @@ ?: (lth i start) $(i +(i), teds t.teds) =. res [+.i.teds res] $(i +(i), teds t.teds) + + +++ get-comment |= [=pid:tp =state:sur] ^- (unit comment:tp) + (get:gorm:tp comments.state pid) +++ get-comment-list +|= [ted=thread:sur f=gfeed:tp] ^- (list full-node:tp) + %- flop + %+ roll replies.ted |= [=pid:tp acc=(list full-node:tp)] + =/ com (get:gorm:tp f pid) + ?~ com acc + =/ fn (node-to-full u.com f) + [fn acc] + +:: ++ node-to-full-fake +:: |= p=post:post ^- full-node:post +:: =/ fake-children=full-graph:post %- ~(rep in children.p) +:: |= [=id:post acc=full-graph:post] +:: (put:form:post acc id *full-node:post) +:: p(children fake-children) +++ node-to-full +|= [p=comment:tp f=gfeed:tp] ^- full-node:tp + =/ =full-graph:tp (convert-children children.p f) + [p full-graph] +++ convert-children +|= [children=(set pid:tp) f=gfeed:tp] +^- full-graph:tp +%- ~(rep in children) + |= [=pid:tp acc=full-graph:tp] + =/ n (get:gorm:tp f pid) + ?~ n acc + =/ full-node (node-to-full u.n f) + (put:form:tp acc pid full-node) + +++ total-comments +|= [ted=thread:sur =state:sur] ^- @ud + =/ total 0 + =/ reps replies.ted + |- ?~ reps total + =/ =pid:tp i.reps + =/ com (get-comment pid state) + ?~ com $(reps t.reps) + =/ fn (node-to-full u.com comments.state) + =/ subt (get-total fn) + =/ ntotal (add total subt) + $(total ntotal, reps t.reps) + +++ get-total |= fn=full-node:tp ^- @ud + ?~ children.fn 1 + =/ lst (tap:form:tp children.fn) + %+ add (lent lst) + %+ roll lst + |= [[=pid:tp n=full-node:tp] acc=@ud] + (add acc (get-total n)) + + +++ get-user-teds |= [who=@p =state:sur] + ^- threads:sur + =| teds=threads:sur + =/ l (tap:torm:sur threads.state) + |- ?~ l teds + =/ ted=thread.sur +.i.l + ?. .=(ship.pid.ted who) $(l t.l) + =/ nteds (put:torm:sur teds pid.ted ted) + $(l t.l, teds nteds) +++ get-user-coms |= [who=@p =state:sur] + ^- gfeed:tp + =| gf=gfeed:tp + =/ l (tap:gorm:tp comments.state) + |- ?~ l gf + =/ com=comment:tp +.i.l + ?. .=(author.com who) $(l t.l) + =/ ngf (put:gorm:tp gf [author.com id.com] com) + $(l t.l, gf ngf) + +++ get-user-karma |= [who=@p =state:sur] + ^- @sd + =/ kar (~(get by karma.state) who) + ?~ kar `@sd`0 + u.kar + :: ++ tally :: |= votes=(map @p ?) ^- [tup=@ud tdo=@ud] :: %- ~(rep by votes) |= [[s=@p v=?] [tup=@ud tdo=@ud]] @@ -65,7 +146,7 @@ content content == ++ build-comment - |= [contents=content-list:tp =bowl:gall thread=pid:tp] + |= [contents=content-list:tp =bowl:gall thread=pid:tp parent=pid:tp] ^- comment:tp =/ p *comment:tp %= p @@ -73,12 +154,15 @@ thread thread author src.bowl contents contents + parent parent == -:: ++ build-content -:: |= [text=@t poll=(unit poll:pols)] ^- content-list:tp -:: =/ contents (tokenize:ui u.text) -:: ?~ contents ~ -:: contents +++ build-content + |= [text=@t] ^- content-list:tp + =/ tokens (tokenise:parser text) + ?- -.tokens + %| ~ + %& +.tokens + == ++ post-date-ago |= [d=@da now=@da length=?(%tam %yau)] ^- tape diff --git a/lib/markdown.hoon b/lib/markdown.hoon new file mode 100644 index 0000000..67ee3ad --- /dev/null +++ b/lib/markdown.hoon @@ -0,0 +1,1711 @@ +/- m=markdown +:: + +=> |% + :: Set label for collapsed / shortcut reference links + ++ backfill-ref-link + |= [a=link:inline:m] + ^- link:inline:m + =/ t target.a + ?+ -.t a :: only reference links + %ref + ?: =(%full type.t) a :: only collapsed / shortcut links + =/ node=element:inline.m (head contents.a) + ?+ -.node a :: ...and it's a %text node + %text + %_ a + target %_ t + label text.node + == + == + == + == + :: + ++ whitespace (mask " \09\0d\0a") :: whitespace: space, tab, or newline + :: + ++ all-link-ref-definitions :: Recursively get link ref definitions + =< process-nodes + |% + ++ process-nodes + |= [nodes=markdown:m] + ^- (map @t urlt:ln:m) + ?~ nodes ~ + %- %~(uni by (process-node (head nodes))) + $(nodes +.nodes) + :: + ++ process-nodeses + |= [nodeses=(list markdown:m)] + ^- (map @t urlt:ln:m) + ?~ nodeses ~ + %- %~(uni by (process-nodes (head nodeses))) + $(nodeses +.nodeses) + :: + ++ process-node + |= [node=node:markdown:m] + ^- (map @t urlt:ln:m) + =/ result *(map @t urlt:ln:m) + ?- -.node + %leaf :: Leaf node: check if it's a link ref def + =/ leaf=node:leaf:m +.node + ?+ -.leaf result + %link-ref-definition (~(put by result) label.leaf urlt.leaf) + == + :: + %container + =/ container=node:container:m +.node + ?- -.container + %block-quote (process-nodes markdown.container) + %ol (process-nodeses contents.container) + %ul (process-nodeses contents.container) + %tl (process-nodeses (turn contents.container |=([is-checked=? =markdown:m] markdown))) + == + == + -- + -- +|% + :: + :: Parse to and from Markdown text format + ++ md + |% + ++ de :: de:md Deserialize (parse) + |% + ++ escaped + |= [char=@t] + (cold char (jest (crip (snoc "\\" char)))) + :: + ++ newline + %+ cold '\0a' :: EOL, with or without carriage return '\0d' + ;~(pfix ;~(pose (just '\0d') (easy ~)) (just '\0a')) + ++ line-end :: Either EOL or EOF + %+ cold '\0a' + ;~(pose newline (full (easy ~))) + :: + ++ ln :: Links and urls + |% + ++ url + =< %+ cook |=(a=url:ln:m a) :: Cast + ;~(pose with-triangles without-triangles) + |% + ++ with-triangles + ;~ plug + %+ cook crip + %+ ifix [gal gar] + %- star + ;~ pose + (escaped '<') + (escaped '>') + ;~(less gal gar line-end prn) :: Anything except '<', '>' or newline + == + (easy %.y) :: "yes triangles" + == + ++ without-triangles + ;~ plug + %+ cook crip + ;~ less + gal :: Doesn't start with '<' + %- plus :: Non-empty + ;~ less + whitespace :: No whitespace allowed + ;~ pose + (escaped '(') + (escaped ')') + ;~(less pal par line-end prn) :: Anything except '(', ')' or newline + == + == + == + (easy %.n) :: "no triangles" + == + -- + :: + ++ urlt + %+ cook |=(a=urlt:ln:m a) :: Cast + ;~ plug + url + %- punt :: Optional title-text + ;~ pfix (plus whitespace) :: Separated by some whitespace + %+ cook crip ;~ pose :: Enclosed in single quote, double quote, or '(...)' + (ifix [soq soq] (star ;~(pose (escaped '\'') ;~(less soq prn)))) + (ifix [doq doq] (star ;~(pose (escaped '"') ;~(less doq prn)))) + (ifix [pal par] (star ;~(pose (escaped '(') (escaped ')') ;~(less pal par prn)))) + == + == + == + :: + :: Labels are used in inline link targets and in a block-level element (labeled link references) + ++ label + %+ cook crip + %+ ifix [sel ser] :: Enclosed in '[...]' + %+ ifix :- (star whitespace) :: Strip leading and trailing whitespapce + (star whitespace) + %- plus ;~ pose :: Non-empty + (escaped '[') + (escaped ']') + ;~(less sel ser prn) :: Anything except '[', ']' (must be escaped) + == + :: + ++ target :: Link target, either reference or direct + =< %+ cook |=(a=target:ln:m a) + ;~(pose target-direct target-ref) + |% + ++ target-direct + %+ cook |=(a=target:ln:m a) + %+ stag %direct + %+ ifix [pal par] :: Direct links are enclosed in '(...)' + %+ ifix :- (star whitespace) :: Strip leading and trailing whitespace + (star whitespace) + urlt :: Just the target + ++ target-ref + %+ cook |=(a=target:ln:m a) + %+ stag %ref + ;~ pose + %+ stag %full label + %+ stag %collapsed (cold '' (jest '[]')) + %+ stag %shortcut (easy '') + == + -- + -- + ++ inline :: Inline elements + |% + ++ contents (cook |=(a=contents:inline:m a) (star element)) :: Element sequence + ++ element :: Any element + %+ cook |=(a=element:inline:m a) + ;~ pose + escape + entity + strong + emphasis + code + link + image + autolink + text + softbrk + hardbrk + == + :: + ++ text + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + entity + link + image + autolink + emphasis + strong + code + softbrk + hardbrk + :: ...etc + prn + == + :: + ++ escape + %+ cook |=(a=escape:inline:m a) + %+ stag %escape + ;~ pose + :: \!\"\#\$\%\&\'\(\)\*\+\,\-\.\/\:\;\<\=\>\?\@\[\\\]\^\_\`\{\|\}\~ + (escaped '[') (escaped ']') (escaped '(') (escaped ')') + (escaped '!') (escaped '*') (escaped '*') (escaped '_') + (escaped '&') (escaped '\\') + :: etc + == + ++ entity + %+ cook |=(a=entity:inline:m a) + %+ stag %entity + %+ ifix [pam mic] + %+ cook crip + ;~ pose + ;~(plug hax (stun [1 7] nud)) :: '#' and one to seven digits + (plus alf) :: Named entity + == + :: + ++ softbrk :: Newline + %+ cook |=(a=softbrk:inline:m a) + %+ stag %soft-line-break + (cold ~ newline) + :: + ++ hardbrk + %+ cook |=(a=hardbrk:inline:m a) + %+ stag %line-break + %+ cold ~ + ;~ pose + ;~(plug (jest ' ') (star ace) newline) :: Two or more spaces before a newline + ;~(plug (just '\\') newline) :: An escaped newline + == + ++ link + %+ knee *link:inline:m |. ~+ :: recurse + %+ cook backfill-ref-link + %+ stag %link + ;~ plug + %+ ifix [sel ser] :: Display text is wrapped in '[...]' + %- star ;~ pose :: Display text can contain various contents + escape + entity + emphasis + strong + code + image + :: Text: => + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + entity + emphasis + strong + code + ser :: No closing ']' + prn + == + == + target:ln + == + :: + ++ image + %+ cook |=(a=image:inline:m a) + %+ stag %image + ;~ plug + %+ ifix [(jest '![') (just ']')] :: alt-text is wrapped in '![...]' + %+ cook crip + %- star ;~ pose + (escaped ']') + ;~(less ser prn) + == + target:ln + == + :: + ++ autolink + %+ cook |=(a=autolink:inline:m a) + %+ stag %autolink + %+ ifix [gal gar] :: Enclosed in '<...>' + %+ cook crip + %- star ;~ pose + ;~(less ace gar prn) :: Spaces are not allowed; neither are backslash-escapes + == + :: + ++ emphasis + %+ knee *emphasis:inline:m |. ~+ :: recurse + %+ cook |=(a=emphasis:inline:m a) + %+ stag %emphasis + ;~ pose + %+ ifix [tar tar] + ;~ plug + (easy '*') + %- plus ;~ pose :: Display text can contain various contents + escape + entity + strong + link + autolink + code + image + link + softbrk + hardbrk + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + entity + strong + link + autolink + code + image + link + softbrk + hardbrk + :: + tar :: If a '*', then it's the end of the `emphasis` + :: + prn + == + == + == + %+ ifix [cab cab] + ;~ plug + (easy '_') + %- plus ;~ pose :: Display text can contain various contents + escape + entity + strong + link + autolink + code + image + link + softbrk + hardbrk + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + entity + strong + link + autolink + code + image + link + softbrk + hardbrk + :: + cab :: If a '*', then it's the end of the `emphasis` + :: + prn + == + == + == + == + :: + ++ strong + %+ knee *strong:inline:m |. ~+ :: recurse + %+ cook |=(a=strong:inline:m a) + %+ stag %strong + ;~ pose + %+ ifix [(jest '**') (jest '**')] + ;~ plug + (easy '*') + %- plus ;~ pose :: Display text can contain various contents + escape + emphasis + link + autolink + code + image + link + softbrk + hardbrk + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + emphasis + link + autolink + code + image + link + softbrk + hardbrk + :: ...etc + (jest '**') :: If a '**', then it's the end of the `emphasis` + prn + == + == + == + %+ ifix [(jest '__') (jest '__')] + ;~ plug (easy '_') + %- plus ;~ pose :: Display text can contain various contents + escape + emphasis + link + autolink + code + image + link + softbrk + hardbrk + %+ knee *text:inline:m |. ~+ :: recurse + %+ cook |=(a=text:inline:m a) + %+ stag %text + %+ cook crip + %- plus :: At least one character + ;~ less :: ...which doesn't match any other inline rule + escape + emphasis + link + autolink + code + image + link + softbrk + hardbrk + :: + (jest '__') :: If a '**', then it's the end of the `emphasis` + prn + == + == + == + == + :: + ++ code + =< %+ cook |=(a=code:inline:m a) + %+ stag %code-span + inner-parser + |% + ++ inner-parser + |= =nail + =/ vex ((plus tic) nail) :: Read the first backtick string + ?~ q.vex vex :: If no vex is found, fail + =/ tic-sequence ^- tape p:(need q.vex) + %. + q:(need q.vex) + %+ cook |= [a=tape] :: Attach the backtick length to it + [(lent tic-sequence) (crip a)] + ;~ sfix + %+ cook + |= [a=(list tape)] + ^- tape + (zing a) + %- star ;~ pose + %+ cook trip ;~(less tic prn) :: Any character other than a backtick + %+ sear :: A backtick string that doesn't match the opener + |= [a=tape] + ^- (unit tape) + ?: =((lent a) (lent tic-sequence)) + ~ + `a + (plus tic) + == + (jest (crip tic-sequence)) :: Followed by a closing backtick string + == + -- + -- + :: + ++ leaf + |% + ++ node + %+ cook |=(a=node:leaf:m a) + ;~ pose + blank-line + heading + break + codeblk-indent + codeblk-fenced + link-ref-def + :: ...etc + table + paragraph + == + ++ blank-line + %+ cook |=(a=blank-line:leaf:m a) + %+ stag %blank-line + (cold ~ newline) + ++ heading + =< %+ cook |=(a=heading:leaf:m a) + %+ stag %heading + ;~(pose atx setext) + |% + ++ atx + =/ atx-eol ;~ plug + (star ace) + (star hax) + (star ace) + line-end + == + + %+ stag %atx + %+ cook :: Parse heading inline content + |= [level=@ text=tape] + [level (scan text contents:inline)] + ;~ pfix + (stun [0 3] ace) :: Ignore up to 3 leading spaces + ;~ plug + (cook |=(a=tape (lent a)) (stun [1 6] hax)) :: Heading level + %+ ifix [(plus ace) atx-eol] :: One leading space is required; rest is ignored + %- star + ;~(less atx-eol prn) :: Trailing haxes/spaces are ignored + == + == + ++ setext + %+ stag %setext + %+ cook + |= [text=tape level=@] + [level (scan text contents:inline)] + ;~ plug :: Wow this is a mess + %+ ifix [(stun [0 3] ace) (star ace)] :: Strip up to 3 spaces, and trailing space + (star ;~(less ;~(pfix (star ace) newline) prn)) :: Any text... + ;~ pfix + newline :: ...followed by newline... + (stun [0 3] ace) :: ...up to 3 spaces (stripped)... + ;~ sfix + ;~ pose :: ...and an underline + (cold 1 (plus (just '-'))) :: Underlined by '-' means heading lvl 1 + (cold 2 (plus (just '='))) :: Underlined by '=' means heading lvl 2 + == + (star ace) + == + == + == + -- + ++ break + %+ cook |=(a=break:leaf:m a) + %+ stag %break + %+ cook + |= [first-2=@t trailing=tape] + [(head trailing) (add 2 (lent trailing))] + %+ ifix :- (stun [0 3] ace) :: Strip indent and trailing space + ;~ plug + (star (mask " \09")) + newline :: No other chars allowed on the line + == + ;~ pose + ;~(plug (jest '**') (plus tar)) :: At least 3, but can be more + ;~(plug (jest '--') (plus hep)) + ;~(plug (jest '__') (plus cab)) + == + :: + ++ codeblk-indent + %+ cook |=(a=codeblk-indent:leaf:m a) + %+ stag %indent-codeblock + %+ cook |=(a=(list tape) (crip (zing a))) + %- plus :: 1 or more lines + ;~ pfix + (jest ' ') :: 4 leading spaces + %+ cook snoc ;~ plug + (star ;~(less line-end prn)) + line-end + == + == + :: + ++ codeblk-fenced + =+ |% + :: Returns a 3-tuple: + :: - indent size + :: - char type + :: - fence length + ++ code-fence + ;~ plug + %+ cook |=(a=tape (lent a)) (stun [0 3] ace) + %+ cook |=(a=tape [(head a) (lent a)]) :: Get code fence char and length + ;~ pose + (stun [3 999.999.999] sig) + (stun [3 999.999.999] tic) + == + == + :: + ++ info-string + %+ cook crip + %+ ifix [(star ace) line-end] :: Strip leading whitespace + (star ;~(less line-end tic prn)) :: No backticks in a code fence + -- + |* =nail + :: Get the marker and indent size + =/ vex (code-fence nail) + ?~ q.vex vex :: If no match found, fail + =/ [indent=@ char=@t len=@] p:(need q.vex) + =/ closing-fence + ;~ plug + (star ace) + (stun [len 999.999.999] (just char)) :: Closing fence must be at least as long as opener + (star ace) :: ...and cannot have any following text except space + line-end + == + :: Read the rest of the list item block + %. + q:(need q.vex) + %+ cook |=(a=codeblk-fenced:leaf:m a) + %+ stag %fenced-codeblock + ;~ plug + %+ cook |=(a=@t a) (easy char) + (easy len) + %+ cook |=(a=@t a) info-string + (easy indent) + %+ cook |=(a=(list tape) (crip (zing a))) + ;~ sfix + %- star :: Any amount of lines + ;~ less closing-fence :: ...until the closing code fence + ;~ pfix (stun [0 indent] ace) :: Strip indent up to that of the opening fence + %+ cook |=(a=tape a) + ;~ pose :: Avoid infinite loop at EOF + %+ cook trip newline :: A line is either a blank line... + %+ cook snoc + ;~ plug :: Or a non-blank line + (plus ;~(less line-end prn)) + line-end + == + == + == + == + ;~(pose closing-fence (full (easy ~))) + == + == + :: + ++ link-ref-def + %+ cook |=(a=link-ref-def:leaf:m a) + %+ stag %link-ref-definition + %+ ifix [(stun [0 3] ace) line-end] :: Strip leading space + ;~ plug + ;~(sfix label:ln col) :: Label (enclosed in "[...]"), followed by col ":" + ;~ pfix :: Optional whitespace, including up to 1 newline + (star ace) + (stun [0 1] newline) + (star ace) + urlt:ln + == + == + :: + ++ paragraph + %+ cook |=(a=paragraph:leaf:m a) + %+ stag %paragraph + %+ cook :: Reparse the paragraph text as elements + |= [a=(list tape)] + (scan (zing a) contents:inline) + %- plus :: Read lines until a non-paragraph object is found + ;~ less + heading + break + block-quote-line:container :: Block quotes can interrupt paragraphs + %+ cook snoc ;~ plug + %- plus ;~(less line-end prn) :: Lines must be non-empty + line-end + == + == + :: + ++ table + => |% + +$ cell-t [len=@ =contents:inline:m] + ++ row + ;~ pfix bar :: A bar in front... + %- star + %+ cook :: compute the length and parse inlines + |= [pfx=@ stuff=tape sfx=@] + [;:(add pfx (lent stuff) sfx) (scan stuff contents:inline)] :: inline elements... + ;~ plug + (cook lent (star ace)) + (star ;~(less newline ;~(plug (star ace) bar) prn)) + (cook lent ;~(sfix (star ace) bar)) + == + == + ++ delimiter-row + ;~ pfix bar :: A bar in front... + %- star + %+ cook + |= [pfx=@ lal=? heps=@ ral=? sfx=@] + :- ;:(add pfx ?:(ral 1 0) heps ?:(lal 1 0) sfx) + ?:(ral ?:(lal %c %r) ?:(lal %l %n)) + ;~ plug + (cook lent (star ace)) :: Delimiter: leading space... + (cook |=(a=tape .?(a)) (stun [0 1] col)) :: maybe a ':'... + (cook lent (plus hep)) :: a bunch of '-'... + (cook |=(a=tape .?(a)) (stun [0 1] col)) :: maybe another ':'... + (cook lent ;~(sfix (star ace) bar)) :: ..and a bar as a terminator + == + == + -- + |* =nail :: Make it a (redundant) gate so I can use `=>` to add a helper core + %. nail :: apply the following parser + %+ cook + |= [hdr=(list cell-t) del=(list [len=@ al=?(%c %r %l %n)]) bdy=(list (list cell-t))] + ^- table:leaf:m + =/ widths=(list @) (turn del |=([len=@ al=*] len)) + =/ rows=(list (list cell-t)) (snoc bdy hdr) :: since they're the same data type + =/ computed-widths + |- + ?~ rows widths + %= $ + rows (tail rows) + widths =/ row=(list cell-t) (head rows) + |- + ?~ row ~ + :- (max (head widths) len:(head row)) + %= $ + widths (tail widths) + row (tail row) + == + == + :* %table + computed-widths + (turn hdr |=(cell=cell-t contents.cell)) + (turn del |=([len=@ al=?(%c %r %l %n)] al)) + (turn bdy |=(row=(list cell-t) (turn row |=(cell=cell-t contents.cell)))) + == + ;~ plug + ;~(sfix row line-end) + ;~(sfix delimiter-row line-end) + (star ;~(sfix row line-end)) + == + -- + :: + ++ container + =+ |% + :: + ++ line :: Read a line of plain text + %+ cook |=([a=tape b=tape c=tape] ;:(weld a b c)) + ;~ plug + (star ;~(less line-end prn)) + (cook trip line-end) + (star newline) :: Can have blank lines in a list item + == + ++ block-quote-marker + ;~ plug :: Single char '>' + (stun [0 3] ace) :: Indented up to 3 spaces + gar + (stun [0 1] ace) :: Optionally followed by a space + == + ++ block-quote-line + %+ cook snoc + ;~ plug :: Single line... + ;~ pfix block-quote-marker :: ...starting with ">..." + (star ;~(less line-end prn)) :: can be empty + == + line-end + == + :: + +$ ul-marker-t [indent=@ char=@t len=@] + ++ ul-marker + %+ cook :: Compute the length of the whole thing + |= [prefix=tape bullet=@t suffix=tape] + ^- ul-marker-t + :* (lent prefix) + bullet + ;:(add 1 (lent prefix) (lent suffix)) + == + ;~ plug + (stun [0 3] ace) + ;~(pose hep lus tar) :: Bullet char + (stun [1 4] ace) + == + :: + :: Produces a 3-tuple: + :: - bullet char (*, +, or -) + :: - indent level (number of spaces before the bullet) + :: - item contents (markdown) + +$ ul-item-t [char=@t indent=@ =markdown:m] + ++ ul-item + |* =nail + :: Get the marker and indent size + =/ vex (ul-marker nail) + ?~ q.vex vex :: If no match found, fail + =/ mrkr=ul-marker-t p:(need q.vex) + :: Read the rest of the list item block + %. + q:(need q.vex) + %+ cook + |= [a=(list tape)] + ^- ul-item-t + :* char.mrkr + indent.mrkr + (scan (zing a) markdown) + == + ;~ plug + line :: First line + %- star ;~ pfix :: Subsequent lines must have the same indent + (stun [len.mrkr len.mrkr] ace) :: the indent + line :: the line + == + == + :: + +$ ol-marker-t [indent=@ char=@t number=@ len=@] + ++ ol-marker + %+ cook :: Compute the length of the whole thing + |= [prefix=tape number=@ char=@t suffix=tape] + ^- ol-marker-t + :* (lent prefix) + char + number + ;:(add 1 (lent (a-co:co number)) (lent prefix) (lent suffix)) + == + ;~ plug + (stun [0 3] ace) + dem + ;~(pose dot par) :: Bullet char + (stun [1 4] ace) + == + :: + :: Produces a 4-tuple: + :: - delimiter char: either dot '.' or par ')' + :: - list item number + :: - indent level (number of spaces before the number) + :: - item contents (markdown) + +$ ol-item-t [char=@t number=@ indent=@ =markdown:m] + ++ ol-item + |* =nail + ::^- edge + :: Get the marker and indent size + =/ vex (ol-marker nail) + ?~ q.vex vex :: If no match found, fail + =/ mrkr=ol-marker-t p:(need q.vex) + :: Read the rest of the list item block + %. + q:(need q.vex) + %+ cook + |= [a=(list tape)] + ^- ol-item-t + :* char.mrkr + number.mrkr + indent.mrkr + (scan (zing a) markdown) + == + ;~ plug + line :: First line + %- star ;~ pfix :: Subsequent lines must have the same indent + (stun [len.mrkr len.mrkr] ace) :: the indent + line :: the line + == + == + :: + ++ tl-checkbox + ;~ pose + %+ cold %.y (jest '[x]') + %+ cold %.n (jest '[ ]') + == + :: + :: Produces a 4-tuple: + :: - bullet char (*, +, or -) + :: - indent level (number of spaces before the bullet) + :: - is-checked + :: - item contents (markdown) + +$ tl-item-t [char=@t indent=@ is-checked=? =markdown:m] + ++ tl-item + |* =nail + :: Get the marker and indent size + =/ vex (;~(plug ul-marker ;~(sfix tl-checkbox ace)) nail) + ?~ q.vex vex :: If no match found, fail + =/ [mrkr=ul-marker-t is-checked=?] p:(need q.vex) + :: Read the rest of the list item block + %. + q:(need q.vex) + %+ cook + |= [a=(list tape)] + ^- tl-item-t + :* char.mrkr + indent.mrkr + is-checked + (scan (zing a) markdown) + == + ;~ plug + line :: First line + %- star ;~ pfix :: Subsequent lines must have the same indent + (stun [len.mrkr len.mrkr] ace) :: the indent + line :: the line + == + == + -- + |% + ++ node + %+ cook |=(a=node:container:m a) + ;~ pose + block-quote + tl + ul + ol + == + :: + ++ block-quote + %+ cook |=(a=block-quote:container:m a) + %+ stag %block-quote + %+ cook |= [a=(list tape)] + (scan (zing a) markdown) + ;~ plug + block-quote-line + %- star :: At least one line + ;~ pose + block-quote-line + %+ cook zing %- plus :: Paragraph continuation (copied from `paragraph` above) + ;~ less :: ...basically just text that doesn't matchZ anything else + heading:leaf + break:leaf + :: ol + :: ul + block-quote-marker :: Can't start with ">" + line-end :: Can't be blank + %+ cook snoc ;~ plug + %- star ;~(less line-end prn) + line-end + == + == + == + == + :: + ++ ul + |* =nail + :: Start by finding the type of the first bullet (indent level and bullet char) + =/ vex (ul-item nail) + ?~ q.vex vex :: Fail if it doesn't match a list item + =/ first-item=ul-item-t p:(need q.vex) + :: Check for more list items + %. + q:(need q.vex) + %+ cook |=(a=ul:container:m a) + %+ stag %ul + ;~ plug :: Give the first item, first + (easy indent.first-item) + (easy char.first-item) + (easy markdown.first-item) + %- star + %+ sear :: Reject items that don't have the same bullet char + |= [item=ul-item-t] + ^- (unit markdown:m) + ?. =(char.item char.first-item) + ~ + `markdown.item + ul-item + == + :: + ++ ol + |* =nail + :: Start by finding the first number, char, and indent level + =/ vex (ol-item nail) + ?~ q.vex vex :: Fail if it doesn't match a list item + =/ first-item=ol-item-t p:(need q.vex) + :: Check for more list items + %. + q:(need q.vex) + %+ cook |=(a=ol:container:m a) + %+ stag %ol + ;~ plug :: Give the first item, first + (easy indent.first-item) + (easy char.first-item) + (easy number.first-item) + (easy markdown.first-item) + %- star + %+ sear :: Reject items that don't have the same delimiter + |= [item=ol-item-t] + ^- (unit markdown:m) + ?. =(char.item char.first-item) + ~ + `markdown.item + ol-item + == + :: + ++ tl + |* =nail + :: Start by finding the type of the first bullet (indent level and bullet char) + =/ vex (tl-item nail) + ?~ q.vex vex :: Fail if it doesn't match a list item + =/ first-item=tl-item-t p:(need q.vex) + :: Check for more list items + %. + q:(need q.vex) + %+ cook |=(a=tl:container:m a) + %+ stag %tl + ;~ plug :: Give the first item, first + (easy indent.first-item) + (easy char.first-item) + (easy [is-checked.first-item markdown.first-item]) + %- star + %+ sear :: Reject items that don't have the same bullet char + |= [item=tl-item-t] + ^- (unit [is-checked=? markdown:m]) + ?. =(char.item char.first-item) + ~ + `[is-checked.item markdown.item] + tl-item + == + -- + :: + ++ markdown + %+ cook |=(a=markdown:m a) + %- star ;~ pose + (stag %container node:container) + (stag %leaf node:leaf) + == + -- + :: + :: Enserialize (write out as text) + ++ en + |% + ++ escape-chars + |= [text=@t chars=(list @t)] + ^- tape + %+ rash text + %+ cook + |=(a=(list tape) `tape`(zing a)) + %- star ;~ pose + (cook |=(a=@t `tape`~['\\' a]) (mask chars)) + (cook trip prn) + == + :: + ++ ln + |% + ++ url + =< |= [u=url:ln:m] + ^- tape + ?: has-triangle-brackets.u + (with-triangles text.u) + (without-triangles text.u) + |% + ++ with-triangles + |= [text=@t] + ;: weld + "<" :: Put it inside triangle brackets + (escape-chars text "<>") :: Escape triangle brackets in the text + ">" + == + ++ without-triangles + |= [text=@t] + (escape-chars text "()") :: Escape all parentheses '(' and ')' + -- + ++ urlt + |= [u=urlt:ln:m] + ^- tape + ?~ title-text.u :: If there's no title text, then it's just an url + (url url.u) + ;:(weld (url url.u) " \"" (escape-chars (need title-text.u) "\"") "\"") + ++ label + |= [text=@t] + ^- tape + ;:(weld "[" (escape-chars text "[]") "]") + ++ target + |= [t=target:ln:m] + ^- tape + ?- -.t + %direct ;:(weld "(" (urlt urlt.t) ")") :: Wrap in parentheses + :: + %ref ?- type.t + %full (label label.t) + %collapsed "[]" + %shortcut "" + == + == + -- + :: + ++ inline + |% + ++ contents + |= [=contents:inline:m] + ^- tape + %- zing %+ turn contents element + ++ element + |= [e=element:inline:m] + ?+ -.e !! + %text (text e) + %link (link e) + %escape (escape e) + %entity (entity e) + %code-span (code e) + %strong (strong e) + %emphasis (emphasis e) + %soft-line-break (softbrk e) + %line-break (hardbrk e) + %image (image e) + %autolink (autolink e) + :: ...etc + == + ++ text + |= [t=text:inline:m] + ^- tape + (trip text.t) :: So easy! + :: + ++ entity + |= [e=entity:inline:m] + ^- tape + ;:(weld "&" (trip code.e) ";") + :: + ++ link + |= [l=link:inline:m] + ^- tape + ;: weld + "[" + (contents contents.l) + "]" + (target:ln target.l) + == + :: + ++ image + |= [i=image:inline:m] + ^- tape + ;: weld + "![" + (escape-chars alt-text.i "]") + "]" + (target:ln target.i) + == + :: + ++ autolink + |= [a=autolink:inline:m] + ^- tape + ;: weld + "<" + (trip text.a) + ">" + == + :: + ++ escape + |= [e=escape:inline:m] + ^- tape + (snoc "\\" char.e) :: Could use `escape-chars` but why bother-- this is shorter + :: + ++ softbrk + |= [s=softbrk:inline:m] + ^- tape + "\0a" + ++ hardbrk + |= [h=hardbrk:inline:m] + ^- tape + "\\\0a" + ++ code + |= [c=code:inline:m] + ^- tape + ;:(weld (reap num-backticks.c '`') (trip text.c) (reap num-backticks.c '`')) + :: + ++ strong + |= [s=strong:inline:m] + ^- tape + ;: weld + (reap 2 emphasis-char.s) + (contents contents.s) + (reap 2 emphasis-char.s) + == + :: + ++ emphasis + |= [e=emphasis:inline:m] + ^- tape + ;: weld + (trip emphasis-char.e) + (contents contents.e) + (trip emphasis-char.e) + == + -- + :: + ++ leaf + |% + ++ node + |= [n=node:leaf:m] + ?+ -.n !! + %blank-line (blank-line n) + %break (break n) + %heading (heading n) + %indent-codeblock (codeblk-indent n) + %fenced-codeblock (codeblk-fenced n) + %link-ref-definition (link-ref-def n) + %paragraph (paragraph n) + %table (table n) + :: ...etc + == + + ++ blank-line + |= [b=blank-line:leaf:m] + ^- tape + "\0a" + :: + ++ break + |= [b=break:leaf:m] + ^- tape + (weld (reap char-count.b char.b) "\0a") + :: + ++ heading + |= [h=heading:leaf:m] + ^- tape + ?- style.h + %atx + ;:(weld (reap level.h '#') " " (contents:inline contents.h) "\0a") + %setext + =/ line (contents:inline contents.h) + ;:(weld line "\0a" (reap (lent line) ?:(=(level.h 1) '-' '=')) "\0a") + == + :: + ++ codeblk-indent + |= [c=codeblk-indent:leaf:m] + ^- tape + %+ rash text.c + %+ cook + |= [a=(list tape)] + ^- tape + %- zing %+ turn a |=(t=tape (weld " " t)) + %- plus %+ cook snoc ;~(plug (star ;~(less (just '\0a') prn)) (just '\0a')) + :: + ++ codeblk-fenced + |= [c=codeblk-fenced:leaf:m] + ^- tape + ;: weld + (reap indent-level.c ' ') + (reap char-count.c char.c) + (trip info-string.c) + "\0a" + ^- tape %+ rash text.c + %+ cook zing %- star :: Many lines + %+ cook |= [a=tape newline=@t] :: Prepend each line with "> " + ^- tape + ;: weld + ?~(a "" (reap indent-level.c ' ')) :: If the line is blank, no indent + a + "\0a" + == + ;~ plug :: Break into lines + (star ;~(less (just '\0a') prn)) + (just '\0a') + == + (reap indent-level.c ' ') + (reap char-count.c char.c) + "\0a" + == + :: + ++ link-ref-def + |= [l=link-ref-def:leaf:m] + ^- tape + ;: weld + "[" + (trip label.l) + "]: " + (urlt:ln urlt.l) + "\0a" + == + :: + ++ table + => |% + ++ cell + |= [width=@ c=contents:inline:m] + ^- tape + =/ contents-txt (contents:inline c) + ;: weld + " " + contents-txt + (reap (sub width (add 1 (lent contents-txt))) ' ') + "|" + == + ++ row + |= [widths=(list @) cells=(list contents:inline:m)] + ^- tape + ;: weld + "|" + |- + ^- tape + ?~ widths ~ + %+ weld + (cell (head widths) (head cells)) + $(widths (tail widths), cells (tail cells)) + "\0a" + == + ++ delimiter-row + |= [widths=(list @) align=(list ?(%l %c %r %n))] + ^- tape + ;: weld + "|" + |- + ^- tape + ?~ align ~ + ;: weld + " " + ?- (head align) + %l (weld ":" (reap ;:(sub (head widths) 3) '-')) + %r (weld (reap ;:(sub (head widths) 3) '-') ":") + %c ;:(weld ":" (reap ;:(sub (head widths) 4) '-') ":") + %n (reap ;:(sub (head widths) 2) '-') + == + " |" + $(align (tail align), widths (tail widths)) + == + "\0a" + == + -- + |= [t=table:leaf:m] + ^- tape + ;: weld + (row widths.t head.t) + (delimiter-row widths.t align.t) + =/ rows rows.t + |- + ^- tape + ?~ rows ~ + %+ weld (row widths.t (head rows)) $(rows (tail rows)) + == + :: + ++ paragraph + |= [p=paragraph:leaf:m] + ^- tape + (contents:inline contents.p) + -- + :: + ++ container + => |% + ++ line + %+ cook snoc + ;~ plug + (star ;~(less (just '\0a') prn)) + (just '\0a') + == + -- + |% + ++ node + |= [n=node:container:m] + ?- -.n + %block-quote (block-quote n) + %ul (ul n) + %ol (ol n) + %tl (tl n) + == + :: + ++ block-quote + |= [b=block-quote:container:m] + ^- tape + %+ scan (markdown markdown.b) :: First, render the contents + %+ cook zing %- plus :: Many lines + %+ cook |= [a=tape newline=@t] :: Prepend each line with "> " + ^- tape + ;: weld + ">" + ?~(a "" " ") :: If the line is blank, no trailing space + a + "\0a" + == + ;~ plug :: Break into lines + (star ;~(less (just '\0a') prn)) + (just '\0a') + == + :: + ++ ul + |= [u=ul:container:m] + ^- tape + %- zing %+ turn contents.u :: Each bullet point... + |= [item=markdown:m] + ^- tape + %+ scan (markdown item) :: First, render bullet point contents + %+ cook zing + ;~ plug + %+ cook |= [a=tape] :: Prepend 1st line with indent + bullet char + ;: weld + (reap indent-level.u ' ') + (trip marker-char.u) + " " + a + == + line :: first line + %- star + %+ cook |= [a=tape] :: Subsequent lines just get indent + ?: ?|(=("" a) =("\0a" a)) a + ;: weld + (reap indent-level.u ' ') + " " :: 2 spaces, to make it even with the 1st line + a + == + line :: second and thereafter lines + == + ++ tl + |= [t=tl:container:m] + ^- tape + %- zing %+ turn contents.t :: Each bullet point... + |= [is-checked=? item=markdown:m] + ^- tape + %+ scan (markdown item) :: First, render bullet point contents + %+ cook zing + ;~ plug + %+ cook |= [a=tape] :: Prepend 1st line with indent, bullet char, checkbox + ;: weld + (reap indent-level.t ' ') + (trip marker-char.t) + " [" + ?:(is-checked "x" " ") + "] " + a + == + line :: first line + %- star + %+ cook |= [a=tape] :: Subsequent lines just get indent + ?: ?|(=("" a) =("\0a" a)) a + ;: weld + (reap indent-level.t ' ') + " " :: 2 spaces, to make it even with the 1st line + a + == + line :: second and thereafter lines + == + :: + ++ ol + |= [o=ol:container:m] + ^- tape + %- zing %+ turn contents.o :: Each item... + |= [item=markdown:m] + ^- tape + %+ scan (markdown item) :: First, render item contents + %+ cook zing + ;~ plug + %+ cook |= [a=tape] :: Prepend 1st line with indent + item number + ;: weld + (reap indent-level.o ' ') + (a-co:co start-num.o) + (trip marker-char.o) + " " + a + == + line :: first line + %- star + %+ cook |= [a=tape] :: Subsequent lines just get indent + ?: ?|(=("" a) =("\0a" a)) a + ;: weld + (reap indent-level.o ' ') + (reap (lent (a-co:co start-num.o)) ' ') + " " :: 2 spaces, to make it even with the 1st line + a + == + line :: second and thereafter lines + == + -- + :: + ++ markdown + |= [a=markdown:m] + ^- tape + %- zing %+ turn a |= [item=node:markdown:m] + ?- -.item + %leaf (node:leaf +.item) + %container (node:container +.item) + == + -- + -- + :: + :: Enserialize as Sail (manx and marl) + ++ sail-en + =< + |= [document=markdown:m] + =/ link-ref-defs (all-link-ref-definitions document) + ^- manx + ;div + ;* (~(markdown sail-en link-ref-defs) document) + == + :: + |_ [reference-links=(map @t urlt:ln:m)] + ++ inline + |% + ++ contents + |= [=contents:inline:m] + ^- marl + %+ turn contents element + ++ element + |= [e=element:inline:m] + ^- manx + ?+ -.e !! + %text (text e) + %link (link e) + %code-span (code e) + %escape (escape e) + %entity (entity e) + %strong (strong e) + %emphasis (emphasis e) + %soft-line-break (softbrk e) + %line-break (hardbrk e) + %image (image e) + %autolink (autolink e) + :: ...etc + == + ++ text + |= [t=text:inline:m] + ^- manx + [[%$ [%$ (trip text.t)] ~] ~] :: Magic; look up the structure of a `manx` if you want + ++ escape + |= [e=escape:inline:m] + ^- manx + [[%$ [%$ (trip char.e)] ~] ~] :: Magic; look up the structure of a `manx` if you want + ++ entity + |= [e=entity:inline:m] + ^- manx + =/ fulltext (crip ;:(weld "&" (trip code.e) ";")) + [[%$ [%$ `tape`[fulltext ~]] ~] ~] :: We do a little sneaky + ++ softbrk + |= [s=softbrk:inline:m] + ^- manx + (text [%text ' ']) + ++ hardbrk + |= [h=hardbrk:inline:m] + ^- manx + ;br; + ++ code + |= [c=code:inline:m] + ^- manx + ;code: {(trip text.c)} + ++ link + |= [l=link:inline:m] + ^- manx + =/ target target.l + =/ urlt ?- -.target + %direct urlt.target :: Direct link; use it + %ref :: Ref link; look it up + ~| "reflink not found: {}" + (~(got by reference-links) label.target) + == + ;a(href (trip text.url.urlt), title (trip (fall title-text.urlt ''))) + ;* (contents contents.l) + == + ++ image + |= [i=image:inline:m] + ^- manx + =/ target target.i + =/ urlt ?- -.target + %direct urlt.target :: Direct link; use it + %ref :: Ref link; look it up + ~| "reflink not found: {}" + (~(got by reference-links) label.target) + == + ;img(src (trip text.url.urlt), alt (trip alt-text.i)); + ++ autolink + |= [a=autolink:inline:m] + ^- manx + ;a(href (trip text.a)): {(trip text.a)} + ++ emphasis + |= [e=emphasis:inline:m] + ^- manx + ;em + ;* (contents contents.e) + == + ++ strong + |= [s=strong:inline:m] + ^- manx + ;strong + ;* (contents contents.s) + == + -- + ++ leaf + |% + ++ node + |= [n=node:leaf:m] + ^- manx + ?+ -.n !! + %blank-line (blank-line n) + %break (break n) + %heading (heading n) + %indent-codeblock (codeblk-indent n) + %fenced-codeblock (codeblk-fenced n) + %table (table n) + %paragraph (paragraph n) + %link-ref-definition (text:inline [%text ' ']) :: Link ref definitions don't render as anything + :: ...etc + == + ++ heading + |= [h=heading:leaf:m] + ^- manx + :- + :_ ~ ?+ level.h !! :: Tag and attributes; attrs are empty (~) + %1 %h1 + %2 %h2 + %3 %h3 + %4 %h4 + %5 %h5 + %6 %h6 + == + (contents:inline contents.h) + ++ blank-line + |= [b=blank-line:leaf:m] + ^- manx + (text:inline [%text ' ']) + ++ break + |= [b=break:leaf:m] + ^- manx + ;hr; + ++ codeblk-indent + |= [c=codeblk-indent:leaf:m] + ^- manx + ;pre + ;code: {(trip text.c)} + == + ++ codeblk-fenced + |= [c=codeblk-fenced:leaf:m] + ^- manx + ;pre + ;+ ?: =(info-string.c '') + ;code: {(trip text.c)} + ;code(class (weld "language-" (trip info-string.c))): {(trip text.c)} + == + ++ table + |= [t=table:leaf:m] + ^- manx + ;table + ;thead + ;tr + ;* =/ hdr head.t + =/ align align.t + |- + ?~ hdr ~ + :- ;th(align ?-((head align) %c "center", %r "right", %l "left", %n "")) + ;* (contents:inline (head hdr)) + == + $(hdr (tail hdr), align (tail align)) + + == + == + ;tbody + ;* %+ turn rows.t + |= [r=(list contents:inline:m)] + ^- manx + ;tr + ;* =/ row r + =/ align align.t + |- + ?~ row ~ + :- ;td(align ?-((head align) %c "center", %r "right", %l "left", %n "")) + ;* (contents:inline (head row)) + == + $(row (tail row), align (tail align)) + == + == + == + ++ paragraph + |= [p=paragraph:leaf:m] + ^- manx + ;p + ;* (contents:inline contents.p) + == + -- + :: + ++ container + |% + ++ node + |= [n=node:container:m] + ^- manx + ?- -.n + %block-quote (block-quote n) + %ul (ul n) + %ol (ol n) + %tl (tl n) + == + :: + ++ block-quote + |= [b=block-quote:container:m] + ^- manx + ;blockquote + ;* (~(. markdown reference-links) markdown.b) + == + :: + ++ ul + |= [u=ul:container:m] + ^- manx + ;ul + ;* %+ turn contents.u |= [a=markdown:m] + ^- manx + ;li + ;* (~(. markdown reference-links) a) + == + == + :: + ++ ol + |= [o=ol:container:m] + ^- manx + ;ol(start (a-co:co start-num.o)) + ;* %+ turn contents.o |= [a=markdown:m] + ^- manx + ;li + ;* (~(. markdown reference-links) a) + == + == + ++ tl + |= [t=tl:container:m] + ^- manx + ;ul.task-list + ;* %+ turn contents.t |= [is-checked=? a=markdown:m] + ^- manx + ;li + ;+ ?: is-checked + ;input(type "checkbox", checked "true"); + ;input(type "checkbox"); + ;* (~(. markdown reference-links) a) + == + == + -- + :: + ++ markdown + |= [a=markdown:m] + ^- marl + %+ turn a |= [item=node:markdown:m] + ?- -.item + %leaf (node:leaf +.item) + %container (node:container +.item) + == + -- +-- diff --git a/lib/matching-parens.hoon b/lib/matching-parens.hoon new file mode 100644 index 0000000..7636810 --- /dev/null +++ b/lib/matching-parens.hoon @@ -0,0 +1,71 @@ +::|% +:: ++ palindrome +:: %+ knee *@ |. ~+ +:: ;~ pose +:: (cook |=(a=@ +(a)) (ifix [(just 'a') (just 'b')] palindrome)) +:: (cold 0 (easy ~)) +:: == +::-- + +|% + ++ structs + |% + +$ document (list node) + +$ node $@ ~ + $% text + parens + square + == + +$ text [%text @t] + +$ parens [%parens document] + +$ square [%square document] + -- + ++ de + |_ [text-no-match=(unit @t)] + ++ document + %+ cook |=(a=document:structs a) + (star node) + ++ node + %+ cook |=(a=node:structs a) + ;~ pose + square + parens + text + == + ++ square + %+ knee *square:structs |. ~+ :: recurse + %+ cook |=(a=square:structs a) :: cast + %+ stag %square :: tag + %+ ifix [sel ser] :: delimiters + %- star ;~ pose + parens + square + ~(text . [~ ']']) + == + ++ parens + %+ knee *parens:structs |. ~+ :: recurse + %+ cook |=(a=parens:structs a) :: cast + %+ stag %parens :: tag + %+ ifix [pal par] :: delimiters + %- star ;~ pose + parens + square + ~(text . [~ ')']) + == + ++ text + %+ cook |=(a=text:structs ~&("text called" a)) + %+ stag %text + %+ cook + |= a=tape + ~& "tape: {}; match: {}" + (crip a) + %- plus + ;~ less :: text means it doesn't match anything else + square + parens + ?~ text-no-match + prn + ;~(less (just u.text-no-match) prn) + == + -- +-- diff --git a/lib/parser.hoon b/lib/parser.hoon index c890ef7..f2d1f55 100644 --- a/lib/parser.hoon +++ b/lib/parser.hoon @@ -1,6 +1,130 @@ -/- tp=post -/+ sr=sortug +/- tp=post, md=markdown +/+ sr=sortug, mdlib=markdown |% +:: new! using wispem's lib +++ tokenise +|= t=@t ^- (each content-list:tp @t) + =/ parsed (rush t markdown:de:md:mdlib) + ?~ parsed [%| 'parsing error'] + :- %& + %+ turn u.parsed de-node +++ de-node |= =node:markdown:md ^- block:tp + ?~ node [%paragraph ~] + ?- -.node + %leaf (de-leaf +.node) + %container (de-cont +.node) + == + +++ de-leaf |= =node:leaf:markdown:md ^- block:tp + ?~ node [%paragraph ~] + ?- -.node + %heading (de-heading node) + %break [%paragraph :~([%break ~])] + %indent-codeblock [%codeblock text.node ''] + %fenced-codeblock [%codeblock text.node info-string.node] + %html [%codeblock text.node 'html'] + %link-ref-definition [%paragraph :~([%link '' label.node])] + %paragraph [%paragraph (de-inline contents.node)] + %blank-line [%paragraph :~([%break ~])] + %table [%paragraph :~([%break ~])] :: TODO + == +++ de-heading |= h=heading:leaf:markdown:md + :+ %heading (flatten-inline contents.h) + ?: .=(1 level.h) %h1 + ?: .=(2 level.h) %h2 + ?: .=(3 level.h) %h3 + ?: .=(4 level.h) %h4 + ?: .=(5 level.h) %h5 %h6 +++ de-inline |= inls=contents:inline:md + =| res=(list inline:tp) + |- ?~ inls (flop res) + =/ inl i.inls + =/ r=inline:tp ?- -.inl + %escape [%codespan char.inl] + %entity [%codespan code.inl] + %code-span [%codespan text.inl] + %line-break [%break ~] + %soft-line-break [%break ~] + %text [%text text.inl] + %emphasis (de-strong +.inl) + %strong (de-strong +.inl) + %link [%link (de-target target.inl) (flatten-inline contents.inl)] + %image [%img (de-target target.inl) alt-text.inl] + %autolink [%text ''] + %html [%codespan text.inl] + == + $(inls t.inls, res [r res]) +++ de-strong |= [char=@t inls=contents:inline:md] +?: .=('_' char) [%italic (flatten-inline inls)] + [%bold (flatten-inline inls)] +++ de-target |= tar=target:ln:md +:: TODO lotsa stuff here + ?- -.tar + %direct text.url.urlt.tar + %ref label.tar + == +++ flatten-inline |= inls=contents:inline:md ^- @t + =/ res "" + |- ?~ inls (crip res) + =/ inl i.inls + =/ r ?+ -.inl "" + %escape (trip char.inl) + %entity (trip code.inl) + %code-span (trip text.inl) + %text (trip text.inl) + %emphasis (trip (flatten-inline contents.inl)) + %strong (trip (flatten-inline contents.inl)) + %link (trip (flatten-inline contents.inl)) + %image (trip (de-target target.inl)) + %html (trip text.inl) + == + $(inls t.inls, res "{res} {r}") +++ de-cont |= =node:container:markdown:md ^- block:tp + ?~ node [%paragraph ~] + ?- -.node + %block-quote [%blockquote (denest +.node)] + %ol [%list (de-list contents.node) .y] + %ul [%list (de-list contents.node) .n] + %tl [%tasklist (turn contents.node de-task)] + == +++ de-task |= [checked=? mde=markdown:md] ^- task:tp + :_ checked (denest mde) +++ de-list |= lmd=(list markdown:md) ^- (list li:tp) + =| res=(list li:tp) + |- ?~ lmd (flop res) + =/ nodelist i.lmd + =/ blocks %+ turn nodelist de-node + $(lmd t.lmd, res [blocks res]) +++ denest |= mde=markdown:md ^- paragraph:tp + =| res=paragraph:tp + |- ?~ mde (flop res) + =/ block (de-node i.mde) + =/ r=paragraph:tp (break-block block) + =/ nr (weld res r) + $(mde t.mde, res nr) + +++ break-block |= =block:tp ^- paragraph:tp +?+ -.block ~ + %paragraph p.block + %blockquote p.block + %heading :~([%text p.block]) + %codeblock :~([%text code.block]) + %eval :~([%text hoon.block]) + %list (break-list p.block) +== +++ break-list |= lis=(list li:tp) ^- paragraph:tp + =| res=paragraph:tp + |- ?~ lis (flop res) + =/ par (ibreak-list i.lis) + =/ nr (weld res par) + $(lis t.lis, res nr) +++ ibreak-list |= blocks=(list block:tp) ^- paragraph:tp + =| res=paragraph:tp + |- ?~ blocks (flop res) + =/ par (break-block i.blocks) + =/ nr (weld res par) + $(blocks t.blocks, res nr) + :: tape -> post:trill, parsing user input from Sail +$ heading $?(%h1 %h2 %h3 %h4 %h5 %h6) @@ -191,16 +315,8 @@ %ship (scow %p p.i) %codespan "`{(trip p.i)}`" %link "[{(trip show.i)}]({(trip href.i)})" + %img "![{(trip alt.i)}]({(trip src.i)})" %break "\0a" - :: TODO custom syntax - %date - =/ t (time:enjs:format p.i) - ?. ?=(%n -.t) "" (trip p.t) - %note "" :: TODO - %underline (trip p.i) - %sup (trip p.i) - %sub (trip p.i) - %ruby (trip p.i) == ++ tags-to-tape |= t=(set @t) ^- tape diff --git a/lib/rudder.hoon b/lib/rudder.hoon new file mode 100644 index 0000000..b5750ec --- /dev/null +++ b/lib/rudder.hoon @@ -0,0 +1,285 @@ +:: rudder: framework for routing & serving simple web frontends +:: +:: v1.0.2: newborn helmsman +:: +:: the primary usage pattern involves your app calling steer:rudder +:: with a configuration, then calling the resulting gate with an +:: incoming request and relevant context. +:: +:: %. [bowl [eyre-id inbound-request] dat] +:: %- (steer:rudder _dat cmd) +:: [pages route adlib solve] +:: +:: dat is app state passed into and transformed by the frontend code. +:: cmd is the type of app actions that the frontend may produce. +:: pages is a (map term (page _dat cmd)), contains per-view frontend logic. +:: route is a routing function, turning a url query into a $place. +:: adlib gets called with the full request when no route is found. +:: solve is a function that applies a cmd resulting from a POST request. +:: +:: the library provides some default implementations for route and adlib, +:: which you can construct using +point and +fours respectively. +:: +:: for examples and a more detailed description of handling http requests, +:: see /lib/rudder/poke-example.hoon +:: +:: pages implement a bundle of view logic, each implementing a door +:: with three arms. +:: +:: +build gets called for GET requests, producing a $reply to render. +:: +argue gets called for POST requests, turning it into a cmd. +:: +final gets called after POST requests, producing a $reply to render. +:: +:: for examples and a more detailed description of implementing a page, +:: see /lib/rudder/page-example.hoon +:: +::TODO +:: - should rudder really be falling back to generic error messages when +:: calling +final after failure? what if apps/pages want to provide +:: their own generic error message? +:: - in the full-default setup, the behavior of +alert is a little bit +:: awkward. because +point forces routes to omit trailing slashes, +:: you cannot refer to "the current page" in a consistent way. +:: you have to either hardcode the page name, or pass the full url +:: from the inbound-request. +:: a router that forces inclusion of trailing slashes would let you +:: use '.', but has unconventional url semantics, and doesn't mesh +:: nicely with single-level routing. +:: - some inconsistency between the expected output of +adlib and +solve. +:: "briefless" +solve results may be common, so it's nice that they're +:: easy to write. for +adlib that probably isn't as relevant, and +:: the current factoring makes for a nice =^ in the lib code, but... +:: on the other hand, they're still different output types semantically, +:: so inconsistency isn't the end of the world. would have to see how +:: this ends up looking in practice. +:: - +argue is awkward because its function signature doesn't really work +:: if the cmd type is an atom. +:: - maybe unsupported methods should go to the fallback too? +:: - currently ambiguous: do you catch would-fail actions during +argue, +:: or in +solve? might be best to catch earlier, but this splits +:: or duplicates business logic between app and pages... +:: +|% ++| %types :: outputs, inputs, function signatures +:: ++$ reply + $% [%page bod=manx] :: html page + [%xtra hed=header-list:http bod=manx] :: html page w/ heads + [%next loc=@t msg=brief] :: 303, succeeded + [%move loc=@t] :: 308, use other + [%auth loc=@t] :: 307, please log in + [%code cod=@ud msg=brief] :: error code page + [%full ful=simple-payload:http] :: full payload + == +:: ++$ place + $% [%page ath=? nom=term] :: serve from pages + [%away loc=(list @t)] :: 308, redirect + == +:: ++$ query + $: trail + args=(list [key=@t value=@t]) + == +:: ++$ trail + [ext=(unit @ta) site=(list @t)] +:: ++$ order [id=@ta inbound-request:eyre] ++$ route $-(trail (unit place)) ++$ brief ?(~ @t) +:: +++ page + |* [dat=mold cmd=mold] + $_ ^| + |_ [bowl:gall order dat] + ++ build |~([(list [k=@t v=@t]) (unit [? @t])] *reply) + ++ argue |~([header-list:http (unit octs)] *$@(brief cmd)) + ++ final |~([success=? msg=brief] *reply) + -- +:: ++$ card card:agent:gall +:: pilot: core server logic +:: ++| %pilot +:: +++ steer :: main helper constructor + |* [dat=mold cmd=mold] + |^ serve + +$ page (^page dat cmd) + +$ adlib $-(order [[(unit reply) (list card)] dat]) + +$ solve $-(cmd $@(brief [brief (list card) dat])) + :: + ++ serve :: main helper + |= [pages=(map @ta page) =route =adlib =solve] + |= [=bowl:gall =order =dat] + ^- (quip card _dat) + =* id id.order + =+ (purse url.request.order) + =/ target=(unit place) + (route -<) + :: if there is no route, fall back to adlib + :: + ?~ target + =^ [res=(unit reply) caz=(list card)] dat + (adlib order) + :_ dat + ?~ res caz + (weld (spout id (paint u.res)) caz) + :: route might be a redirect + :: + ?: ?=(%away -.u.target) + =+ (rap 3 '/' (join '/' loc.u.target)) + [(spout id (paint %move -)) dat] + :: route might require authentication + :: + ?: &(ath.u.target !authenticated.order) + [(spout id (paint %auth url.request.order)) dat] + :: route might have messed up and pointed to nonexistent page + :: + ?. (~(has by pages) nom.u.target) + [(spout id (issue 404 (cat 3 'no such page: ' nom.u.target))) dat] + :: + %. [bowl order dat] + (apply (~(got by pages) nom.u.target) solve) + :: + ++ apply :: page usage helper + |= [=page =solve] + |= [=bowl:gall =order =dat] + ^- (quip card _dat) + =. page ~(. page bowl order dat) + =* id id.order + ?+ method.request.order + [(spout id (issue 405 ~)) dat] + :: + %'GET' + :_ dat + =+ (purse url.request.order) + =^ msg args + ::NOTE as set by %next replies + ?~ msg=(get-header:http 'rmsg' args) [~ args] + [`[& u.msg] (delete-header:http 'rmsg' args)] + %+ spout id + (paint (build:page args msg)) + :: + %'POST' + ?@ act=(argue:page [header-list body]:request.order) + :_ dat + =? act ?=(~ act) 'failed to parse request' + (spout id (paint (final:page | act))) + ?@ res=(solve act) + :_ dat + =? act ?=(~ act) 'failed to process request' + (spout id (paint (final:page | res))) + :_ +>.res + =. +<+>.page +>.res + (weld (spout id (paint (final:page & -.res))) +<.res) + == + -- +:: easy: hands-off steering behavior +:: ++| %easy +:: +++ point :: simple single-level routing, +route + |= [base=(lest @t) auth=? have=(set term)] + ^- route + |= trail + ^- (unit place) + ?~ site=(decap base site) ~ + ?- u.site + ~ `[%page auth %index] + [~ ~] `[%away (snip ^site)] + [%index ~] `[%away (snip ^site)] + [@ ~] ?:((~(has in have) i.u.site) `[%page auth i.u.site] ~) + [@ ~ ~] `[%away (snip ^site)] + * ~ + == +:: +++ fours :: simple 404 responses, +adlib + |* dat=* + :: ^- adlib:(rest * _dat) + |= * + [[`[%code 404 'no route found'] ~] dat] +:: +++ alert :: simple redirecting +final handler + |= [next=@t build=$-([(list [@t @t]) (unit [? @t])] reply)] + |= [done=? =brief] + ^- reply + ?: done [%next next brief] + (build ~ `[| `@t`brief]) +:: cargo: payload generation +:: ++| %cargo +:: +++ paint :: render response + |= =reply + ^- simple-payload:http + ?- -.reply + %page [[200 ['content-type' 'text/html']~] `(press bod.reply)] + %xtra =? hed.reply ?=(~ (get-header:http 'content-type' hed.reply)) + ['content-type'^'text/html' hed.reply] + [[200 hed.reply] `(press bod.reply)] + %next =; loc [[303 ['location' loc]~] ~] + ?~ msg.reply loc.reply + %+ rap 3 + :~ loc.reply + ?:(?=(^ (find "?" (trip loc.reply))) '&' '?') + 'rmsg=' + (crip (en-urlt:html (trip msg.reply))) + == + %move [[308 ['location' loc.reply]~] ~] + %auth =/ loc (crip (en-urlt:html (trip loc.reply))) + [[307 ['location' (cat 3 '/~/login?redirect=' loc)]~] ~] + %code (issue +.reply) + %full ful.reply + == +:: +++ issue :: render status code page + |= [cod=@ud msg=brief] + ^- simple-payload:http + :- [cod ~] + =; nom=@t + `(as-octs:mimes:html (rap 3 ~[(scot %ud cod) ': ' nom '\0a' msg])) + ?+ cod '' + %400 'bad request' + %404 'not found' + %405 'method not allowed' + %500 'internal server error' + == +:: utils: fidgeting +:: ++| %utils +:: +++ decap :: strip leading base from full site path + |= [base=(list @t) site=(list @t)] + ^- (unit (list @t)) + ?~ base `site + ?~ site ~ + ?. =(i.base i.site) ~ + $(base t.base, site t.site) +:: +++ frisk :: parse url-encoded form args + |= body=@t + %- ~(gas by *(map @t @t)) + (fall (rush body yquy:de-purl:html) ~) +:: +::NOTE the below (and $query) are also available in /lib/server.hoon, +:: but we reimplement them here for independence's sake. +:: +++ purse :: url cord to query + |= url=@t + ^- query + (fall (rush url ;~(plug apat:de-purl:html yque:de-purl:html)) [[~ ~] ~]) +:: +++ press :: manx to octs + (cork en-xml:html as-octt:mimes:html) +:: +++ spout :: build full response cards + |= [eyre-id=@ta simple-payload:http] + ^- (list card) + =/ =path /http-response/[eyre-id] + :~ [%give %fact ~[path] [%http-response-header !>(response-header)]] + [%give %fact ~[path] [%http-response-data !>(data)]] + [%give %kick ~[path] ~] + == +-- diff --git a/lib/seeds.hoon b/lib/seeds.hoon new file mode 100644 index 0000000..715f75d --- /dev/null +++ b/lib/seeds.hoon @@ -0,0 +1,174 @@ +|% +++ authors +^- (list @p) +:~ + ~zod + ~polwex + ~lagrev-nocfep + ~lagrev-nocfep-polwex-nocfep + ~sorreg-namtyv +== +++ titles +^- (list @t) +:~ +'Helldivers 2 has caused over 20k Steam accounts to be banned' +'UI elements with a hand-drawn, sketchy look' +'60 kHz ' +'Show HN: Every mountain, building and tree shadow mapped for any date and time' +'Snowflake breach: Hacker confirms access through infostealer infection' +'Heroku Postgres is now based on AWS Aurora' +'Armor from Mycenaean Greece turns out to have been effective' +'Why is no Laravel/Rails in JavaScript? Will there be one?' +'Moving Beyond Type Systems' +'Japanese \'My Number Card\' Digital IDs Coming to Apple\'s Wallet App' +'How to copy a file from a 30-year-old laptop' +' good corporate engineering blogs are written' +'Debian KDE: Right Linux distribution for professional digital painting in 2024' +'Go: Sentinel errors and errors.Is() slow your code down by 3000%' +'"Moveable Type" to end 17-year run in The New York Times\'s lobby' +'London\'s Evening Standard axes daily print edition' +'The Forth Deck mini: a portable Forth computer with a discrete CPU ' +'Corcel – Use WordPress backend with Laravel or any PHP application ' +'One Million Checkboxes ' +'Next gen 3D metal printing ' +'Figma Slides ' +'GCCs new fortification level: The gains and costs ' +'South Korean telecom company attacks torrent users with malware ' +'Show HN: R2R V2 – A open source RAG engine with prod features ' +'From RSS to My Kindle ' +'How the STL Uses Explicit (quuxplusone.github.io)' +'The brain makes a lot of waste. Now scientists think they know where it goes' +'The plan-execute pattern ' +'1Living Computers Museum to permanently close, auction vintage items ' +'Tracing garbage collection for arenas ' +'Upgrading my Chumby 8 kernel part 11: SD/CF card reader)' +'Exploring How Cache Memory Works ' +'Compressing graphs and indexes with recursive graph bisection (2016)' +'Motion (YC W20) Is Hiring Our First DevOps Engineer ' +'Ghosts in the ROM (2012) ' +'Structured logs are the way to start ' +'Test firing of a 3D-printed rocket engine designed through computational model (leap7m)' +'Took part in Apache ceremonies. schools expelled them for satanic activities' +'The Alternate Reality Kit (1987) [video] (youtube.com)' +'2How automotive radar measures the velocity of objects' +'2Super Mario 64 ported to the GBA [video]' +'APL Demonstration (1975) [video]' +'Composite modding another Atari, because colors are hard ' +'Coup Attempt in Bolivia ' +'Documentation Driven Development (2022) ' +== +++ links +^- (list @t) +:~ +'https://urbit.org' +'https://www.nytimes.com/2024/06/26/world/asia/china-children-crimes.html' +'https://news.ycombinator.com/item?id=40800548' +'https://instagram.com/my.cat.sandy' +'https://xiaohongshu.com' +'https://x.com/urbit/status/1806048064525779405' +'https://x.com/wispem_wantex/status/1790186423804633107' +== +++ md ^- (list @t) +:~ +'Random post 1' +'Random post 2' +'Random post 3' +'Random post 4' +'Random post 5' +'![lol](https://afar.brightspotcdn.com/dims4/default/68ef509/2147483647/strip/false/crop/1440x720+0+0/resize/1440x720!/quality/90/?url=https%3A%2F%2Fk3-prod-afar-media.s3.us-west-2.amazonaws.com%2Fbrightspot%2Fcf%2F8a%2F20b4a2c544a58be93512ad67084c%2Fbohler-japankk-4006.jpg)' +''' +## Recipe: Chocolate Chip Cookies + +**Ingredients:** +- 2 1/4 cups all-purpose flour +- 1 tsp baking soda +- 1 cup butter, softened +- 3/4 cup sugar +- 3/4 cup brown sugar +- 2 eggs +- 2 cups chocolate chips + +**Instructions:** +1. Preheat oven to 375°F (190°C). +2. Mix dry ingredients in a bowl. +3. In another bowl, cream butter and sugars. Add eggs and mix well. +4. Combine wet and dry ingredients. Stir in chocolate chips. +5. Drop spoonfuls onto baking sheets and bake for 9-11 minutes. + +![Chocolate Chip Cookies](https://example.com/cookies.jpg) + +Enjoy your homemade cookies! +''' +''' +# Programming Languages Comparison + +| Language | Type | Popular Use Cases | +|----------|------|-------------------| +| Python | Interpreted | Data Science, Web Development | +| Java | Compiled | Enterprise Applications, Android | +| JavaScript | Interpreted | Web Development, Server-side | + +## Code Examples + +Python: +```python +def greet(name): + print(f"Hello, {name}!") +''' +''' +# Book Review: "1984" by George Orwell + +**Rating:** ⭐⭐⭐⭐⭐ + +"1984" is a dystopian novel that explores themes of totalitarianism, surveillance, and the manipulation of truth. + +## Key Themes +1. Government control +2. Loss of privacy +3. Manipulation of language and history + +> "Who controls the past controls the future. Who controls the present controls the past." - George Orwell, 1984 + +The book serves as a warning about the dangers of totalitarian regimes and the importance of individual freedom. +''' +''' +# The Solar System + +Our solar system consists of the Sun and everything that orbits around it. + +## Planets in Order from the Sun + +1. Mercury +2. Venus +3. Earth (our home!) +4. Mars +5. Jupiter +6. Saturn +7. Uranus +8. Neptune + +> Fun Fact: Pluto was once considered the 9th planet but was reclassified as a dwarf planet in 2006. + +For more astronomical information, visit [NASA's website](https://www.nasa.gov). +''' +''' +# Travel Guide: Paris, France + +Paris, known as the "City of Light," is famous for its art, cuisine, and architecture. + +## Must-Visit Attractions + +1. Eiffel Tower +2. Louvre Museum +3. Notre-Dame Cathedral +4. Arc de Triomphe +5. Champs-Élysées + +> "Paris is always a good idea." - Audrey Hepburn + +![Paris Skyline](https://example.com/paris.jpg) + +Don't forget to try some authentic French cuisine while you're there! +''' +== +-- diff --git a/lib/skeleton.hoon b/lib/skeleton.hoon new file mode 100644 index 0000000..982c371 --- /dev/null +++ b/lib/skeleton.hoon @@ -0,0 +1,51 @@ +:: Similar to default-agent except crashes everywhere +^- agent:gall +|_ bowl:gall +++ on-init + ^- (quip card:agent:gall agent:gall) + !! +:: +++ on-save + ^- vase + !! +:: +++ on-load + |~ old-state=vase + ^- (quip card:agent:gall agent:gall) + !! +:: +++ on-poke + |~ in-poke-data=cage + ^- (quip card:agent:gall agent:gall) + !! +:: +++ on-watch + |~ path + ^- (quip card:agent:gall agent:gall) + !! +:: +++ on-leave + |~ path + ^- (quip card:agent:gall agent:gall) + !! +:: +++ on-peek + |~ path + ^- (unit (unit cage)) + !! +:: +++ on-agent + |~ [wire sign:agent:gall] + ^- (quip card:agent:gall agent:gall) + !! +:: +++ on-arvo + |~ [wire =sign-arvo] + ^- (quip card:agent:gall agent:gall) + !! +:: +++ on-fail + |~ [term tang] + ^- (quip card:agent:gall agent:gall) + !! +-- diff --git a/lib/sortug.hoon b/lib/sortug.hoon index a324349..79000c1 100644 --- a/lib/sortug.hoon +++ b/lib/sortug.hoon @@ -1,17 +1,22 @@ :: Painstakingly built utility functions by Sortug Development Ltd. :: There's more where it came from -:: Parsing |% ++ b64 (bass 64 (plus siw:ab)) ++ b16 (bass 16 (plus six:ab)) ++ scow |= [mod=@tas a=@] ^- tape ?+ mod "" + %s (signed-scow a) %ud (a-co:co a) %ux ((x-co:co 0) a) %uv ((v-co:co 0) a) %uw ((w-co:co 0) a) == +++ signed-scow |= a=@s ^- tape + =/ old (old:si a) + =/ num (scow %ud +.old) + =/ sign=tape ?: -.old "" "-" + "{sign}{num}" ++ slaw |= [mod=@tas txt=@t] ^- (unit @) ?+ mod ~ @@ -30,4 +35,80 @@ ?~ a b =/ nb (c i i.a b) $(a t.a, b nb, i +(i)) +++ parsing + |% + ++ link auri:de-purl:html + ++ para + |% + ++ eof ;~(less next (easy ~)) + ++ white (mask "\09 ") + ++ blank ;~(plug (star white) (just '\0a')) + ++ hard-wrap (cold ' ' ;~(plug blank (star white))) + ++ one-space (cold ' ' (plus white)) + ++ empty + ;~ pose + ;~(plug blank (plus blank)) + ;~(plug (star white) eof) + ;~(plug blank (star white) eof) + == + ++ para + %+ ifix + [(star white) empty] + %- plus + ;~ less + empty + next + == + -- + ++ trim para:para :: from whom/lib/docu + ++ youtube + ;~ pfix + ;~ plug + (jest 'https://') + ;~ pose + (jest 'www.youtube.com/watch?v=') + (jest 'youtube.com/watch?v=') + (jest 'youtu.be/') + == + == + ;~ sfix + (star aln) + (star next) + == + == + ++ twatter + ;~ pfix + ;~ plug + (jest 'https://') + ;~ pose + (jest 'x.com/') + (jest 'twitter.com/') + == + (star ;~(less fas next)) + (jest '/status/') + == + ;~ sfix + (star nud) + (star next) + == + == + ++ img-set + %- silt + :~ ~.webp + ~.png + ~.jpeg + ~.jpg + ~.svg + == + ++ is-img + |= t=@ta + (~(has in img-set) t) + ++ is-image + |= url=@t ^- ? + =/ u=(unit purl:eyre) (de-purl:html url) + ?~ u .n + =/ ext p.q.u.u + ?~ ext .n + (~(has in img-set) u.ext) + -- -- diff --git a/lib/strand.hoon b/lib/strand.hoon new file mode 100644 index 0000000..b0db35b --- /dev/null +++ b/lib/strand.hoon @@ -0,0 +1 @@ +rand diff --git a/lib/strandio.hoon b/lib/strandio.hoon new file mode 100644 index 0000000..7660e22 --- /dev/null +++ b/lib/strandio.hoon @@ -0,0 +1,832 @@ +/- spider +/+ libstrand=strand +=, strand=strand:libstrand +=, strand-fail=strand-fail:libstrand +|% +++ send-raw-cards + |= cards=(list =card:agent:gall) + =/ m (strand ,~) + ^- form:m + |= strand-input:strand + [cards %done ~] +:: +++ send-raw-card + |= =card:agent:gall + =/ m (strand ,~) + ^- form:m + (send-raw-cards card ~) +:: +++ ignore + |= tin=strand-input:strand + `[%fail %ignore ~] +:: +++ get-bowl + =/ m (strand ,bowl:strand) + ^- form:m + |= tin=strand-input:strand + `[%done bowl.tin] +:: +++ get-beak + =/ m (strand ,beak) + ^- form:m + |= tin=strand-input:strand + `[%done [our q.byk da+now]:bowl.tin] +:: +++ get-time + =/ m (strand ,@da) + ^- form:m + |= tin=strand-input:strand + `[%done now.bowl.tin] +:: +++ get-our + =/ m (strand ,ship) + ^- form:m + |= tin=strand-input:strand + `[%done our.bowl.tin] +:: +++ get-entropy + =/ m (strand ,@uvJ) + ^- form:m + |= tin=strand-input:strand + `[%done eny.bowl.tin] +:: +:: Convert skips to %ignore failures. +:: +:: This tells the main loop to try the next handler. +:: +++ handle + |* a=mold + =/ m (strand ,a) + |= =form:m + ^- form:m + |= tin=strand-input:strand + =/ res (form tin) + =? next.res ?=(%skip -.next.res) + [%fail %ignore ~] + res +:: +:: Wait for a poke with a particular mark +:: +++ take-poke + |= =mark + =/ m (strand ,vase) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ + `[%wait ~] + :: + [~ %poke @ *] + ?. =(mark p.cage.u.in.tin) + `[%skip ~] + `[%done q.cage.u.in.tin] + == +:: +++ take-sign-arvo + =/ m (strand ,[wire sign-arvo]) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ + `[%wait ~] + :: + [~ %sign *] + `[%done [wire sign-arvo]:u.in.tin] + == +:: +:: Wait for a subscription update on a wire +:: +++ take-fact-prefix + |= =wire + =/ m (strand ,[path cage]) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %agent * %fact *] + ?. =(watch+wire (scag +((lent wire)) wire.u.in.tin)) + `[%skip ~] + `[%done (slag (lent wire) wire.u.in.tin) cage.sign.u.in.tin] + == +:: +:: Wait for a subscription update on a wire +:: +++ take-fact + |= =wire + =/ m (strand ,cage) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %agent * %fact *] + ?. =(watch+wire wire.u.in.tin) + `[%skip ~] + `[%done cage.sign.u.in.tin] + == +:: +:: Wait for a subscription close +:: +++ take-kick + |= =wire + =/ m (strand ,~) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %agent * %kick *] + ?. =(watch+wire wire.u.in.tin) + `[%skip ~] + `[%done ~] + == +:: +++ echo + =/ m (strand ,~) + ^- form:m + %- (main-loop ,~) + :~ |= ~ + ^- form:m + ;< =vase bind:m ((handle ,vase) (take-poke %echo)) + =/ message=tape !<(tape vase) + %- (slog leaf+"{message}..." ~) + ;< ~ bind:m (sleep ~s2) + %- (slog leaf+"{message}.." ~) + (pure:m ~) + :: + |= ~ + ^- form:m + ;< =vase bind:m ((handle ,vase) (take-poke %over)) + %- (slog leaf+"over..." ~) + (pure:m ~) + == +:: +++ take-watch + =/ m (strand ,path) + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %watch *] + `[%done path.u.in.tin] + == +:: +++ take-wake + |= until=(unit @da) + =/ m (strand ,~) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %sign [%wait @ ~] %behn %wake *] + ?. |(?=(~ until) =(`u.until (slaw %da i.t.wire.u.in.tin))) + `[%skip ~] + ?~ error.sign-arvo.u.in.tin + `[%done ~] + `[%fail %timer-error u.error.sign-arvo.u.in.tin] + == +:: +++ take-tune + |= =wire + =/ m (strand ,[spar:ames (unit roar:ames)]) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + :: + [~ %sign * %ames %tune ^ *] + ?. =(wire wire.u.in.tin) + `[%skip ~] + `[%done +>.sign-arvo.u.in.tin] + == +:: +++ take-near + |= =wire + =/ m (strand ,[spar:ames (unit (unit page))]) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + :: + [~ %sign * %ames %near ^ *] + ?. =(wire wire.u.in.tin) + `[%skip ~] + `[%done +>.sign-arvo.u.in.tin] + == +:: +++ take-poke-ack + |= =wire + =/ m (strand ,~) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %agent * %poke-ack *] + ?. =(wire wire.u.in.tin) + `[%skip ~] + ?~ p.sign.u.in.tin + `[%done ~] + `[%fail %poke-fail u.p.sign.u.in.tin] + == +:: +++ take-watch-ack + |= =wire + =/ m (strand ,~) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %agent * %watch-ack *] + ?. =(watch+wire wire.u.in.tin) + `[%skip ~] + ?~ p.sign.u.in.tin + `[%done ~] + `[%fail %watch-ack-fail u.p.sign.u.in.tin] + == +:: +++ poke + |= [=dock =cage] + =/ m (strand ,~) + ^- form:m + =/ =card:agent:gall [%pass /poke %agent dock %poke cage] + ;< ~ bind:m (send-raw-card card) + (take-poke-ack /poke) +:: +++ raw-poke + |= [=dock =cage] + =/ m (strand ,~) + ^- form:m + =/ =card:agent:gall [%pass /poke %agent dock %poke cage] + ;< ~ bind:m (send-raw-card card) + =/ m (strand ,~) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ + `[%wait ~] + :: + [~ %agent * %poke-ack *] + ?. =(/poke wire.u.in.tin) + `[%skip ~] + `[%done ~] + == +:: +++ raw-poke-our + |= [app=term =cage] + =/ m (strand ,~) + ^- form:m + ;< =bowl:spider bind:m get-bowl + (raw-poke [our.bowl app] cage) +:: +++ poke-our + |= [=term =cage] + =/ m (strand ,~) + ^- form:m + ;< our=@p bind:m get-our + (poke [our term] cage) +:: +++ watch + |= [=wire =dock =path] + =/ m (strand ,~) + ^- form:m + =/ =card:agent:gall [%pass watch+wire %agent dock %watch path] + ;< ~ bind:m (send-raw-card card) + (take-watch-ack wire) +:: +++ watch-one + |= [=wire =dock =path] + =/ m (strand ,cage) + ^- form:m + ;< ~ bind:m (watch wire dock path) + ;< =cage bind:m (take-fact wire) + ;< ~ bind:m (take-kick wire) + (pure:m cage) +:: +++ watch-our + |= [=wire =term =path] + =/ m (strand ,~) + ^- form:m + ;< our=@p bind:m get-our + (watch wire [our term] path) +:: +++ scry + |* [=mold =path] + =/ m (strand ,mold) + ^- form:m + ?> ?=(^ path) + ?> ?=(^ t.path) + ;< =bowl:spider bind:m get-bowl + %- pure:m + .^(mold i.path (scot %p our.bowl) i.t.path (scot %da now.bowl) t.t.path) +:: +++ leave + |= [=wire =dock] + =/ m (strand ,~) + ^- form:m + =/ =card:agent:gall [%pass watch+wire %agent dock %leave ~] + (send-raw-card card) +:: +++ leave-our + |= [=wire =term] + =/ m (strand ,~) + ^- form:m + ;< our=@p bind:m get-our + (leave wire [our term]) +:: +++ rewatch + |= [=wire =dock =path] + =/ m (strand ,~) + ;< ~ bind:m ((handle ,~) (take-kick wire)) + ;< ~ bind:m (flog-text "rewatching {} {}") + ;< ~ bind:m (watch wire dock path) + (pure:m ~) +:: +++ wait + |= until=@da + =/ m (strand ,~) + ^- form:m + ;< ~ bind:m (send-wait until) + (take-wake `until) +:: +++ keen + |= [=wire =spar:ames] + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass wire %arvo %a %keen ~ spar) +:: +++ keen-shut + |= [=wire =spar:ames] + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass wire %keen & spar) +:: +++ sleep + |= for=@dr + =/ m (strand ,~) + ^- form:m + ;< now=@da bind:m get-time + (wait (add now for)) +:: +++ send-wait + |= until=@da + =/ m (strand ,~) + ^- form:m + =/ =card:agent:gall + [%pass /wait/(scot %da until) %arvo %b %wait until] + (send-raw-card card) +:: +++ map-err + |* computation-result=mold + =/ m (strand ,computation-result) + |= [f=$-([term tang] [term tang]) computation=form:m] + ^- form:m + |= tin=strand-input:strand + =* loop $ + =/ c-res (computation tin) + ?: ?=(%cont -.next.c-res) + c-res(self.next ..loop(computation self.next.c-res)) + ?. ?=(%fail -.next.c-res) + c-res + c-res(err.next (f err.next.c-res)) +:: +++ set-timeout + |* computation-result=mold + =/ m (strand ,computation-result) + |= [time=@dr computation=form:m] + ^- form:m + ;< now=@da bind:m get-time + =/ when (add now time) + =/ =card:agent:gall + [%pass /timeout/(scot %da when) %arvo %b %wait when] + ;< ~ bind:m (send-raw-card card) + |= tin=strand-input:strand + =* loop $ + ?: ?& ?=([~ %sign [%timeout @ ~] %behn %wake *] in.tin) + =((scot %da when) i.t.wire.u.in.tin) + == + `[%fail %timeout ~] + =/ c-res (computation tin) + ?: ?=(%cont -.next.c-res) + c-res(self.next ..loop(computation self.next.c-res)) + ?: ?=(%done -.next.c-res) + =/ =card:agent:gall + [%pass /timeout/(scot %da when) %arvo %b %rest when] + c-res(cards [card cards.c-res]) + c-res +:: +++ send-request + |= =request:http + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass /request %arvo %i %request request *outbound-config:iris) +:: +++ send-cancel-request + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass /request %arvo %i %cancel-request ~) +:: +++ take-client-response + =/ m (strand ,client-response:iris) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + :: + [~ %sign [%request ~] %iris %http-response %cancel *] + ::NOTE iris does not (yet?) retry after cancel, so it means failure + :- ~ + :+ %fail + %http-request-cancelled + ['http request was cancelled by the runtime']~ + :: + [~ %sign [%request ~] %iris %http-response %finished *] + `[%done client-response.sign-arvo.u.in.tin] + == +:: +:: Wait until we get an HTTP response or cancelation and unset contract +:: +++ take-maybe-sigh + =/ m (strand ,(unit httr:eyre)) + ^- form:m + ;< rep=(unit client-response:iris) bind:m + take-maybe-response + ?~ rep + (pure:m ~) + :: XX s/b impossible + :: + ?. ?=(%finished -.u.rep) + (pure:m ~) + (pure:m (some (to-httr:iris +.u.rep))) +:: +++ take-maybe-response + =/ m (strand ,(unit client-response:iris)) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %sign [%request ~] %iris %http-response %cancel *] + `[%done ~] + [~ %sign [%request ~] %iris %http-response %finished *] + `[%done `client-response.sign-arvo.u.in.tin] + == +:: +++ extract-body + |= =client-response:iris + =/ m (strand ,cord) + ^- form:m + ?> ?=(%finished -.client-response) + %- pure:m + ?~ full-file.client-response '' + q.data.u.full-file.client-response +:: +++ fetch-cord + |= url=tape + =/ m (strand ,cord) + ^- form:m + =/ =request:http [%'GET' (crip url) ~ ~] + ;< ~ bind:m (send-request request) + ;< =client-response:iris bind:m take-client-response + (extract-body client-response) +:: +++ fetch-json + |= url=tape + =/ m (strand ,json) + ^- form:m + ;< =cord bind:m (fetch-cord url) + =/ json=(unit json) (de:json:html cord) + ?~ json + (strand-fail %json-parse-error ~) + (pure:m u.json) +:: +++ hiss-request + |= =hiss:eyre + =/ m (strand ,(unit httr:eyre)) + ^- form:m + ;< ~ bind:m (send-request (hiss-to-request:html hiss)) + take-maybe-sigh +:: +:: +build-file: build the source file at the specified $beam +:: +++ build-file + |= [[=ship =desk =case] =spur] + =* arg +< + =/ m (strand ,(unit vase)) + ^- form:m + ;< =riot:clay bind:m + (warp ship desk ~ %sing %a case spur) + ?~ riot + (pure:m ~) + ?> =(%vase p.r.u.riot) + (pure:m (some !<(vase q.r.u.riot))) +:: +++ build-file-hard + |= [[=ship =desk =case] =spur] + =* arg +< + =/ m (strand ,vase) + ^- form:m + ;< =riot:clay + bind:m + (warp ship desk ~ %sing %a case spur) + ?> ?=(^ riot) + ?> ?=(%vase p.r.u.riot) + (pure:m !<(vase q.r.u.riot)) +:: +build-mark: build a mark definition to a $dais +:: +++ build-mark + |= [[=ship =desk =case] mak=mark] + =* arg +< + =/ m (strand ,dais:clay) + ^- form:m + ;< =riot:clay bind:m + (warp ship desk ~ %sing %b case /[mak]) + ?~ riot + (strand-fail %build-mark >arg< ~) + ?> =(%dais p.r.u.riot) + (pure:m !<(dais:clay q.r.u.riot)) +:: +build-tube: build a mark conversion gate ($tube) +:: +++ build-tube + |= [[=ship =desk =case] =mars:clay] + =* arg +< + =/ m (strand ,tube:clay) + ^- form:m + ;< =riot:clay bind:m + (warp ship desk ~ %sing %c case /[a.mars]/[b.mars]) + ?~ riot + (strand-fail %build-tube >arg< ~) + ?> =(%tube p.r.u.riot) + (pure:m !<(tube:clay q.r.u.riot)) +:: +:: +build-nave: build a mark definition to a $nave +:: +++ build-nave + |= [[=ship =desk =case] mak=mark] + =* arg +< + =/ m (strand ,vase) + ^- form:m + ;< =riot:clay bind:m + (warp ship desk ~ %sing %e case /[mak]) + ?~ riot + (strand-fail %build-nave >arg< ~) + ?> =(%nave p.r.u.riot) + (pure:m q.r.u.riot) +:: +build-cast: build a mark conversion gate (static) +:: +++ build-cast + |= [[=ship =desk =case] =mars:clay] + =* arg +< + =/ m (strand ,vase) + ^- form:m + ;< =riot:clay bind:m + (warp ship desk ~ %sing %f case /[a.mars]/[b.mars]) + ?~ riot + (strand-fail %build-cast >arg< ~) + ?> =(%cast p.r.u.riot) + (pure:m q.r.u.riot) +:: +:: Read from Clay +:: +++ warp + |= [=ship =riff:clay] + =/ m (strand ,riot:clay) + ;< ~ bind:m (send-raw-card %pass /warp %arvo %c %warp ship riff) + (take-writ /warp) +:: +++ read-file + |= [[=ship =desk =case] =spur] + =* arg +< + =/ m (strand ,cage) + ;< =riot:clay bind:m (warp ship desk ~ %sing %x case spur) + ?~ riot + (strand-fail %read-file >arg< ~) + (pure:m r.u.riot) +:: +++ check-for-file + |= [[=ship =desk =case] =spur] + =/ m (strand ,?) + ;< =riot:clay bind:m (warp ship desk ~ %sing %u case spur) + ?> ?=(^ riot) + (pure:m !<(? q.r.u.riot)) +:: +++ list-tree + |= [[=ship =desk =case] =spur] + =* arg +< + =/ m (strand ,(list path)) + ;< =riot:clay bind:m (warp ship desk ~ %sing %t case spur) + ?~ riot + (strand-fail %list-tree >arg< ~) + (pure:m !<((list path) q.r.u.riot)) +:: +:: Take Clay read result +:: +++ take-writ + |= =wire + =/ m (strand ,riot:clay) + ^- form:m + |= tin=strand-input:strand + ?+ in.tin `[%skip ~] + ~ `[%wait ~] + [~ %sign * ?(%behn %clay) %writ *] + ?. =(wire wire.u.in.tin) + `[%skip ~] + `[%done +>.sign-arvo.u.in.tin] + == +:: +check-online: require that peer respond before timeout +:: +++ check-online + |= [who=ship lag=@dr] + =/ m (strand ,~) + ^- form:m + %+ (map-err ,~) |=(* [%offline *tang]) + %+ (set-timeout ,~) lag + ;< ~ bind:m + (poke [who %hood] %helm-hi !>(~)) + (pure:m ~) +:: +++ eval-hoon + |= [gen=hoon bez=(list beam)] + =/ m (strand ,vase) + ^- form:m + =/ sut=vase !>(..zuse) + |- + ?~ bez + (pure:m (slap sut gen)) + ;< vax=vase bind:m (build-file-hard i.bez) + $(bez t.bez, sut (slop vax sut)) +:: +++ send-thread + |= [=bear:khan =shed:khan =wire] + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass wire %arvo %k %lard bear shed) +:: +:: Queue on skip, try next on fail %ignore +:: +++ main-loop + |* a=mold + =/ m (strand ,~) + =/ m-a (strand ,a) + =| queue=(qeu (unit input:strand)) + =| active=(unit [in=(unit input:strand) =form:m-a forms=(list $-(a form:m-a))]) + =| state=a + |= forms=(lest $-(a form:m-a)) + ^- form:m + |= tin=strand-input:strand + =* top `form:m`..$ + =. queue (~(put to queue) in.tin) + |^ (continue bowl.tin) + :: + ++ continue + |= =bowl:strand + ^- output:m + ?> =(~ active) + ?: =(~ queue) + `[%cont top] + =^ in=(unit input:strand) queue ~(get to queue) + ^- output:m + =. active `[in (i.forms state) t.forms] + ^- output:m + (run bowl in) + :: + ++ run + ^- form:m + |= tin=strand-input:strand + ^- output:m + ?> ?=(^ active) + =/ res (form.u.active tin) + =/ =output:m + ?- -.next.res + %wait `[%wait ~] + %skip `[%cont ..$(queue (~(put to queue) in.tin))] + %cont `[%cont ..$(active `[in.u.active self.next.res forms.u.active])] + %done (continue(active ~, state value.next.res) bowl.tin) + %fail + ?: &(?=(^ forms.u.active) ?=(%ignore p.err.next.res)) + %= $ + active `[in.u.active (i.forms.u.active state) t.forms.u.active] + in.tin in.u.active + == + `[%fail err.next.res] + == + [(weld cards.res cards.output) next.output] + -- +:: +++ retry + |* result=mold + |= [crash-after=(unit @ud) computation=_*form:(strand (unit result))] + =/ m (strand ,result) + =| try=@ud + |- ^- form:m + =* loop $ + ?: =(crash-after `try) + (strand-fail %retry-too-many ~) + ;< ~ bind:m (backoff try ~m1) + ;< res=(unit result) bind:m computation + ?^ res + (pure:m u.res) + loop(try +(try)) +:: +++ backoff + |= [try=@ud limit=@dr] + =/ m (strand ,~) + ^- form:m + ;< eny=@uvJ bind:m get-entropy + %- sleep + %+ min limit + ?: =(0 try) ~s0 + %+ add + (mul ~s1 (bex (dec try))) + (mul ~s0..0001 (~(rad og eny) 1.000)) +:: +:: ---- +:: +:: Output +:: +++ flog + |= =flog:dill + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass / %arvo %d %flog flog) +:: +++ flog-text + |= =tape + =/ m (strand ,~) + ^- form:m + (flog %text tape) +:: +++ flog-tang + |= =tang + =/ m (strand ,~) + ^- form:m + =/ =wall + (zing (turn (flop tang) (cury wash [0 80]))) + |- ^- form:m + =* loop $ + ?~ wall + (pure:m ~) + ;< ~ bind:m (flog-text i.wall) + loop(wall t.wall) +:: +++ trace + |= =tang + =/ m (strand ,~) + ^- form:m + (pure:m ((slog tang) ~)) +:: +++ app-message + |= [app=term =cord =tang] + =/ m (strand ,~) + ^- form:m + =/ msg=tape :(weld (trip app) ": " (trip cord)) + ;< ~ bind:m (flog-text msg) + (flog-tang tang) +:: +:: ---- +:: +:: Handle domains +:: +++ install-domain + |= =turf + =/ m (strand ,~) + ^- form:m + (send-raw-card %pass / %arvo %e %rule %turf %put turf) +:: +:: ---- +:: +:: Threads +:: +++ start-thread + |= file=term + =/ m (strand ,tid:spider) + ;< =bowl:spider bind:m get-bowl + (start-thread-with-args byk.bowl file *vase) +:: +++ start-thread-with-args + |= [=beak file=term args=vase] + =/ m (strand ,tid:spider) + ^- form:m + ;< =bowl:spider bind:m get-bowl + =/ tid + (scot %ta (cat 3 (cat 3 'strand_' file) (scot %uv (sham file eny.bowl)))) + =/ poke-vase !>(`start-args:spider`[`tid.bowl `tid beak file args]) + ;< ~ bind:m (poke-our %spider %spider-start poke-vase) + ;< ~ bind:m (sleep ~s0) :: wait for thread to start + (pure:m tid) +:: ++$ thread-result + (each vase [term tang]) +:: +++ await-thread + |= [file=term args=vase] + =/ m (strand ,thread-result) + ^- form:m + ;< =bowl:spider bind:m get-bowl + =/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl)))) + =/ poke-vase !>(`start-args:spider`[`tid.bowl `tid byk.bowl file args]) + ;< ~ bind:m (watch-our /awaiting/[tid] %spider /thread-result/[tid]) + ;< ~ bind:m (poke-our %spider %spider-start poke-vase) + ;< ~ bind:m (sleep ~s0) :: wait for thread to start + ;< =cage bind:m (take-fact /awaiting/[tid]) + ;< ~ bind:m (take-kick /awaiting/[tid]) + ?+ p.cage ~|([%strange-thread-result p.cage file tid] !!) + %thread-done (pure:m %& q.cage) + %thread-fail (pure:m %| ;;([term tang] q.q.cage)) + == +-- diff --git a/lib/verb.hoon b/lib/verb.hoon new file mode 100644 index 0000000..06f06e0 --- /dev/null +++ b/lib/verb.hoon @@ -0,0 +1,182 @@ +:: Print what your agent is doing. +:: +/- *verb +:: +|= [loud=? =agent:gall] +=| bowl-print=_| +^- agent:gall +|^ !. +|_ =bowl:gall ++* this . + ag ~(. agent bowl) +:: +++ on-init + ^- (quip card:agent:gall agent:gall) + %- (print bowl |.("{}: on-init")) + =^ cards agent on-init:ag + :_ this + :_ :_ cards + (emit-event %on-init ~) + (emit-event-plus bowl [%on-init ~] cards) +:: +++ on-save + ^- vase + %- (print bowl |.("{}: on-save")) + on-save:ag +:: +++ on-load + |= old-state=vase + ^- (quip card:agent:gall agent:gall) + %- (print bowl |.("{}: on-load")) + =^ cards agent (on-load:ag old-state) + :_ this + :_ :_ cards + (emit-event %on-load ~) + (emit-event-plus bowl [%on-load ~] cards) +:: +++ on-poke + |= [=mark =vase] + ^- (quip card:agent:gall agent:gall) + %- (print bowl |.("{}: on-poke with mark {}")) + ?: ?=(%verb mark) + ?- !<(?(%loud %bowl) vase) + %loud `this(loud !loud) + %bowl `this(bowl-print !bowl-print) + == + =^ cards agent (on-poke:ag mark vase) + :_ this + :_ :_ cards + (emit-event %on-poke mark) + (emit-event-plus bowl [%on-poke mark (mug q.vase)] cards) +:: +++ on-watch + |= =path + ^- (quip card:agent:gall agent:gall) + %- (print bowl |.("{}: on-watch on path {}")) + =^ cards agent + ?: ?=([%verb ?(%events %events-plus) ~] path) + [~ agent] + (on-watch:ag path) + :_ this + :_ :_ cards + (emit-event %on-watch path) + (emit-event-plus bowl [%on-watch path] cards) +:: +++ on-leave + |= =path + ^- (quip card:agent:gall agent:gall) + %- (print bowl |.("{}: on-leave on path {}")) + ?: ?=([%verb %event ~] path) + [~ this] + =^ cards agent (on-leave:ag path) + :_ this + :_ :_ cards + (emit-event %on-leave path) + (emit-event-plus bowl [%on-leave path] cards) +:: +++ on-peek + |= =path + ^- (unit (unit cage)) + %- (print bowl |.("{}: on-peek on path {}")) + (on-peek:ag path) +:: +++ on-agent + |= [=wire =sign:agent:gall] + ^- (quip card:agent:gall agent:gall) + %- (print bowl |.("{}: on-agent on wire {}, {<-.sign>}")) + =^ cards agent (on-agent:ag wire sign) + :_ this + :_ :_ cards + (emit-event %on-agent wire -.sign) + =; =^sign + (emit-event-plus bowl [%on-agent wire sign] cards) + ?- -.sign + %poke-ack [%poke-ack ?=(~ p.sign)] + %watch-ack [%watch-ack ?=(~ p.sign)] + %kick [%kick ~] + %fact [%fact p.cage.sign (mug q.q.cage.sign)] + == +:: +++ on-arvo + |= [=wire =sign-arvo] + ^- (quip card:agent:gall agent:gall) + %- %+ print bowl |. + "{}: on-arvo on wire {}, {<[- +<]:sign-arvo>}" + =^ cards agent (on-arvo:ag wire sign-arvo) + :_ this + :_ :_ cards + (emit-event %on-arvo wire [- +<]:sign-arvo) + (emit-event-plus bowl [%on-arvo wire [- +<]:sign-arvo] cards) +:: +++ on-fail + |= [=term =tang] + ^- (quip card:agent:gall agent:gall) + %- (print bowl |.("{}: on-fail with term {}")) + =^ cards agent (on-fail:ag term tang) + :_ this + :_ :_ cards + (emit-event %on-fail term) + (emit-event-plus bowl [%on-fail term] cards) +-- +:: +++ print + |= [=bowl:gall render=(trap tape)] + ^+ same + =? . bowl-print + %- (slog >bowl< ~) + . + ?. loud same + %- (slog [%leaf $:render] ~) + same +:: +++ emit-event + |= =event + ^- card:agent:gall + [%give %fact ~[/verb/events] %verb-event !>(event)] +:: +++ emit-event-plus + |= [=bowl:gall =cause cards=(list card:agent:gall)] + ^- card:agent:gall + =; event=event-plus + [%give %fact ~[/verb/events-plus] %verb-event-plus !>(event)] + =- [act.bowl now.bowl src.bowl sap.bowl cause -] + %+ turn cards + |= =card:agent:gall + ^- effect + ::TODO for %fact, %kick, could calculate how many ships affected + ?- card + [%pass * %agent * ?(%poke %poke-as) *] + =, q.card + =/ =cage ?-(-.task.q.card %poke cage.task, %poke-as [mark.task q.cage.task]) + [%poke p.card [ship name] p.cage `@`(mug q.q.cage)] + :: + [%pass * %agent * ?(%watch %watch-as) *] + =, q.card + =/ =path ?-(-.task.q.card %watch path.task, %watch-as path.task) + [%watch p.card [ship name] path] + :: + [%pass * %agent * %leave *] + =, q.card + [%leave p.card [ship name]] + :: + [%give %fact *] + =, p.card + [%fact paths p.cage (mug q.q.cage)] + :: + [%give %kick *] + [%kick paths.p.card] + :: + [%give ?(%poke-ack %watch-ack) *] + ~| %explicit-ack + !! :: shouldn't be given explicitly + :: + [%pass * %arvo *] + [%arvo p.card -.q.card +<.q.card] + :: + [%pass *] + [%arvo p.card %$ -.q.card] + :: + [%slip *] + $(card [%pass //slip p.card]) + == +-- diff --git a/mar/tang.hoon b/mar/tang.hoon new file mode 100644 index 0000000..9fdd314 --- /dev/null +++ b/mar/tang.hoon @@ -0,0 +1,25 @@ +:: +:::: /hoon/tang/mar + :: +/? 310 +:: +=, format +|_ tan=(list tank) +++ grad %noun +++ grow + |% + ++ noun tan + ++ json + =/ result=(each (list ^json) tang) + (mule |.((turn tan tank:enjs:format))) + ?- -.result + %& a+p.result + %| a+[a+[%s '[[output rendering error]]']~]~ + == + -- +++ grab :: convert from + |% + ++ noun (list ^tank) :: clam from %noun + ++ tank |=(a=^tank [a]~) + -- +-- diff --git a/sur/forum.hoon b/sur/forum.hoon index e541670..160173f 100644 --- a/sur/forum.hoon +++ b/sur/forum.hoon @@ -1,5 +1,12 @@ /- tp=post |% ++$ pokes [%ui eyre-id=@ta p=ui-pokes] ++$ ui-pokes + $% [%submit-comment ted=thread text=@t] + [%submit-reply =comment:tp text=@t] + [%submit-thread title=@t url=@t text=@t] + [%vote ted=? =pid:tp vote=?] + == +$ state $% state-0 == @@ -8,7 +15,7 @@ $: %0 =threads popular=pfeed comments=gfeed:tp - karma=(map @p @ud) + karma=(map @p @sd) :: mods=(set @p) admins=(set @p) diff --git a/sur/markdown.hoon b/sur/markdown.hoon new file mode 100644 index 0000000..baf266e --- /dev/null +++ b/sur/markdown.hoon @@ -0,0 +1,157 @@ +=> |% + ++ ln + |% + :: + :: Url: optionally enclosed in triangle brackets + :: A link destination consists of either + :: - a sequence of zero or more characters between an opening < and a closing > that + :: contains no line breaks or unescaped < or > characters, or + :: - a nonempty sequence of characters that does not start with <, does not include + :: ASCII space or control characters, and includes parentheses only if (a) they are + :: backslash-escaped or (b) they are part of a balanced pair of unescaped parentheses. + :: (Implementations may impose limits on parentheses nesting to avoid performance + :: issues, but at least three levels of nesting should be supported.) + +$ url [text=@t has-triangle-brackets=?] + :: + :: Url with optional title-text + +$ urlt [=url title-text=(unit @t)] + :: + :: Link target: the part of a link after the display text. can be direct or reference + :: A reference link is in square brackets, and refers to a named link elsewhere. + :: - full => [Display][foo] + :: - collapsed => [Display][] + :: - shortcut => [Display] + :: Collapsed and shortcut links have a `label` equal to the display text. + +$ target $% [%direct =urlt] + [%ref type=?(%full %collapsed %shortcut) label=@t] + == + -- + -- +:: +|% + :: + :: Markdown document or fragment: a list of nodes + ++ markdown =< $+ markdown + (list node) + |% + +$ node $+ markdown-node + $@ ~ :: `$@ ~` is magic that makes recursive structures work + $% [%leaf node:leaf] + [%container node:container] + == + -- + :: + ++ inline + |% + :: A single inline element + ++ element $+ inline-element + $@ ~ + $%(escape entity code hardbrk softbrk text emphasis strong link image autolink html) + :: + :: Any amount of elements + ++ contents (list element) + :: + :: ----------------------- + :: List of inline elements + :: ----------------------- + :: + :: Backslash-escaped character + +$ escape [%escape char=@t] + :: + :: HTML-entity + +$ entity [%entity code=@t] + :: + :: Code span (inline code). Interpreted literally, cannot have nested elements. + :: Can be enclosed by any amount of backticks on each side, >= 1. Must be balanced. + +$ code [%code-span num-backticks=@ text=@t] + :: + :: Line break + +$ hardbrk [%line-break ~] + :: + :: Soft line break: a newline in the source code, will be rendered as a single space + +$ softbrk [%soft-line-break ~] + :: + :: Text: Just text + +$ text [%text text=@t] + :: + :: Emphasis and strong emphasis + :: Can use either tar "*" or cab "_" as the emphasis character. + :: Can have nested inline elements. + +$ emphasis [%emphasis emphasis-char=@t =contents] + +$ strong [%strong emphasis-char=@t =contents] + :: + :: Link + +$ link [%link =contents =target:ln] + :: + :: Images + +$ image [%image alt-text=@t =target:ln] + :: + :: Autolink: a link that's just itself, surrounded by "<...>" + +$ autolink [%autolink text=@t] + :: + :: HTML + +$ html [%html text=@t] + -- + :: + :: Leaf nodes: non-nested (i.e., terminal) nodes + ++ leaf + |% + ++ node $+ leaf-node + $@ ~ + $%(heading break codeblk-indent codeblk-fenced html link-ref-def table paragraph blank-line) + :: + :: Heading, either setext or ATX style + +$ heading [%heading style=?(%setext %atx) level=@ =contents:inline] + :: + :: Thematic break (horizontal line) + :: Consists of at least 3 repetitions of either hep '-', cab '_', or tar '*' + +$ break [%break char=@t char-count=@] + :: + :: Indentation-based code block: indented 4 spaces. Can include newlines and blank lines. + +$ codeblk-indent [%indent-codeblock text=@t] + :: + :: Fenced code block: begins and ends with 3+ repetitions of tic (`) or sig (~). + :: Can be indented up to 3 spaces. + +$ codeblk-fenced [%fenced-codeblock char=@t char-count=@ info-string=@t indent-level=@ text=@t] + :: + :: HTML + +$ html [%html text=@t] + :: + :: Link reference definition (defines a named link which can be referenced elsewhere) + +$ link-ref-def [%link-ref-definition label=@t =urlt:ln] + :: + :: Paragraph + +$ paragraph [%paragraph =contents:inline] + :: + :: Blank lines (not rendered, but lets user control aethetic layout of the source code) + +$ blank-line [%blank-line ~] + :: + :: Table (alignments: [l]eft, [r]ight, [c]enter, [n]one) + +$ table [%table widths=(list @) head=(list contents:inline) align=(list ?(%l %c %r %n)) rows=(list (list contents:inline))] + -- + :: + :: Container node: can contain other nodes (either container or leaf). + ++ container + |% + ++ node $+ container-node + $@ ~ + $%(block-quote ol ul tl) + :: + :: Block quote. Can be nested. + +$ block-quote [%block-quote =markdown] + :: + :: Ordered list: numbered based on first list item marker. + :: Marker char can be either dot '1. asdf' or par '1) asdf' + :: Can be indented up to 3 spaces + +$ ol [%ol indent-level=@ marker-char=@t start-num=@ contents=(list markdown)] :: is-tight=? + :: + :: Unordered list: bullet point list + :: Marker char can be either hep (-), lus (+) or tar (*) + :: Can be indented up to 3 spaces + +$ ul [%ul indent-level=@ marker-char=@t contents=(list markdown)] :: is-tight=? + :: + :: Task list: unordered list of tasks + :: Can be indented up to 3 spaces + +$ tl [%tl indent-level=@ marker-char=@t contents=(list [is-checked=? =markdown])] :: is-tight=? + -- +-- diff --git a/sur/post.hoon b/sur/post.hoon index 4111898..cc80742 100644 --- a/sur/post.hoon +++ b/sur/post.hoon @@ -17,7 +17,7 @@ $: =id author=ship thread=pid - parent=(unit pid) + parent=pid children=(set pid) contents=content-list =votes @@ -33,12 +33,14 @@ +$ block $% [%paragraph p=paragraph] [%blockquote p=paragraph] - :: table - clist [%heading p=cord q=heading] [%media =media] [%codeblock code=cord lang=cord] [%eval hoon=cord] + + + :: table + clist [%tasklist p=(list task)] :: [%ref app=term =ship =path] @@ -68,14 +70,9 @@ [%strike p=cord] [%codespan p=cord] [%link href=cord show=cord] + [%img src=cord alt=cord] [%break ~] :: not strictly markdown [%ship p=ship] - [%date p=@da] - [%note id=cord text=(list inline)] :: footnotes and so on - [%underline p=cord] - [%sup p=cord] - [%sub p=cord] - [%ruby p=cord q=cord] == -- diff --git a/sur/spider.hoon b/sur/spider.hoon new file mode 100644 index 0000000..7c21268 --- /dev/null +++ b/sur/spider.hoon @@ -0,0 +1,27 @@ +/+ libstrand=strand +=, strand=strand:libstrand +|% ++$ thread $-(vase shed:khan) ++$ input [=tid =cage] ++$ tid tid:strand ++$ bowl bowl:strand ++$ http-error + $? %bad-request :: 400 + %forbidden :: 403 + %nonexistent :: 404 + %offline :: 504 + == ++$ start-args + $: parent=(unit tid) + use=(unit tid) + =beak + file=term + =vase + == ++$ inline-args + $: parent=(unit tid) + use=(unit tid) + =beak + =shed:khan + == +-- diff --git a/sur/verb.hoon b/sur/verb.hoon new file mode 100644 index 0000000..5363674 --- /dev/null +++ b/sur/verb.hoon @@ -0,0 +1,48 @@ +|% ++$ event + $% [%on-init ~] + [%on-load ~] + [%on-poke =mark] + [%on-watch =path] + [%on-leave =path] + [%on-agent =wire sign=term] + [%on-arvo =wire vane=term sign=term] + [%on-fail =term] + == +:: ++$ event-plus + $: act=@ud + now=@da + src=@p + sap=path + =cause + effects=(list effect) + == +:: ++$ cause + $% [%on-init ~] + [%on-load ~] + [%on-poke =mark mug=@ux] + [%on-watch =path] + [%on-leave =path] + [%on-agent =wire =sign] + [%on-arvo =wire vane=term sign=term] + [%on-fail =term] + == +:: ++$ sign + $% [%poke-ack ack=?] + [%watch-ack ack=?] + [%kick ~] + [%fact =mark mug=@ux] + == +:: ++$ effect + $% [%poke =wire =gill:gall =mark mug=@ux] + [%watch =wire =gill:gall =path] + [%leave =wire =gill:gall] + [%fact paths=(list path) =mark mug=@ux] + [%kick paths=(list path)] + [%arvo =wire vane=term task=term] + == +-- diff --git a/ted/proxy.hoon b/ted/proxy.hoon new file mode 100644 index 0000000..da4b86b --- /dev/null +++ b/ted/proxy.hoon @@ -0,0 +1,53 @@ +/- spider +/+ strandio +=, strand=strand:spider +=, dejs-soft:format +=, strand-fail=strand-fail:libstrand:spider +^- thread:spider +|= arg=vase +=/ a !< (unit json) arg +?~ a (strand-fail:strand %no-body ~) +?. ?=(%s -.u.a) (strand-fail:strand %no-body ~) +=/ url +.u.a +=/ m (strand ,vase) +^- form:m +|^ (retry url 0) ++$ res-t (each json @t) :: for redirects + ++ retry |= [url=@t count=@] + ;< r=res-t bind:m (send-req url) + ?- -.r + %& (pure:m !>(p.r)) + %| ?: (gte count 5) (pure:m !>(`json`[%s 'error'])) + (retry p.r +(count)) + == + ++ send-req |= url=@t + ~& fetching=url + =/ m (strand ,res-t) ^- form:m + =/ headers + :~ + ['connection' 'keep-alive'] + ['Accept-language' 'en-US;en;q=0.9'] + ['Accept' '*/*'] + ['origin' 'https://www.google.com'] + ['referer' 'https://www.google.com/'] + ['DNT' '1'] + ['User-agent' 'facebookexternalhit/1.1'] + :: ['User-agent' 'Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/90.0.4430.93 Safari/537.36'] + == + =/ =request:http [%'GET' url headers ~] + ;< ~ bind:m (send-request:strandio request) + ;< res=client-response:iris bind:m take-client-response:strandio + ?. ?=(%finished -.res) (strand-fail:strand %no-body ~) + =/ headers headers.response-header.res + ~& > header=headers + =/ redirect (get-header:http 'location' headers) + ~& >> red=redirect + ?^ redirect (pure:m [%| u.redirect]) + + :: + ?~ full-file.res (strand-fail:strand %no-body ~) + ~& mime=-.u.full-file.res + =/ htmls=@t q.data.u.full-file.res + =/ json [%s htmls] + (pure:m [%& json]) + -- diff --git a/web/assets/style.css b/web/assets/style.css index 7b16083..4beaf12 100644 --- a/web/assets/style.css +++ b/web/assets/style.css @@ -76,6 +76,12 @@ html { .g2 { gap: 1rem; } +.cp{ + cursor: pointer; +} +.tc{ + text-align:center; +} /* base */ @@ -87,25 +93,74 @@ html { } -* { +body { background-color: var(--primary); color: var(--black); + margin: 0; + padding: 0; + min-height: 100vh; + display: flex; + flex-direction: column; +} + +a { + color: inherit; + text-decoration: none; } /* nav */ -nav { - padding: 1rem; +#topnav { + height: 63px; + + & #login-div { + display: flex; + align-items: center; + text-decoration: underline; + margin-right: 2rem; + font-size: 20px; + line-height: 23px; + font-weight: 600; + } } #nav-main { background-color: var(--black); color: var(--primary); cursor: pointer; + font-size: 25px; + line-height: 23px; + font-weight: 600; + text-align: center; + display: flex; + align-items: center; + gap: 1rem; + padding: 0 1rem; } +#nav-links { + display: flex; + align-items: center; + font-size: 25px; + line-height: 23px; + font-weight: 600; + text-align: center; + gap: 1rem; + + & a { + opacity: 0.5; + } + + & .active { + opacity: 1 + } +} + + /* index */ main { padding: 1rem 2rem; + flex-grow: 1; + overflow: auto; } #index-top { @@ -137,13 +192,181 @@ main { } & a { - font-size: 1.1rem; text-decoration: none; - font-weight: 500; + } + & .preview{ + max-width: 100%; + } + & .title { + font-weight: 600; + font-size: 25px; + line-height: 33px; + } + & .title-text{ + white-space: nowrap; + overflow: hidden; + text-overflow: ellipsis; + } + + & .out-link { + font-weight: 600; + font-size: 20px; + + & .arrow { + margin-left: 0.3rem; + font-size: 1.3rem; + } } & .meta { opacity: 0.5; + & .upvote-button, & .downvote-button{ + + } } -} \ No newline at end of file +} + +.moar { + text-decoration: underline; + font-size: 20px; + margin-top: 1rem; + display: block; +} + +.white{ + background-color: var(--white); +} +/* thread page */ +#thread-main{ + background-color: var(--white); + & h1{ + margin-top: 0.3rem; + } + & ul{ + display: block; + list-style-image: none; + list-style-position: outside; + list-style-type: none; + padding: 0; + & li{ + margin-bottom: 1rem; + } + } + & .nested{ + padding-left: 2rem !important; + } + & .comment{ + & img{ + max-width: 60%; + display: block; + margin: 1rem auto; + } + & .comment-proper{ + margin-top: 0.5rem; + } + & .content{ + font-weight: 600; + margin: 1rem 0; + & p{ + margin: 0.2rem 0; + } + } + } +} +.red{ + color: red; +} +.green { + color: green; +} +.tally{ + font-weight: 600; +} +.uln{ + text-decoration: underline; + cursor: pointer; +} +.return-link{ + display: block; + margin-bottom: 2rem; +} +#og{ + border: 1px solid var(--black); + border-radius: 0.5rem; + & img{ + width: 100%; + max-height: 500px; + } +} +#link-url{ + padding: 0.5rem 1rem; +} +#thread-composer{ + & input{ + display: block; + height: 2rem; + width: 100%; + margin: 1rem 0; + } +} +#comment-composer{ + margin-top: 3rem; + margin-bottom: 1rem; + + padding: 0.5rem 1rem; + border: 1px solid var(--black); + border-radius: 0.5rem; +} +#composer-proper{ + margin: 1rem; + padding: 1rem; + & textarea{ + width: 100%; + height: 200px; + margin-bottom: 0.5rem; + resize: none; + } +} +#login-page{ + & form{ + display: block; + width: 50%; + margin: 2rem auto; + + & input{ + display: block; + width: 30ch; + padding: 0.4rem; + height: 2rem; + margin: 2rem auto; + } + & button{ + display: block; + margin: auto; + font-size: 1.2rem; + } + } +} +#sigil-img{ + margin: 1rem auto !important; +} +#user-page{ + & *{ + margin: auto; + } + & #main{ + width: 50%; + } +} +#logout{ + display: block; + margin: 2rem auto; + font-size: 1.2rem; +} +button, .button{ + border: 1px solid var(--black); + background: none; + padding: 0.5rem; + width: max-content; +} diff --git a/web/components/components.hoon b/web/components/components.hoon new file mode 100644 index 0000000..51b087a --- /dev/null +++ b/web/components/components.hoon @@ -0,0 +1,106 @@ +/- sur=forum, tp=post +/+ lib=forum, sr=sortug +|% +++ votes |= v=votes:tp + =/ old (old:si tally.v) + =/ arrow ?: -.old + "↑" + "↓" + :: =/ img ?: -.old + :: ;img@"/up.svg"; + :: ;img@"/down.svg"(cnn.org) ; + ;div.f.g1 + ;div.arrow:"{arrow}" + ;div:"{(scow %ud +.old)}" + == +++ tally |= v=votes:tp + =/ old (old:si tally.v) + =/ classn ?: -.old "tally green" "tally red" + ;div(class classn):"{(scow %ud +.old)}" + +++ upvote ^- manx + ;div.upvote-button.cp:"↑" +++ downvote + ;div.downvote-button.cp:"↓" +++ thread-metadata + |= [=pid:tp now=@da v=votes:tp reply-count=@ud] + =/ post-link (scow:sr %uw (jam pid)) + =/ ago (post-date-ago:lib id.pid now %yau) + =/ author (scow %p ship.pid) + =/ comments ?: .=(0 reply-count) ~ + ;+ ;div:"{(scow %ud reply-count)} comments" + ;div.meta.f.g2 + =pid post-link + ;+ (votes v) + ;div:"{author}" + ;a/"/forum/com/{post-link}":"{ago} ago" + ;* comments + == +++ post-metadata +|= [=pid:tp now=@da v=votes:tp reply-count=@ud is-ted=?] + =/ teds ?: is-ted "yeah" "nope" + =/ post-link (scow:sr %uw (jam pid)) + =/ ago (post-date-ago:lib id.pid now %yau) + =/ author (scow %p ship.pid) + =/ comments ?: .=(0 reply-count) ~ + ;+ ;div:"{(scow %ud reply-count)} comments" + ;div.meta.f.g2 + =pid post-link + =ted teds + ;+ upvote + ;+ (tally v) + ;+ downvote + ;div:"{author}" + ;a/"/forum/com/{post-link}":"{ago} ago" + ;* comments + == +++ reply-header +|= [t=thread:sur =comment:tp now=@da] + =/ cpid [author.comment id.comment] + =/ ago (post-date-ago:lib id.comment now %yau) + =/ author (scow %p author.comment) + =/ thread-link (scow:sr %uw (jam pid.t)) + =/ parent-link (scow:sr %uw (jam parent.comment)) + =/ titlet (trip title.t) + ;div.meta.f.g2 + ;+ (votes votes.comment) + ;div:"{author}" + ;div:"{ago} ago" + ; | + ;a/"/forum/com/{parent-link}":"parent" + ; | + ;a/"/forum/ted/{thread-link}":"Thread: {titlet}" + == +++ reply-composer |= [pids=tape top=?] + =/ action ?: top "/forum/comment" "/forum/reply" + ;form#reply-form(action action, method "POST") + ;input#thread-id(type "hidden", name "parent", value pids); + ;textarea#textarea(name "text"); + ;button:"Submit" + ;script:"{script}" + == +++ script ^~ %- trip +''' + function autoSave(){ + const form = document.getElementById("reply-form"); + const hiddenInput = document.getElementById("thread-id"); + const draftID = hiddenInput.value; + console.log(draftID, "id") + const area = document.getElementById("textarea"); + + window.addEventListener("load", () => { + const savedContent = localStorage.getItem(draftID); + console.log(savedContent, "saved") + if (savedContent) area.value = savedContent; + }) + form.addEventListener("submit", () => { + localStorage.removeItem(draftID); + }) + area.addEventListener("input", () => { + console.log("saving", area.value) + localStorage.setItem(draftID, area.value); + }) + } + autoSave(); +''' +-- diff --git a/web/components/navbar.hoon b/web/components/navbar.hoon index 9ee406f..bf8124b 100644 --- a/web/components/navbar.hoon +++ b/web/components/navbar.hoon @@ -1,28 +1,47 @@ /+ sig=sigil-sigil |_ =bowl:gall -++ login +++ login ^- manx ?- (clan:title src.bowl) %czar sigil %king sigil %duke sigil %earl sigil - %pawn ;a/"/~/login":"Log In" + %pawn login-prompt + == +++ login-prompt ^- manx + ;a/"/forum/log":"Log In" ++ sigil :: ;+ (sig(size 48) src.bowl) -=/ (scow %p src.bowl) -;a/"/":"{p}" +=/ p (scow %p src.bowl) + ;div.f.g2 + ;a/"/forum/add":"new post" + ;a/"/forum/usr/{p}":"{p}" + == ++ $ - ;nav.fs.g2 - ;div.fg2 + ;nav#topnav.fs.g2 + ;div.f.g2 ;div#nav-main.fs ;a/"/":"~ Technical Journal" ;div#nav-dropdown:"↓" == ;div#nav-links - ;a:/"/information":"Information" - ;a:/"/Forum":"Forum" + ;a/"/information":"Information" + ;a.active/"/forum":"Forum" == == - ;+ login + ;div#login-div + ;+ login-prompt + == + ;script:"{script}" == +++ script ^~ %- trip +''' + async function setSigil(){ + const div = document.getElementById("login-div"); + const res = await fetch("/forum/f/sigil"); + const t = await res.text(); + if (t) div.innerHTML = t; + } + setSigil(); +''' -- diff --git a/web/components/post-text.hoon b/web/components/post-text.hoon new file mode 100644 index 0000000..b4f70b1 --- /dev/null +++ b/web/components/post-text.hoon @@ -0,0 +1,125 @@ +/- tp=post +/+ sr=sortug +|% +++ content +|= c=content-list:tp ^- marl + (turn c block) +++ block + |= b=block:tp ^- manx + ?+ -.b ;p; + %paragraph (pg +.b) + %blockquote (bq +.b) + %heading (heading +.b) + %list (htmlist +.b) + %media (media +.b) + %codeblock (codeblock +.b) + %eval (eval +.b) + == +++ eval + |= txt=@t ^- manx + :: Ream can crash if the cord is wrong + :: soften instead + =/ uhoon (rush txt vest) + ?~ uhoon ;p:"The hoon you tried to run ({(trip txt)}) is invalid." + =/ run %- mule |. + %+ slap !>(..zuse) u.uhoon + ?: ?=(%.n -.run) :: if virtualization fails get a (list tank) + ;p + ;span:"Evaluation of {(trip txt)} failed:" + ;br; + ;* %+ turn p.run |= t=tank ;span:"{~(ram re t)}" + == + ;p:"{(text p.run)}" +++ pg + |= l=(list inline:tp) ^- manx + ;p + ;* %+ turn l inline + == +++ bq + |= l=(list inline:tp) ^- manx + ;blockquote + ;* %+ turn l inline + == +++ htmlist + |= [l=(list content-list:tp) ordered=?] + ?: ordered + ;ol + ;* %+ turn l li + == + ;ul + ;* %+ turn l li + == +++ li + |= l=content-list:tp ^- manx + ;li + ;* (turn l block) + == +++ media + |= m=media:tp ^- manx + ?- -.m + %video ;video@"{(trip p.m)}"; + %audio ;audio@"{(trip p.m)}"; + %images ;div.images + ;* %+ turn p.m + |= [url=@t caption=@t] ;img@"{(trip url)}"(alt (trip caption)); + == + == +++ codeblock + |= [code=@t lang=@t] :: TODO lang suff + ;pre + ;code:"{(trip code)}" + == +++ heading + |= [pp=@t q=@] ^- manx + =/ p (trip pp) + ?: .=(1 q) ;h1:"{p}" + ?: .=(2 q) ;h2:"{p}" + ?: .=(3 q) ;h3:"{p}" + ?: .=(4 q) ;h4:"{p}" + ?: .=(5 q) ;h5:"{p}" + ?: .=(6 q) ;h6:"{p}" + ;p:"" +++ inline + |= l=inline:tp ^- manx + ?+ -.l ;span; + %text (parse-text p.l) + %italic ;i:"{(trip p.l)}" + %bold ;strong:"{(trip p.l)}" + :: %strike ;del:"{(trip p.l)}" + %ship ;span.ship:"{(trip (scot %p p.l))}" + %codespan ;code:"{(trip p.l)}" + %break ;br; + %img ;a/"{(trip src.l)}" + ;img@"{(trip src.l)}"(alt (trip alt.l)); + == + %link ?. (is-image:parsing:sr href.l) + ;a/"{(trip href.l)}"(target "_blank"):"{(trip show.l)}" + ;a/"{(trip href.l)}" + =target "_blank" + ;img@"{(trip href.l)}"(alt (trip show.l)); + == + == +++ parse-text + |= txt=@t ^- manx + =/ tpe (trip txt) + =/ youtube (rush txt youtube:parsing:sr) + ?^ youtube + :: ;a/"{tpe}" + :: ;img@"https://i.ytimg.com/vi/{u.youtube}/hqdefault.jpg"; + :: == + ;iframe.youtube-frame@"https://www.youtube.com/embed/{u.youtube}"; + =/ twatter-status (rush txt twatter:parsing:sr) + ?^ twatter-status + ;div :: goddamn twatter embeds insert themselves as last child + ;a.parsed-twatter(status u.twatter-status):"{tpe}" + == + =/ trimmed (rush txt trim:parsing:sr) + ?~ trimmed ~& parsing-error=txt ;span.parsing-error; + =/ link=(unit purl:eyre) (rust u.trimmed link:parsing:sr) + ?^ link + ?^ p.q.u.link + ?: (is-img:parsing:sr u.p.q.u.link) ;img@"{u.trimmed}"; + ;a.parsed-link/"{tpe}"(target "_blank"):"{tpe}" :: normal link + ;a.parsed-link/"{tpe}"(target "_blank"):"{tpe}" :: normal link + ;span:"{tpe}" +-- diff --git a/web/components/tally.hoon b/web/components/tally.hoon new file mode 100644 index 0000000..a15aa0f --- /dev/null +++ b/web/components/tally.hoon @@ -0,0 +1,16 @@ +/- tp=post +=< votes +|% +++ votes |= v=votes:tp + =/ old (old:si tally.v) + =/ arrow ?: -.old + "↑" + "↓" + :: =/ img ?: -.old + :: ;img@"/up.svg"; + :: ;img@"/down.svg"(cnn.org) ; + ;div.f.g1 + ;div.arrow:"{arrow}" + ;div:"{(scow %ud +.old)}" + == +-- diff --git a/web/pages/add-comment.hoon b/web/pages/add-comment.hoon new file mode 100644 index 0000000..57a48ee --- /dev/null +++ b/web/pages/add-comment.hoon @@ -0,0 +1,22 @@ +/- sur=forum, tp=post +/+ sr=sortug +/= comps /web/components/components +/= pt /web/components/post-text +|_ [ted=thread:sur com=comment:tp =bowl:gall] +++ $ + =/ ppid [author.com id.com] + =/ pids (scow:sr %uw (jam ppid)) + ;main#thread-main + ;div#parent + ;+ (reply-header:comps ted com now.bowl) + ;div.post-text + ;* (content:pt contents.com) + == + ;div#composer + ;div#composer-proper + ;+ (reply-composer:comps pids .n) + == + == + == + == +-- diff --git a/web/pages/add-thread.hoon b/web/pages/add-thread.hoon new file mode 100644 index 0000000..5905a86 --- /dev/null +++ b/web/pages/add-thread.hoon @@ -0,0 +1,43 @@ +/- sur=forum, tp=post +/+ sr=sortug +/= comps /web/components/components +/= pt /web/components/post-text +|_ =bowl:gall +++ $ + ;main#thread-main + ;h1.tc:"New Thread" + ;div#thread-composer + ;div#composer-proper + ;form#form(action "new-thread", method "POST") + ;input#thread-title(type "text", name "title", placeholder "title"); + ;input#thread-url(type "text", name "url", placeholder "url"); + ;textarea#textarea(name "text"); + ;button:"Submit" + ;script:"{script}" + == + == + == + == +++ script ^~ %- trip +''' + function autoSave(){ + const form = document.getElementById("form"); + const draftID = "new-thread"; + const area = document.getElementById("textarea"); + + window.addEventListener("load", () => { + const savedContent = localStorage.getItem(draftID); + console.log(savedContent, "saved") + if (savedContent) area.value = savedContent; + }) + form.addEventListener("submit", () => { + localStorage.removeItem(draftID); + }) + area.addEventListener("input", () => { + console.log("saving", area.value) + localStorage.setItem(draftID, area.value); + }) + } + autoSave(); +''' +-- diff --git a/web/pages/comment.hoon b/web/pages/comment.hoon new file mode 100644 index 0000000..83d85a2 --- /dev/null +++ b/web/pages/comment.hoon @@ -0,0 +1,114 @@ +/- sur=forum, tp=post +/+ lib=forum, sr=sortug +/= comps /web/components/components +/= pt /web/components/post-text +|_ [ted=thread:sur op=full-node:tp =bowl:gall] + +++ comments + ;div#comments + ;+ (grandchildren op 0) + == + +++ mini-thread +=| nested=@ud +|= fn=full-node:tp ^- manx + ;li.comment + ;+ (comment p.fn) + ;+ (grandchildren fn +(nested)) + == +++ grandchildren |= [fn=full-node:tp nested=@ud] + =/ pid [author.p.fn id.p.fn] + ?~ children.fn ;span; + ?: (gth nested 5) (show-more pid) + =/ children (tap:form:tp children.fn) + =/ mtf mini-thread + ;ul.comment-thread.nested + ;* %+ turn children |= [p=pid:tp fnc=full-node:tp] + (mtf(nested nested) fnc) + == + +++ show-more |= =pid:tp + =/ pids (scow:sr %uw (jam pid)) + ;div.show-more-button.uln + =pid pids + ; Show more + == +++ comment |= c=comment:tp + =/ pid [author.c id.c] + =/ pids (scow:sr %uw (jam pid)) + ;div.comment-proper + ;+ (post-metadata:comps pid now.bowl votes.c ~(wyt in children.c) .n) + ;div.content + ;* (content:pt contents.c) + == + ;a.uln/"/forum/rep/{pids}":"reply" + == +++ $ + =/ ppid [author.p.op id.p.op] + =/ pids (scow:sr %uw (jam ppid)) + + ;main#thread-main + ;+ (reply-header:comps ted p.op now.bowl) + ;div#thread-body + ;* (content:pt contents.p.op) + == + ;div#comment-composer + ;div#comment-prompt.cp:"add a comment" + ;div#composer-proper(hidden "") + ;+ (reply-composer:comps pids .y) + == + == + ;+ comments + ;script:"{reply-script}" + == +++ reply-script ^~ %- trip +''' + function replyToggle(){ + const el = document.getElementById("comment-prompt"); + if (!el) return + const form = document.getElementById("composer-proper"); + if (!form) return + el.addEventListener("click", (e) => { + form.hidden = !form.hidden; + }); + } + replyToggle(); +''' +++ og-script ^~ %- trip +''' + async function run(){ + const urlEl = document.getElementById("og"); + const url = urlEl.getAttribute("url"); + if (!url) return + const res = await fetch(url); + const text = await res.text(); + getMeta(url, text); + } + function getMeta(url, s){ + const parser = new DOMParser(); + const doc = parser.parseFromString(s, "text/html"); + const metaTags = doc.querySelectorAll("meta"); + + for (let tag of metaTags){ + const name = tag.getAttribute("name"); + const prop = tag.getAttribute("property"); + const cont = tag.getAttribute("content"); + + if (name && name.includes("image")){ + setImage(url, cont); + break; + } + } + } + function setImage(base, path){ + console.log([base, path], "bp") + const url = path.includes("http") ? path : (base + path); + console.log("setting image", url); + const el = document.getElementById("link-image"); + console.log(el, "el"); + el.src = url; + } + run(); + +''' +-- diff --git a/web/pages/index.hoon b/web/pages/index.hoon index 2810a4a..1ff7d8c 100644 --- a/web/pages/index.hoon +++ b/web/pages/index.hoon @@ -1,6 +1,7 @@ /- sur=forum, tp=post -/+ lib=forum, sr=sortug -|_ [thp=thread-page:sur =bowl:gall] +/+ lib=forum, sr=sortug, cons=constants +/= comps /web/components/components +|_ [thp=thread-page:sur =state:sur =bowl:gall] ++ $ ^- manx ;main ;div#index-top.f.g1 @@ -14,7 +15,10 @@ == ++ thread-list ^- marl =/ tl threads.thp - =/ i 1 + =/ page -.thp + ~& page=page + =/ init (mul (dec -.thp) page-size:cons) + =/ i +(init) =| res=marl |- ?~ tl (flop res) =/ ted (thread i i.tl) @@ -25,38 +29,20 @@ =/ thread-link (scow:sr %uw (jam pid.t)) =/ titlet (trip title.t) =/ numt (scow %ud num) + =/ descendants (total-comments:lib t state) =/ link ?. ?=(%link -.content.t) ~ ;+ (link-div +.content.t) - =/ ago (post-date-ago:lib id.pid.t now.bowl %yau) - =/ author (scow %p ship.pid.t) - =/ comments ?~ replies.t ~ - ;+ ;div:"{(scow %ud (lent replies.t))} comments" - ;div.thread-preview.f.g2 ;div.num:"{numt}." ;div.preview ;div.title.f.g1 - ;a/"/forum/ted/{thread-link}":"{titlet}" + ;a.title-text/"/forum/ted/{thread-link}":"{titlet}" ;* link == - ;div.meta.f.g2 - ;+ (votes votes.t) - ;div:"{author}" - ;div:"{ago} ago" - ;* comments - == + ;+ (thread-metadata:comps pid.t now.bowl votes.t descendants) == == -++ votes |= v=votes:tp - =/ old (old:si tally.v) - =/ img ?: -.old - ;img@"/up.svg"; - ;img@"/down.svg"; - ;div.f.g0 - ;+ img - ;div:"{(scow %ud +.old)}" - == ++ link-div |= l=@t =/ url (de-purl:html l) =/ dom "" @@ -72,11 +58,13 @@ ?: .=(~ dom) "{el}" "{dom}.{el}" $(parts t.parts) -;div.out-link - ;a/"{(trip l)}":"({domain})" - ;img@"/imgs/outlink.svg"; +;a.out-link/"{(trip l)}"(target "_blank") + ;span:"({domain})" + ;span.arrow:"↗" == ++ moar + =/ len (lent threads.thp) + ?: (lth len page-size:cons) ;span; =/ page-num (add 1 page.thp) - ;a/"/forum/p/{(scow %ud page-num)}":"More" + ;a.moar/"/forum/p/{(scow %ud page-num)}":"More" -- diff --git a/web/pages/login.hoon b/web/pages/login.hoon new file mode 100644 index 0000000..8a88012 --- /dev/null +++ b/web/pages/login.hoon @@ -0,0 +1,21 @@ +=< html +|% +++ html + =/ redirect-str "/forum" + ;main#login-page.white + ;h1.tc:"Login" + ;form#form(action "/~/login", method "POST") + ;p.tc: Urbit ID + ;input.mono(type "text") + =name "name" + =id "name" + =placeholder "~sampel-palnet" + =required "true" + =minlength "4" + =maxlength "14" + =pattern "~((([a-z]\{6})\{1,2}-\{0,2})+|[a-z]\{3})"; + ;input(type "hidden", name "redirect", value redirect-str); + ;button(name "eauth", type "submit"):"Login" + == + == +-- diff --git a/web/pages/thread.hoon b/web/pages/thread.hoon index cc97ccd..7402073 100644 --- a/web/pages/thread.hoon +++ b/web/pages/thread.hoon @@ -1,5 +1,193 @@ -/- sur=forum -|_ [ted=thread:sur =bowl:gall] +/- sur=forum, tp=post +/+ lib=forum, sr=sortug +/= comps /web/components/components +/= pt /web/components/post-text +|_ [ted=thread:sur comment-list=(list full-node:tp) =bowl:gall] +++ body + ?: ?=(%link -.content.ted) + ;+ link-body + (content:pt +.content.ted) +++ link-body + ?> ?=(%link -.content.ted) + =/ url (trip +.content.ted) + ;a/"{url}" + ;div#og + =url url + ;img#link-image; + ;div#link-url:"{url}" + ;script:"{og-script}" + == + == +++ comments + ;div#comments + ;ul.comment-thread + ;* %+ turn comment-list mini-thread + == + == + +++ mini-thread +=| nested=@ud +|= fn=full-node:tp ^- manx + ;li.comment + ;+ (comment p.fn) + ;+ (grandchildren fn +(nested)) + == +++ grandchildren |= [fn=full-node:tp nested=@ud] + =/ pid [author.p.fn id.p.fn] + ?~ children.fn ;span; + ?: (gth nested 5) (show-more pid) + =/ children (tap:form:tp children.fn) + =/ mtf mini-thread + ;ul.comment-thread.nested + ;* %+ turn children |= [p=pid:tp fnc=full-node:tp] + (mtf(nested nested) fnc) + == + +++ show-more |= =pid:tp + =/ pids (scow:sr %uw (jam pid)) + ;div.show-more-button.uln + =pid pids + ; Show more + == +++ comment |= c=comment:tp + =/ pid [author.c id.c] + =/ pids (scow:sr %uw (jam pid)) + ;div.comment-proper + ;+ (post-metadata:comps pid now.bowl votes.c ~(wyt in children.c) .n) + ;div.content + ;* (content:pt contents.c) + == + ;a.uln/"/forum/rep/{pids}":"reply" + == ++ $ - ;div:"lmao" + =/ op (scow %p ship.pid.ted) + =/ op-ago (post-date-ago:lib id.pid.ted now.bowl %yau) + =/ pids (scow:sr %uw (jam pid.ted)) + + ;main#thread-main + ;a.return-link/"/forum":"Return to forum" + ;+ (post-metadata:comps pid.ted now.bowl votes.ted (lent replies.ted) .y) + ;h1#thread-title:"{(trip title.ted)}" + ;div#thread-body + ;* body + == + ;div#comment-composer + ;div#comment-prompt.cp:"add a comment" + ;div#composer-proper(hidden "") + ;+ (reply-composer:comps pids .y) + == + == + ;+ comments + ;script:"{reply-script}" + == +++ reply-script ^~ %- trip +''' + function replyToggle(){ + const el = document.getElementById("comment-prompt"); + if (!el) return + const form = document.getElementById("composer-proper"); + if (!form) return + el.addEventListener("click", (e) => { + form.hidden = !form.hidden; + }); + } + replyToggle(); + async function voting(){ + const upbs = document.querySelectorAll(".upvote-button"); + const downbs = document.querySelectorAll(".downvote-button"); + for (let upb of upbs){ + const parent = upb.closest(".meta"); + if (!parent) continue; + const pid = parent.getAttribute("pid"); + const teds = parent.getAttribute("ted"); + const postType = (teds && teds === "yeah") ? "ted" : "com" + if (!pid) continue; + upb.addEventListener("click", async () => { + const res = await fetch(`/forum/vote/${postType}/${pid}/gud`, {method: "POST"}); + console.log(res, "res"); + const t = await res.text(); + console.log(t, "t") + }) + } + for (let db of downbs){ + const parent = db.closest(".meta"); + if (!parent) continue; + const pid = parent.getAttribute("pid"); + if (!pid) continue; + const teds = parent.getAttribute("ted"); + const postType = (teds && teds === "yeah") ? "ted" : "com" + db.addEventListener("click", async () => { + const res = await fetch(`/forum/vote/${postType}/${pid}/bad`, {method: "POST"}); + console.log(res, "res"); + const t = await res.text(); + console.log(t, "t") + }) + } + } + voting(); + + +''' +++ og-script ^~ %- trip +''' + async function run(){ + const urlEl = document.getElementById("og"); + const url = urlEl.getAttribute("url"); + if (!url) return + try{ + const res = await fetch(url); + const text = await res.text(); + getMeta(url, text); + } catch(e){ + callThread(url); + } + } + async function callThread(url){ + console.log(url, "calling thread") + try{ + const opts = { + credentials: 'include', + accept: '*', + method: "POST", + body: JSON.stringify(url), + headers: { + 'Content-type': "application/json" + } + }; + const res = await fetch("/kumo/ustj/json/proxy/json", opts); + const text = await res.json(); + getMeta(url, text); + } catch(e){ + console.log(e, "wtf") + } + + } + function getMeta(url, s){ + const parser = new DOMParser(); + const doc = parser.parseFromString(s, "text/html"); + console.log(doc, "document") + const metaTags = doc.querySelectorAll("meta"); + for (let tag of metaTags){ + const name = tag.getAttribute("name"); + const prop = tag.getAttribute("property"); + const cont = tag.getAttribute("content"); + const isImage = (name && name.includes("image") || (prop && prop.includes("image"))) + + if (isImage){ + setImage(url, cont); + break; + } + } + } + function setImage(base, path){ + console.log([base, path], "bp") + const url = path.includes("http") ? path : (base + path); + console.log("setting image", url); + const el = document.getElementById("link-image"); + console.log(el, "el"); + el.src = url; + } + run(); + +''' -- diff --git a/web/pages/user.hoon b/web/pages/user.hoon new file mode 100644 index 0000000..6fdd7c7 --- /dev/null +++ b/web/pages/user.hoon @@ -0,0 +1,27 @@ +/- sur=forum, tp=post +/+ sig=sigil-sigil, sr=sortug +|_ [who=@p tedf=threads:sur gf=gfeed:tp karma=@s] +++ sigil +=/ p (scow %p who) + ;div#sigil + ;h2.tc:"{p}" + ;div#sigil-img + ;+ (sig(size 128) who) + == + == +++ $ + =/ karmas (scow:sr %s karma) + =/ teds (scow %ud (lent (tap:torm:sur tedf))) + =/ coms (scow %ud (lent (tap:gorm:tp gf))) + ;main#user-page.white + ;div#main + ;+ sigil + ;div#stats.tc + ;div:"Karma: {karmas}" + ;div:"Threads: {teds}" + ;div:"Comments: {coms}" + == + ;a#logout.button/"/~/logout?redirect=/forum":"Logout" + == + == +-- diff --git a/web/router.hoon b/web/router.hoon index 0743a26..07fea10 100644 --- a/web/router.hoon +++ b/web/router.hoon @@ -1,10 +1,16 @@ /- sur=forum, tp=post -/+ lib=forum, sr=sortug +/+ lib=forum, sr=sortug, rd=rudder, cons=constants /+ server :: /= layout /web/layout +/= navbar /web/components/navbar /= index /web/pages/index /= thread /web/pages/thread +/= comment-page /web/pages/comment +/= add-comment /web/pages/add-comment +/= add-thread /web/pages/add-thread +/= login-page /web/pages/login +/= user-page /web/pages/user :: /* sw %noun /web/sw/js :: /* manifest %noun /web/manifest/json @@ -22,68 +28,190 @@ %- manx-to-octs:server manx-bail ++ manx-bail ^- manx ;div:"404" -++ route - |= [=order =state:sur =bowl:gall] ^- (list card:agent:gall) - =/ rl (parse-request-line:server url.request.req.order) - =. site.rl ?~ site.rl ~ t.site.rl +++ manx-payload |= =manx ^- simple-payload:http + %- html-response:gen:server + %- manx-to-octs:server manx +++ redirect |= [eyre-id=@ta path=tape] + =/ url (crip "{base-url:cons}{path}") + =/ pl (redirect:gen:server url) + (give-simple-payload:app:server eyre-id pl) +:: main +++ router +|_ [=state:sur =bowl:gall] + ++ eyre + |= =order ^- (list card:agent:gall) + =/ rl (parse-request-line:server url.request.req.order) + =. site.rl ?~ site.rl ~ t.site.rl - =/ met method.request.req.order - =/ fpath=(pole knot) [met site.rl] - ~& > rl=fpath - =/ bail %+ give-simple-payload:app:server id.order pbail - |^ - :: if file extension assume its asset - ?. ?=(~ ext.rl) (serve-assets rl) - ?+ fpath bail - [%'GET' rest=*] (serve-get rl(site rest.fpath)) - [%'POST' rest=*] (serve-post rl(site rest.fpath)) - == + =/ met method.request.req.order + =/ fpath=(pole knot) [met site.rl] + |^ + :: if file extension assume its asset + ?. ?=(~ ext.rl) (eyre-give (serve-assets rl)) + ?+ fpath bail + [%'GET' rest=*] (eyre-manx (serve-get rl(site rest.fpath))) + [%'POST' rest=*] (serve-post id.order rl(site rest.fpath) body.request.req.order) + == + :: + ++ bail (eyre-give pbail) + ++ eyre-give |= pl=simple-payload:http ^- (list card:agent:gall) + (give-simple-payload:app:server id.order pl) + + ++ eyre-manx |= =manx + =/ pl %- html-response:gen:server %- manx-to-octs:server manx + (eyre-give pl) + -- :: - ++ serve-assets - |= rl=request-line:server - ~& >> assets=rl - =/ pl - ?+ [site ext]:rl pbail - [[%style ~] [~ %css]] (css-response:gen:server (as-octs:mimes:html css)) - :: [[%spinner ~] [~ %svg]] [%full (serve-other:kaji %svg spinner)] - :: [[%sw ~] [~ %js]] [%mime /text/javascript sw] - :: [[%manifest ~] [~ %json]] [%mime /application/json manifest] - == - (give-simple-payload:app:server id.order pl) + ++ render + |= url=@t ^- simple-payload:http + =/ rl (parse-request-line:server url) + =. site.rl ?~ site.rl ~ t.site.rl + =/ =(pole knot) [%'GET' site.rl] + ?. ?=(~ ext.rl) (serve-assets rl) - ++ serve-get - |= rl=request-line:server - =/ pl %- html-response:gen:server %- manx-to-octs:server - ^- manx - =/ p=(pole knot) site.rl ::?. mob.rl pat.rl [%m pat.rl] - ?: ?=([%f rest=*] p) (fragment rest.p) - %- layout ^- marl :_ ~ - ?+ p manx-bail - ~ (serve-index '1') - [%p p=@t ~] (serve-index p.p) - [%ted ted=@t ~] (serve-thread ted.p) - == - (give-simple-payload:app:server id.order pl) - ++ serve-index |= t=@t ^- manx - =/ pag (slaw %ud t) ?~ pag manx-bail - =/ threads (get-thread-page:lib u.pag state) - (index [u.pag threads] bowl) - ++ serve-thread |= uidt=@t ^- manx - =/ uid (slaw:sr %uw uidt) ?~ uid manx-bail - =/ cued (cue u.uid) - =/ pid %- (soft pid:tp) cued - ?~ pid manx-bail - =/ ted (get-thread:lib u.pid state) - ?~ ted manx-bail - (thread u.ted bowl) - - ++ fragment - |= p=(pole knot) - ?+ p manx-bail - ~ manx-bail + %- manx-payload ^- manx + ?+ pole manx-bail + [%'GET' rest=*] (serve-get rl(site rest.pole)) + :: [%'POST' rest=*] (serve-post rl(site rest.pole)) == + ++ serve-assets + |= rl=request-line:server + :: ~& >> assets=rl + ?+ [site ext]:rl pbail + [[%style ~] [~ %css]] (css-response:gen:server (as-octs:mimes:html css)) + :: [[%spinner ~] [~ %svg]] [%full (serve-other:kaji %svg spinner)] + :: [[%sw ~] [~ %js]] [%mime /text/javascript sw] + :: [[%manifest ~] [~ %json]] [%mime /application/json manifest] + == - ++ serve-post - |= rl=request-line:server ~ + ++ serve-get + |= rl=request-line:server ^- manx + =/ p=(pole knot) site.rl ::?. mob.rl pat.rl [%m pat.rl] + ?: ?=([%f rest=*] p) (serve-fragment rest.p) + %- add-layout + ?+ p manx-bail + ~ (serve-index '1') + [~ ~] (serve-index '1') + [%p p=@t ~] (serve-index p.p) + [%ted ted=@t ~] (serve-thread ted.p) + [%com uid=@t ~] (serve-comment uid.p) + [%rep uid=@t ~] (reply-page uid.p) + [%usr p=@t ~] (serve-user p.p) + [%add ~] (add-thread bowl) + [%log ~] login-page + == + ++ add-layout |= m=manx + %- layout :~ + (navbar bowl) + m + == + ++ serve-fragment |= =(pole knot) ^- manx + ?+ pole !! + [%sigil ~] + =/ navb ~(. navbar bowl) + =/ userdiv login:navb + userdiv + == + ++ serve-user |= t=@t ^- manx + =/ patp (slaw %p t) ?~ patp manx-bail + =/ teds (get-user-teds:lib u.patp state) + =/ coms (get-user-coms:lib u.patp state) + =/ karma (get-user-karma:lib u.patp state) + (user-page u.patp teds coms karma) + ++ serve-index |= t=@t ^- manx + =/ pag (slaw %ud t) ?~ pag manx-bail + =/ threads (get-thread-page:lib u.pag state) + (index [u.pag threads] state bowl) + ++ serve-comment |= uidt=@t ^- manx + =/ uid (slaw:sr %uw uidt) ?~ uid manx-bail + =/ cued (cue u.uid) + =/ pid %- (soft pid:tp) cued + ?~ pid manx-bail + =/ com (get-comment:lib u.pid state) + ?~ com manx-bail + =/ ted (get-thread:lib thread.u.com state) + ?~ ted manx-bail + =/ fn (node-to-full:lib u.com comments.state) + (comment-page u.ted fn bowl) + + ++ reply-page |= uidt=@t ^- manx + =/ uid (slaw:sr %uw uidt) ?~ uid manx-bail + =/ cued (cue u.uid) + =/ pid %- (soft pid:tp) cued + ?~ pid manx-bail + =/ com (get-comment:lib u.pid state) + ?~ com manx-bail + =/ ted (get-thread:lib thread.u.com state) + ?~ ted manx-bail + (add-comment u.ted u.com bowl) + + ++ serve-thread |= uidt=@t ^- manx + =/ uid (slaw:sr %uw uidt) ?~ uid manx-bail + =/ cued (cue u.uid) + =/ pid %- (soft pid:tp) cued + ?~ pid manx-bail + =/ ted (get-thread:lib u.pid state) + ?~ ted manx-bail + =/ fg (get-comment-list:lib u.ted comments.state) + (thread u.ted fg bowl) + + ++ serve-post + |= [eyre-id=@ta rl=request-line:server body=(unit octs)] + |^ + =/ p=(pole knot) site.rl + ?+ p ~ + [%reply ~] (handle-reply .n) + [%comment ~] (handle-reply .y) + [%new-thread ~] handle-thread + [%vote %ted uid=@t vote=@t ~] (handle-vote .y uid.p vote.p) + [%vote %com uid=@t vote=@t ~] (handle-vote .n uid.p vote.p) + == + ++ handle-vote |= [is-ted=? uidt=@t vote=@t] + =/ vot=? .=(vote 'gud') + =/ uid (slaw:sr %uw uidt) ?~ uid ~ + =/ cued (cue u.uid) + =/ pid %- (soft pid:tp) cued + ?~ pid ~ + (self-poke [%ui eyre-id %vote is-ted u.pid vot]) + + ++ handle-thread + ?~ body ~ + =/ bod (frisk:rd q.u.body) + ~& bod=bod + =/ md (~(get by bod) 'text') + ?~ md ~ + =/ title (~(get by bod) 'title') + ?~ title ~ + =/ url (~(get by bod) 'url') + ?~ url ~ + (self-poke [%ui eyre-id %submit-thread u.title u.url u.md]) + + ++ handle-reply |= top=? + ?~ body ~ + =/ bod (frisk:rd q.u.body) + =/ pars (~(get by bod) 'parent') + ?~ pars ~ + =/ uid (slaw:sr %uw u.pars) + ?~ uid ~ + =/ cued (cue u.uid) + =/ pid %- (soft pid:tp) cued + ?~ pid ~ + =/ md (~(get by bod) 'text') + ?~ md ~ + ?: top + =/ ted (get-thread:lib u.pid state) + ?~ ted ~ + (self-poke [%ui eyre-id %submit-comment u.ted u.md]) + :: + =/ com (get-comment:lib u.pid state) + ?~ com ~ + (self-poke [%ui eyre-id %submit-reply u.com u.md]) + -- + :: + ++ self-poke |= noun=* + =/ =card:agent:gall + [%pass /gib %agent [our.bowl dap.bowl] %poke %noun !>(noun)] + :~ card + == -- --