From 07454e232757d906bfa9a2886235018a5d4c948d Mon Sep 17 00:00:00 2001 From: Fang Date: Thu, 3 Oct 2019 01:30:07 +0200 Subject: [PATCH 01/16] apps: Add WIP chat-cli --- pkg/arvo/app/chat-cli.hoon | 990 +++++++++++++++++++++++++++++++++++++ 1 file changed, 990 insertions(+) create mode 100644 pkg/arvo/app/chat-cli.hoon diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon new file mode 100644 index 0000000000..dbaa7ee999 --- /dev/null +++ b/pkg/arvo/app/chat-cli.hoon @@ -0,0 +1,990 @@ +:: chat-cli: cli chat client using chat-store and friends +:: +:: pulls all known messages into a single stream. +:: type ;help for usage instructions. +:: +::NOTE the code is a mess. heavily wip! +:: +/- sole-sur=sole, *chat-store, *chat-view, *chat-hook +/+ sole-lib=sole +:: +|% ++$ state + $: grams=(list mail) + known=(set [path serial]) + count=@ud :: (lent grams) + :: ui state :: + nicks=(map ship @t) ::TODO contacts + bound=(map (set target) char) :: bound circle glyphs + binds=(jug char (set target)) :: circle glyph lookup + latest=@ud :: latest shown msg num + audience=(set target) :: active targets + settings=(set term) :: frontend flags + width=@ud :: display width + timez=(pair ? @ud) :: timezone adjustment + cli=[=bone state=sole-share:sole-sur] :: console id & state + == +:: ++$ mail [source=path envelope] ++$ target [=ship =path] +:: +++ command + $% [%say (list letter)] :: send message + [%eval cord hoon] :: send #-message + :: + [%create =path =(unit char)] + [%join targets=(set target)] + [%leave targets=(set target)] + :: + [%target to=(set target)] + :: + [%help ~] :: print usage info + == :: +:: ++$ move [bone card] ++$ card + $% [%diff %sole-effect sole-effect:sole-sur] + [%poke wire dock out-action] + [%peer wire dock path] + == +:: ++$ out-action + $% [%chat-action chat-action] + [%chat-view-action chat-view-action] + [%chat-hook-action chat-hook-action] + == +:: +::TODO why is this not in /sur/chat-store ++$ in-diff + $% [%chat-initial inbox] + [%chat-configs chat-configs] + [%chat-update chat-update] + == +-- +:: +|_ [=bowl:gall state] +:: +++ prep + |= old=(unit state) + ~& %chat-cli-prep + ?^ old [~ this(+<+ u.old)] + =. audience [[our.bowl /inbox] ~ ~] + =. settings (sy %showtime %notify ~) + =. width 80 + :_ this + ::TODO %peer /all + ~ +:: +++ this . +:: +++ true-self + |= who=ship + ^- ship + ?. ?=(%earl (clan:title who)) who + ::TODO but they're moons... isn't ^sein sufficient? + (sein:title our.bowl now.bowl who) +:: +++ our-self (true-self our.bowl) +:: +++ diff-chat-initial + |= [=wire =inbox] + ^- (quip move _this) + =| moves=(list move) + |- ^- (quip move _this) + ?~ inbox [~ this] + =^ mon this (read-envelopes [p envelopes.q]:n.inbox) + =^ mol this $(inbox l.inbox) + =^ mor this $(inbox r.inbox) + [:(weld mon mol mor) this] +:: +++ read-envelopes + |= [=path envs=(list envelope)] + ^- (quip move _this) + ?~ envs [~ this] + =^ moi this (read-envelope path i.envs) + =^ mot this $(envs t.envs) + [(weld moi mot) this] +:: +++ diff-chat-update + |= [=wire upd=chat-update] + ^- (quip move _this) + ?+ -.upd [~ this] + %message (read-envelope +.upd) + == +:: +++ read-envelope + |= [=path =envelope] + ^- (quip move _this) + ?: (~(has in known) [path uid.envelope]) + ::NOTE we no-op only because edits aren't possible + [~ this] + :- (print-envelope:sh path envelope) + %_ this + known (~(put in known) [path uid.envelope]) + grams [[path envelope] grams] + count +(count) + == +:: +++ peer + |= =path + ^- (quip move _this) + ?. =(src.bowl our.bowl) + ~| [%peer-talk-stranger src.bowl] + !! + ?. ?=([%sole *] path) + ~| [%peer-talk-strange path] + !! + =. bone.cli ost.bowl + :: display a fresh prompt + :- [prompt:sh ~] + :: start with fresh sole state + this(state.cli *sole-share:sole-sur) +:: +++ poke-sole-action + |= act=sole-action:sole-sur + ^- (quip move _this) + ?. =(bone.cli ost.bowl) + ~|(%strange-sole !!) + (sole:sh act) +:: +++ sh + |% + ++ effect + :: console effect move + :: + |= fec=sole-effect:sole-sur + ^- move + [bone.cli %diff %sole-effect fec] + :: + ++ note + :: shell message + :: + :: left-pads {txt} with heps and prints it. + :: + |= txt=tape + ^- move + =+ lis=(simple-wrap txt (sub width 16)) + %+ effect %mor + =+ ?:((gth (lent lis) 0) (snag 0 lis) "") + :- txt+(runt [14 '-'] '|' ' ' -) + %+ turn (slag 1 lis) + |=(a=tape txt+(runt [14 ' '] '|' ' ' a)) + :: + ++ prompt + :: show prompt + :: + :: makes and stores a move to modify the cli + :: prompt to display the current audience. + :: + ^- move + %+ effect %pro + :+ & %talk-line + ^- tape + =+ cha=(~(get by bound) audience) + ?^ cha ~[u.cha ' '] + =+ por=~(ar-prom ar audience) + (weld `tape`['[' por] `tape`[']' ' ' ~]) + :: + ++ sole + :: applies sole action. + :: + |= act=sole-action:sole-sur + ^- (quip move _this) + ?- -.act + $det (edit +.act) + $clr [~ this] :: (sh-pact ~) ::TODO clear to PM-to-self? + $ret obey + == + :: + ++ edit + :: apply sole edit + :: + :: called when typing into the cli prompt. + :: applies the change and does sanitizing. + :: + |= cal=sole-change:sole-sur + ^- (quip move _this) + =^ inv state.cli (~(transceive sole-lib state.cli) cal) + =+ fix=(sanity inv buf.state.cli) + ?~ lit.fix + [~ this] + :: just capital correction + ?~ err.fix + (slug fix) + :: allow interior edits and deletes + ?. &(?=($del -.inv) =(+(p.inv) (lent buf.state.cli))) + [~ this] + (slug fix) + :: + ++ read + :: command parser + :: + :: parses the command line buffer. produces work + :: items which can be executed by ++sh-work. + :: + =< work + :: # %parsers + :: various parsers for command line input. + |% + ++ expr + :: [cord hoon] + |= tub/nail %. tub + %+ stag (crip q.tub) + wide:(vang & [&1:% &2:% (scot %da now.bowl) |3:%]) + :: + ++ dare + :: @dr + %+ sear + |= a/coin + ?. ?=({$$ $dr @} a) ~ + (some `@dr`+>.a) + nuck:so + :: + ++ ship ;~(pfix sig fed:ag) :: ship + ++ shiz :: ship set + %+ cook + |=(a/(list ^ship) (~(gas in *(set ^ship)) a)) + (most ;~(plug com (star ace)) ship) + :: + ::TODO stolen from stdlib stab, add to stdlib + ++ path + ;~(pfix net (more net urs:ab)) + :: + ++ tarl :: local target + ;~(pfix cen (stag our-self path)) + :: + ++ targ :: target + ;~ pose + (cold [our-self /] col) + ;~(pfix ket (stag (^sein:title our-self) path)) + tarl + ;~(plug ship path) + == + :: + ++ targets-flat :: collapse mixed list + |= a=(list (each target (set target))) + ^- (set target) + ?~ a ~ + ?- -.i.a + %& (~(put in $(a t.a)) p.i.a) + %| (~(uni in $(a t.a)) p.i.a) + == + :: + ++ tars :: non-empty circles + %+ cook targets-flat + %+ most ;~(plug com (star ace)) + (^pick targ (sear glyf glyph)) + :: + ++ drat + :: @da or @dr + :: + :: pas: whether @dr's are in the past or not. + |= pas/? + =- ;~(pfix sig (sear - crub:so)) + |= a/^dime + ^- (unit @da) + ?+ p.a ~ + $da `q.a + $dr :- ~ + %. [now.bowl q.a] + ?:(pas sub add) + == + :: + ++ tarz :: non-empty sources + %+ cook ~(gas in *(set target)) + (most ;~(plug com (star ace)) targ) + :: + ++ pick :: message reference + ;~(pose nump (cook lent (star mic))) + :: + ++ nump :: number reference + ;~ pose + ;~(pfix hep dem:ag) + ;~ plug + (cook lent (plus (just '0'))) + ;~(pose dem:ag (easy 0)) + == + (stag 0 dem:ag) + == + :: + ++ lobe :: y/n loob + ;~ pose + (cold %& ;~(pose (jest 'y') (jest '&') (just 'true'))) + (cold %| ;~(pose (jest 'n') (jest '|') (just 'false'))) + == + :: + ++ message :: exp, lin or url msg + ;~ pose + ;~(plug (cold %eval hax) expr) + (stag %say letters) + == + :: + ++ letters :: lin or url msgs + %+ most (jest '•') + ;~ pose + ::TODO (stag %url aurf:de-purl:html) + :(stag %text ;~(less mic hax text)) + == + :: + ++ text :: msg without break + %+ cook crip + (plus ;~(less (jest '•') next)) + :: + ++ nick (cook crip (plus next)) :: nickname + ++ glyph (mask "!@#$%^&()-=_+[]\{}'\\:\"|,./<>?") :: circle postfix + ++ setting :: setting flag + %- perk :~ + %nicks + %quiet + %notify + %showtime + == + ++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib + ++ work :: full input + %+ knee *command |. ~+ + =- ;~(pose ;~(pfix mic -) message) + ;~ pose + :: + ;~((glue ace) (tag %create) ;~(plug path (punt ;~(pfix ace glyph)))) + :: + ;~((glue ace) (tag %join) tars) + ;~((glue ace) (tag %leave) tars) + :: + (stag %target tars) + :: + ;~(plug (tag %help) (easy ~)) + :: + == + -- + :: + ++ obey + :: apply result + :: + :: called upon hitting return in the prompt. if + :: input is invalid, ++sh-slug is called. + :: otherwise, the appropriate work is done and + :: the entered command (if any) gets displayed + :: to the user. + :: + ^- (quip move _this) + =+ buf=buf.state.cli + =+ fix=(sanity [%nop ~] buf) + ?^ lit.fix + (slug fix) + =+ jub=(rust (tufa buf) read) + ?~ jub [[(effect %bel ~) ~] this] + =^ cal state.cli (~(transmit sole-lib state.cli) [%set ~]) + =^ moves this (work u.jub) + :_ this + %+ weld + ^- (list move) + :: echo commands into scrollback + ?. =(`0 (find ";" buf)) ~ + [(note (tufa `(list @)`buf)) ~] + :_ moves + %+ effect %mor + :~ [%nex ~] + [%det cal] + == + :: + ++ work + :: do work + :: + :: implements worker arms for different talk + :: commands. + :: worker arms must produce updated state. + :: + |= job=command + ^- (quip move _this) + |^ ?+ -.job ~|([%unimplemented -.job] !!) + :: %join (join +.job) + :: %leave (leave +.job) + %create (create +.job) + :: + %say (say +.job) + :: %eval (eval +.job) + :: + %target (set-target +.job) + :: + %help help + == + :: + ++ act + |= [what=term app=term =out-action] + ^- move + :* ost.bowl + %poke + /cli-command/[what] + [our.bowl app] + out-action + == + :: + ++ set-glyph + :: new glyph binding + :: + :: applies glyph binding to our state. + :: + |= [cha=char aud=(set target)] + %_ this + bound (~(put by bound) aud cha) + binds (~(put ju binds) cha aud) + == + ::TODO should send these to settings store eventually + :: + ++ unset-glyph + :: remove old glyph binding + :: + :: removes either {aud} or all bindings on a + :: glyph. + :: + |= [cha=char aud=(unit (set target))] + ^+ this + =/ ole=(set (set target)) + ?^ aud [u.aud ~ ~] + (~(get ju binds) cha) + |- ^+ this + ?~ ole this + =. this $(ole l.ole) + =. this $(ole r.ole) + %_ this + bound (~(del by bound) n.ole) + binds (~(del ju binds) cha n.ole) + == + ::TODO should send these to settings store eventually + :: + ++ create + ::TODO configurable security + |= [=path gyf=(unit char)] + ^- (quip move _this) + ::TODO check if already exists + =/ =target [our.bowl path] + =. audience [target ~ ~] + =? this ?=(^ gyf) + (set-glyph u.gyf audience) + :_ this + :_ ~ + %^ act %do-create %chat-view + :- %chat-view-action + [%create path %channel ~ ~] + :: + ++ say + |= letters=(list letter) + ^- (quip move _this) + =/ =serial (shaf %msg-uid eny.bowl) + :_ this(eny.bowl (shax eny.bowl)) + ^- (list move) + ::TODO wait, so, is host irrelevant in target? only for joins? + %+ turn ~(tap in audience) + |= =target + %^ act %out-message %chat-hook + :- %chat-action + :+ %message path.target + :* serial + *@ + our.bowl + now.bowl + (snag 0 letters) ::TODO support multiple + == + :: + ++ set-target + |= tars=(set target) + ^- (quip move _this) + =. audience tars + [[prompt ~] this] + :: + ++ help + ^- (quip move _this) + :_ this + :~ (effect %txt "see https://urbit.org/docs/using/messaging/") + ::TODO tmp + `move`[ost.bowl %peer /chat-store [our.bowl %chat-store] /all] + == + -- + :: + ++ sanity + :: check input sanity + :: + :: parses cli prompt input using ++read and + :: describes error correction when invalid. + :: + |= [inv=sole-edit:sole-sur buf=(list @c)] + ^- [lit=(list sole-edit:sole-sur) err=(unit @u)] + =+ res=(rose (tufa buf) read) + ?: ?=(%& -.res) [~ ~] + [[inv]~ `p.res] + :: + ++ slug + :: apply error correction to prompt input + :: + |= [lit=(list sole-edit:sole-sur) err=(unit @u)] + ^- (quip move _this) + ?~ lit [~ this] + =^ lic state.cli + %- ~(transmit sole-lib state.cli) + ^- sole-edit:sole-sur + ?~(t.lit i.lit [%mor lit]) + :_ this + :_ ~ + %+ effect %mor + :- [%det lic] + ?~(err ~ [%err u.err]~) + :: + ++ glyf + :: decode glyph + :: + :: finds the circle(s) that match a glyph. + :: + |= cha=char + ^- (unit (set target)) + =+ lax=(~(get ju binds) cha) + :: no circle. + ?: =(~ lax) ~ + :: single circle. + ?: ?=({* ~ ~} lax) `n.lax + :: in case of multiple audiences, pick the most recently active one. + |- ^- (unit (set target)) + ?~ grams ~ + ~ + ::TODO + :: :: get first circle from a telegram's audience. + :: =+ pan=(silt ~(tap in aud.i.grams)) + :: ?: (~(has in lax) pan) `pan + :: $(grams t.grams) + :: + ++ print-envelope + |= [=path =envelope] + ^- (list move) + %+ weld + ^- (list move) + ?. =(0 (mod count 5)) ~ + :_ ~ + =+ num=(scow %ud count) + %+ effect %txt + (runt [(sub 13 (lent num)) '-'] "[{num}]") + ::TODO %notify logic? or do elsewhere? just check the %text msgs + =+ lis=~(render tr settings path envelope) + ?~ lis ~ + :_ ~ + %+ effect %mor + %+ turn `(list tape)`lis + =+ nom=(scag 7 (cite:title our-self)) + |= t=tape + ?. ?& (~(has in settings) %notify) + ?=(^ (find nom (slag 15 t))) + == + [%txt t] + [%mor [%txt t] [%bel ~] ~] + -- +:: +:: +::TODO code style +++ ar + :: audience renderer + :: + :: used for representing audiences (sets of circles) + :: as tapes. + :: + |_ :: aud: members of the audience. + :: + aud=(set target) + :: + ++ ar-best + :: find the most relevant circle in the set. + :: + ^- (unit target) + ?~ aud ~ + :- ~ + |- ^- target + =+ lef=`(unit target)`ar-best(aud l.aud) + =+ rit=`(unit target)`ar-best(aud r.aud) + =? n.aud ?=(^ lef) (~(cr-best cr n.aud) u.lef) + =? n.aud ?=(^ rit) (~(cr-best cr n.aud) u.rit) + n.aud + :: + ++ ar-deaf + :: remove ourselves from the audience. + :: + ^+ . + .(aud (~(del in aud) [our.bowl /])) + :: + ++ ar-maud + :: multiple audience + :: + :: checks if there's multiple circles in the + :: audience via pattern matching. + :: + ^- ? + =. . ar-deaf + !?=($@(~ {* ~ ~}) aud) + :: + ++ ar-phat + :: render all circles, no glyphs. + :: + ^- tape + %- ~(rep in aud) + |= {c/target t/tape} + =? t ?=(^ t) + (weld t ", ") + (weld t ~(cr-phat cr c)) + :: + ++ ar-prom + :: render all circles, ordered by relevance. + :: + ^- tape + =. . ar-deaf + =/ all + %+ sort `(list target)`~(tap in aud) + |= {a/target b/target} + (~(cr-beat cr a) b) + =+ fir=& + |- ^- tape + ?~ all ~ + ;: welp + ?:(fir "" " ") + (~(cr-show cr i.all) ~) + $(all t.all, fir |) + == + :: + ++ ar-whom + :: render sender as the most relevant circle. + :: + (~(cr-show cr (need ar-best)) ~ ar-maud) + :: + ++ ar-dire + :: returns true if circle is a mailbox of ours. + :: + |= cir=target ^- ? + ?& =(ship.cir our-self) + ::TODO permissions check + == + :: + ++ ar-glyf + :: audience glyph + :: + :: get the glyph that corresponds to the audience. + :: for mailbox messages and complex audiences, use + :: reserved "glyphs". + :: + ^- tape + =+ cha=(~(get by bound) aud) + ?^ cha ~[u.cha] + ?. (lien ~(tap by aud) ar-dire) + "*" + ?: ?=({^ ~ ~} aud) + ":" + ";" + -- +:: +++ cr + :: target renderer + :: + :: used in both target and ship rendering. + :: + |_ :: one: the target. + :: + one=target + :: + ++ cr-beat + :: {one} more relevant? + :: + :: returns true if one is better to show, false + :: otherwise. prioritizes: our > main > size. + :: + |= two=target + ^- ? + :: the target that's ours is better. + ?: =(our-self ship.one) + ?. =(our-self ship.two) & + ?< =(path.one path.two) + :: if both targets are ours, the main story is better. + ?: =(%inbox path.one) & + ?: =(%inbox path.two) | + :: if neither are, pick the "larger" one. + (lth (lent path.one) (lent path.two)) + :: if one isn't ours but two is, two is better. + ?: =(our-self ship.two) | + ?: =(ship.one ship.two) + :: if they're from the same ship, pick the "larger" one. + (lth (lent path.one) (lent path.two)) + :: if they're from different ships, neither ours, pick hierarchically. + (lth (xeb ship.one) (xeb ship.two)) + :: + ++ cr-best + :: returns the most relevant target. + :: + |= two=target + ?:((cr-beat two) one two) + :: + ++ cr-curt + :: prints a ship name in 14 characters. + :: + :: left-pads with spaces. {mup} signifies + :: "are there other targets besides this one?" + :: + |= mup=? + ^- tape + =+ raw=(cite:title ship.one) + (runt [(sub 14 (lent raw)) ' '] raw) + :: + ++ cr-nick + :: get nick for ship, or shortname if no nick. + :: + :: left-pads with spaces. + :: + |= source=path + ^- tape + =/ nic=(unit cord) + ?: (~(has by nicks) ship.one) + (~(get by nicks) ship.one) + ::TODO get their-set nick from presence + ~ + ?~ nic (cr-curt |) + =+ raw=(scag 14 (trip u.nic)) + =+ len=(sub 14 (lent raw)) + (weld (reap len ' ') raw) + :: + :: todo: figure out why enabling the doccord causes a nest fail, even when + :: attached to the arm instead of the product. + :: + ++ cr-phat ::: render accurately + ::: prints a target fully, but still taking + ::: "shortcuts" where possible: + ::: ":" for local mailbox, "~ship" for foreign + ::: mailbox, "%/channel" for local target, + ::: "^/channel" for parent target. + :: + ^- tape + ?: =(our-self ship.one) + ?: =(/ path.one) + ":" + ['%' (spud path.one)] + =+ wun=(cite:title ship.one) + ?: =(path.one %inbox) + wun + ?: =(ship.one (^sein:title our-self)) + ['/' (spud path.one)] + :(welp wun "/" (spud path.one)) + :: + ++ cr-full (cr-show ~) :: render full width + :: + ++ cr-show + :: renders a target as text. + :: + :: moy: multiple targets in audience? + |= moy=(unit ?) + ^- tape + :: render target (as glyph if we can). + ?~ moy + =+ cha=(~(get by bound) one ~ ~) + =- ?~(cha - "{u.cha ~}") + ~(cr-phat cr one) + (~(cr-curt cr one) u.moy) + -- +:: +++ tr + :: telegram renderer + :: + :: responsible for converting telegrams and + :: everything relating to them to text to be + :: displayed in the cli. + :: + |_ $: settings=(set term) + source=path + envelope + == + :: + ++ tr-fact + :: activate effect + :: + :: produces sole-effect for printing message + :: details. + :: + ^- sole-effect:sole-sur + ~[%mor [%tan tr-meta] tr-body] + :: + ++ render + :: renders a telegram + :: + :: the first line will contain the author and + :: optional timestamp. + :: + ^- (list tape) + =/ wyd + %+ sub width :: termwidth, + %+ add 14 :: minus author, + ?:((~(has in settings) %showtime) 10 0) :: minus timestamp. + =+ txs=(tr-text wyd) + ?~ txs ~ + :: render the author. + =/ nom=tape + ?: (~(has in settings) %nicks) + (~(cr-nick cr [author /inbox]) source) + (~(cr-curt cr [author /inbox]) |) + :: regular indent. + =/ den=tape + (reap (lent nom) ' ') + :: timestamp, if desired. + =/ tam=tape + ?. (~(has in settings) %showtime) "" + =. when + %. [when (mul q.timez ~h1)] + ?:(p.timez add sub) + =+ dat=(yore when) + =/ t + |= a/@ + %+ weld + ?:((lth a 10) "0" ~) + (scow %ud a) + =/ time + ;: weld + "~" (t h.t.dat) + "." (t m.t.dat) + "." (t s.t.dat) + == + %+ weld + (reap (sub +(wyd) (min wyd (lent (tuba i.txs)))) ' ') + time + %- flop + %+ roll `(list tape)`txs + |= [t=tape l=(list tape)] + ?~ l [:(weld nom t tam) ~] + [(weld den t) l] + :: + ++ tr-meta + :: metadata + :: + :: builds string that display metadata, including + :: message serial, timestamp, author and audience. + :: + ^- tang + =. when (sub when (mod when (div when ~s0..0001))) :: round + =+ hed=leaf+"{(scow %uv uid)} at {(scow %da when)}" + =/ src=tape (spud source) + [%rose [" " ~ ~] [hed >author< [%rose [", " "to " ~] [leaf+src]~] ~]]~ + :: + ++ tr-body + :: message content + :: + :: long-form display of message contents, specific + :: to each speech type. + :: + |- ^- sole-effect:sole-sur + ?- -.letter + %text + tan+~[leaf+"{(trip text.letter)}"] + :: + %url + url+url.letter + :: + %code + =/ texp=tape ['>' ' ' (trip expression.letter)] + :- %mor + |- ^- (list sole-effect:sole-sur) + ?: =("" texp) [tan+output.letter ~] + =/ newl (find "\0a" texp) + ?~ newl [txt+texp $(texp "")] + =+ (trim u.newl texp) + :- txt+(scag u.newl texp) + $(texp [' ' ' ' (slag +(u.newl) texp)]) + == + :: + ++ tr-chow + :: truncate + :: + :: truncates the {txt} to be of max {len} + :: characters. if it does truncate, indicates it + :: did so by appending _ or …. + :: + |= [len=@u txt=tape] + ^- tape + ?: (gth len (lent txt)) txt + =. txt (scag len txt) + |- + ?~ txt txt + ?: =(' ' i.txt) + |- + :- '_' + ?. ?=({$' ' *} t.txt) + t.txt + $(txt t.txt) + ?~ t.txt "…" + [i.txt $(txt t.txt)] + :: + ++ tr-text + :: compact contents + :: + :: renders just the most important data of the + :: message. if possible, these stay within a single + :: line. + :: + :: pre: replace/append line prefix + ::TODO this should probably be redone someday. + =| pre=(unit (pair ? tape)) + |= wyd=@ud + ^- (list tape) + ?- -.letter + %code + =+ texp=(trip expression.letter) + =+ newline=(find "\0a" texp) + =? texp ?=(^ newline) + (weld (scag u.newline texp) " ...") + :- (tr-chow wyd '#' ' ' texp) + ?~ output.letter ~ + =- [' ' (tr-chow (dec wyd) ' ' -)]~ + ~(ram re (snag 0 `(list tank)`output.letter)) + :: + %url + :_ ~ + =+ ful=(trip url.letter) + =+ pef=q:(fall pre [p=| q=""]) + :: clean up prefix if needed. + =? pef =((scag 1 (flop pef)) " ") + (scag (dec (lent pef)) pef) + =. pef (weld "/" pef) + =. wyd (sub wyd +((lent pef))) :: account for prefix. + :: if the full url fits, just render it. + ?: (gte wyd (lent ful)) :(weld pef " " ful) + :: if it doesn't, prefix with _ and render just (the tail of) the domain. + %+ weld (weld pef "_") + ::TODO need kinda dangerous... + =+ hok=r.p:(need (de-purl:html url.letter)) + =- (swag [a=(sub (max wyd (lent -)) wyd) b=wyd] -) + ^- tape + =< ?: ?=(%& -.hok) + (reel p.hok .) + +:(scow %if p.hok) + |= [a=knot b=tape] + ?~ b (trip a) + (welp b '.' (trip a)) + :: + %text + :: glyph prefix + =/ pef=tape + ?: &(?=(^ pre) p.u.pre) q.u.pre + =- (weld - q:(fall pre [p=| q=" "])) + %~ ar-glyf ar + [[our.bowl source] ~ ~] ::TODO just single source path + =/ lis=(list tape) + %+ simple-wrap + `tape``(list @)`(tuba (trip text.letter)) + (sub wyd (min (div wyd 2) (lent pef))) + =+ lef=(lent pef) + =+ ?:((gth (lent lis) 0) (snag 0 lis) "") + :- (weld pef -) + %+ turn (slag 1 lis) + |=(a=tape (runt [lef ' '] a)) + == + -- +:: +++ simple-wrap + |= {txt/tape wyd/@ud} + ^- (list tape) + ?~ txt ~ + =+ ^- {end/@ud nex/?} + ?: (lte (lent txt) wyd) [(lent txt) &] + =+ ace=(find " " (flop (scag +(wyd) `tape`txt))) + ?~ ace [wyd |] + [(sub wyd u.ace) &] + :- (tufa (scag end `(list @)`txt)) + $(txt (slag ?:(nex +(end) end) `tape`txt)) +-- \ No newline at end of file From 7911061dab5270da85c892470b219063182862d1 Mon Sep 17 00:00:00 2001 From: Fang Date: Fri, 4 Oct 2019 22:38:22 +0200 Subject: [PATCH 02/16] chat-cli: Make more fully-featured Brings it largely up to parity with Talk, save for features relating to: - presence & nicknames - circle management (permissions, sources) - deprecated message types In addition to implementing remaining functionality for basic usage patterns, makes the following changes: - glyphs per target, not multiple targets - assume /~ship/path paths are created/used by the chat-hook Code cleanup pending. --- pkg/arvo/app/chat-cli.hoon | 608 ++++++++++++++++++++++++++----------- 1 file changed, 429 insertions(+), 179 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index dbaa7ee999..5608d507fa 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -3,21 +3,27 @@ :: pulls all known messages into a single stream. :: type ;help for usage instructions. :: +:: note that while the chat-store only cares about paths, +:: we mostly deal with [ship path] (aka target) here. +:: when sending messages (through the chat hook), +:: we concat the ship onto the head of the path, +:: and trust it to take care of the rest. +:: ::NOTE the code is a mess. heavily wip! :: /- sole-sur=sole, *chat-store, *chat-view, *chat-hook /+ sole-lib=sole +/= seed /~ !>(.) :: |% +$ state $: grams=(list mail) - known=(set [path serial]) + known=(set [target serial]) count=@ud :: (lent grams) :: ui state :: - nicks=(map ship @t) ::TODO contacts - bound=(map (set target) char) :: bound circle glyphs - binds=(jug char (set target)) :: circle glyph lookup - latest=@ud :: latest shown msg num + ::TODO nicks from contacts + bound=(map target char) :: bound circle glyphs + binds=(jug char target) :: circle glyph lookup audience=(set target) :: active targets settings=(set term) :: frontend flags width=@ud :: display width @@ -25,19 +31,33 @@ cli=[=bone state=sole-share:sole-sur] :: console id & state == :: -+$ mail [source=path envelope] ++$ mail [source=target envelope] +$ target [=ship =path] :: -++ command - $% [%say (list letter)] :: send message ++$ glyph char +++ glyphs "!@#$%^&()-=_+[]\{};'\\:\",.<>?" +:: ++$ command + $% [%target (set target)] :: set messaging target + [%say (list letter)] :: send message [%eval cord hoon] :: send #-message :: - [%create =path =(unit char)] - [%join targets=(set target)] - [%leave targets=(set target)] + [%create path =(unit glyph)] :: create chat + [%join target =(unit glyph)] :: join target + [%leave target] :: nuke target :: - [%target to=(set target)] + [%bind glyph target] :: bind glyph + [%unbind glyph] :: unbind glyph + [%what (unit $@(char target))] :: glyph lookup :: + [%settings ~] :: show active settings + [%set term] :: set settings flag + [%unset term] :: unset settings flag + [%width @ud] :: adjust display width + [%timezone ? @ud] :: adjust time printing + :: + [%select $@(back=@ud [zeros=@u num=@ud])] :: rel/abs msg selection + [%chats ~] :: list available chats [%help ~] :: print usage info == :: :: @@ -53,13 +73,6 @@ [%chat-view-action chat-view-action] [%chat-hook-action chat-hook-action] == -:: -::TODO why is this not in /sur/chat-store -+$ in-diff - $% [%chat-initial inbox] - [%chat-configs chat-configs] - [%chat-update chat-update] - == -- :: |_ [=bowl:gall state] @@ -67,8 +80,10 @@ ++ prep |= old=(unit state) ~& %chat-cli-prep - ?^ old [~ this(+<+ u.old)] - =. audience [[our.bowl /inbox] ~ ~] + ?^ old + :_ this(+<+ u.old) + [ost.bowl %peer /chat-store [our-self %chat-store] /all]~ + =. audience [[our-self /inbox] ~ ~] =. settings (sy %showtime %notify ~) =. width 80 :_ this @@ -86,22 +101,41 @@ :: ++ our-self (true-self our.bowl) :: +++ target-to-path + |= target + path + ::TODO + :: [(scot %p ship) path] +:: +++ path-to-target + |= =path + ^- target + ?. ?=([@ @ *] path) + ::TODO but then doing target-to-path won't get us the same path... + [our-self path] + =+ who=(slaw %p i.path) + ?~ who [our-self path] + [u.who path] +:: ++ diff-chat-initial |= [=wire =inbox] ^- (quip move _this) =| moves=(list move) |- ^- (quip move _this) ?~ inbox [~ this] - =^ mon this (read-envelopes [p envelopes.q]:n.inbox) + =* path p.n.inbox + =* mailbox q.n.inbox + =/ =target (path-to-target path) + =^ mon this (read-envelopes target envelopes.mailbox) =^ mol this $(inbox l.inbox) =^ mor this $(inbox r.inbox) [:(weld mon mol mor) this] :: ++ read-envelopes - |= [=path envs=(list envelope)] + |= [=target envs=(list envelope)] ^- (quip move _this) ?~ envs [~ this] - =^ moi this (read-envelope path i.envs) + =^ moi this (read-envelope target i.envs) =^ mot this $(envs t.envs) [(weld moi mot) this] :: @@ -109,26 +143,68 @@ |= [=wire upd=chat-update] ^- (quip move _this) ?+ -.upd [~ this] - %message (read-envelope +.upd) + %create (notice-create (path-to-target path.upd)) + %delete [[(show-delete:sh (path-to-target path.upd)) ~] this] + %message (read-envelope (path-to-target path.upd) envelope.upd) == :: -++ read-envelope - |= [=path =envelope] +++ notice-create + |= =target ^- (quip move _this) - ?: (~(has in known) [path uid.envelope]) + =^ moz this + ?: (~(has by bound) target) + [~ this] + (bind-default-glyph target) + [[(show-create:sh target) moz] this] +:: +++ bind-default-glyph + |= =target + ^- (quip move _this) + =- (bind-glyph - target) + ::TODO try not to double-bind + =- (snag - glyphs) + (mod (mug target) (lent glyphs)) +:: +++ bind-glyph + |= [=glyph =target] + ^- (quip move _this) + ::TODO should send these to settings store eventually + ::TODO disallow double-binding glyphs? + =. bound (~(put by bound) target glyph) + =. binds (~(put ju binds) glyph target) + [(show-glyph:sh glyph `target) this] +:: +++ unbind-glyph + |= =glyph ::TODO do we really not want this optionally per-audience? + ^- (quip move _this) + =/ ole=(set target) + (~(get ju binds) glyph) + =. binds (~(del by binds) glyph) + =. bound + |- + ?~ ole bound + =. bound $(ole l.ole) + =. bound $(ole r.ole) + (~(del by bound) n.ole) + [(show-glyph:sh glyph ~) this] +:: +++ read-envelope + |= [=target =envelope] + ^- (quip move _this) + ?: (~(has in known) [target uid.envelope]) ::NOTE we no-op only because edits aren't possible [~ this] - :- (print-envelope:sh path envelope) + :- (print-envelope:sh target envelope) %_ this - known (~(put in known) [path uid.envelope]) - grams [[path envelope] grams] + known (~(put in known) [target uid.envelope]) + grams [[target envelope] grams] count +(count) == :: ++ peer |= =path ^- (quip move _this) - ?. =(src.bowl our.bowl) + ?. (team:title our-self src.bowl) ~| [%peer-talk-stranger src.bowl] !! ?. ?=([%sole *] path) @@ -147,6 +223,7 @@ ~|(%strange-sole !!) (sole:sh act) :: +::TODO maybe separate +shin and +shout ++ sh |% ++ effect @@ -156,6 +233,12 @@ ^- move [bone.cli %diff %sole-effect fec] :: + ++ print + :: just puts some text into the cli as-is. + :: + |= txt=tape + (effect %txt txt) + :: ++ note :: shell message :: @@ -176,14 +259,22 @@ :: makes and stores a move to modify the cli :: prompt to display the current audience. :: + ::TODO take arg? ^- move %+ effect %pro :+ & %talk-line ^- tape - =+ cha=(~(get by bound) audience) - ?^ cha ~[u.cha ' '] - =+ por=~(ar-prom ar audience) - (weld `tape`['[' por] `tape`[']' ' ' ~]) + =- ?: =(1 (lent -)) "{-} " + "[{-}] " + :: %- zing + :: %+ join " " + :: ^- (list tape) + :: %+ turn ~(tap in audience) + :: |= =target + :: ^- tape + :: =+ gyf=(~(get by bound) target) + :: ?^ gyf ~[u.gyf] + ~(ar-prom ar audience) :: ++ sole :: applies sole action. @@ -246,34 +337,27 @@ |=(a/(list ^ship) (~(gas in *(set ^ship)) a)) (most ;~(plug com (star ace)) ship) :: - ::TODO stolen from stdlib stab, add to stdlib ++ path - ;~(pfix net (more net urs:ab)) + ;~(pfix net (most net urs:ab)) :: ++ tarl :: local target - ;~(pfix cen (stag our-self path)) + (stag our-self path) + :: + ++ tarp :: sponsor target + ;~(pfix ket (stag (sein:title our.bowl now.bowl our-self) path)) :: ++ targ :: target ;~ pose - (cold [our-self /] col) - ;~(pfix ket (stag (^sein:title our-self) path)) tarl + tarp ;~(plug ship path) - == - :: - ++ targets-flat :: collapse mixed list - |= a=(list (each target (set target))) - ^- (set target) - ?~ a ~ - ?- -.i.a - %& (~(put in $(a t.a)) p.i.a) - %| (~(uni in $(a t.a)) p.i.a) + (sear glyf glyph) == :: ++ tars :: non-empty circles - %+ cook targets-flat + %+ cook ~(gas in *(set target)) %+ most ;~(plug com (star ace)) - (^pick targ (sear glyf glyph)) + ;~(pose targ (sear glyf glyph)) :: ++ drat :: @da or @dr @@ -331,11 +415,9 @@ (plus ;~(less (jest '•') next)) :: ++ nick (cook crip (plus next)) :: nickname - ++ glyph (mask "!@#$%^&()-=_+[]\{}'\\:\"|,./<>?") :: circle postfix + ++ glyph (mask glyphs) :: circle postfix ++ setting :: setting flag %- perk :~ - %nicks - %quiet %notify %showtime == @@ -343,17 +425,40 @@ ++ work :: full input %+ knee *command |. ~+ =- ;~(pose ;~(pfix mic -) message) + ::TODO refactor the optional trailing args, glue junk ;~ pose + (stag %target tars) :: ;~((glue ace) (tag %create) ;~(plug path (punt ;~(pfix ace glyph)))) :: - ;~((glue ace) (tag %join) tars) - ;~((glue ace) (tag %leave) tars) + ;~((glue ace) (tag %join) ;~(plug targ (punt ;~(pfix ace glyph)))) + ;~((glue ace) (tag %leave) targ) :: - (stag %target tars) + ;~((glue ace) (tag %bind) glyph targ) + ;~((glue ace) (tag %unbind) glyph) + ;~(plug (perk %what ~) (punt ;~(pfix ace ;~(pose glyph targ)))) :: + ;~(plug (tag %settings) (easy ~)) + ;~((glue ace) (tag %set) setting) + ;~((glue ace) (tag %unset) setting) + ;~(plug (cold %width (jest 'set width ')) dem:ag) + ;~ plug + (cold %timezone (jest 'set timezone ')) + ;~ pose + (cold %| (just '-')) + (cold %& (just '+')) + == + %+ sear + |= a=@ud + ^- (unit @ud) + ?:(&((gte a 0) (lte a 14)) `a ~) + dem:ag + == + :: + ;~(plug (tag %chats) (easy ~)) ;~(plug (tag %help) (easy ~)) :: + (stag %select pick) == -- :: @@ -396,16 +501,28 @@ :: |= job=command ^- (quip move _this) - |^ ?+ -.job ~|([%unimplemented -.job] !!) - :: %join (join +.job) - :: %leave (leave +.job) + |^ ?- -.job ::~|([%unimplemented -.job] !!) + %target (set-target +.job) + :: + %join (join +.job) + %leave (leave +.job) %create (create +.job) :: %say (say +.job) - :: %eval (eval +.job) + %eval (eval +.job) :: - %target (set-target +.job) + %bind (bind-glyph +.job) + %unbind (unbind-glyph +.job) + %what (lookup-glyph +.job) :: + %settings show-settings + %set (set-setting +.job) + %unset (unset-setting +.job) + %width (set-width +.job) + %timezone (set-timezone +.job) + :: + %select (select +.job) + %chats chats %help help == :: @@ -415,58 +532,49 @@ :* ost.bowl %poke /cli-command/[what] - [our.bowl app] + [our-self app] out-action == :: - ++ set-glyph - :: new glyph binding - :: - :: applies glyph binding to our state. - :: - |= [cha=char aud=(set target)] - %_ this - bound (~(put by bound) aud cha) - binds (~(put ju binds) cha aud) - == - ::TODO should send these to settings store eventually - :: - ++ unset-glyph - :: remove old glyph binding - :: - :: removes either {aud} or all bindings on a - :: glyph. - :: - |= [cha=char aud=(unit (set target))] - ^+ this - =/ ole=(set (set target)) - ?^ aud [u.aud ~ ~] - (~(get ju binds) cha) - |- ^+ this - ?~ ole this - =. this $(ole l.ole) - =. this $(ole r.ole) - %_ this - bound (~(del by bound) n.ole) - binds (~(del ju binds) cha n.ole) - == - ::TODO should send these to settings store eventually + ++ set-target + |= tars=(set target) + ^- (quip move _this) + =. audience tars + [[prompt ~] this] :: ++ create ::TODO configurable security |= [=path gyf=(unit char)] ^- (quip move _this) ::TODO check if already exists - =/ =target [our.bowl path] - =. audience [target ~ ~] - =? this ?=(^ gyf) - (set-glyph u.gyf audience) - :_ this - :_ ~ + =/ =target [our-self path] + =^ moz this + ?. ?=(^ gyf) [~ this] + (bind-glyph u.gyf target) + =- [[- moz] this(audience [target ~ ~])] %^ act %do-create %chat-view :- %chat-view-action [%create path %channel ~ ~] :: + ++ join + |= [=target gyf=(unit char)] + ^- (quip move _this) + =^ moz this + ?. ?=(^ gyf) [~ this] + (bind-glyph u.gyf target) + =- [[- moz] this(audience [target ~ ~])] + %^ act %do-join %chat-hook + :- %chat-hook-action + [%add-synced target] + :: + ::TODO but if we leave our own circle, then it disappears for everyone? + ++ leave + |= =target + =- [[- ~] this] + %^ act %do-leave %chat-hook + :- %chat-hook-action + [%remove (target-to-path target)] + :: ++ say |= letters=(list letter) ^- (quip move _this) @@ -478,27 +586,171 @@ |= =target %^ act %out-message %chat-hook :- %chat-action - :+ %message path.target + :+ %message (target-to-path target) :* serial *@ - our.bowl + our-self now.bowl (snag 0 letters) ::TODO support multiple == :: - ++ set-target - |= tars=(set target) + ++ eval + :: run + :: + :: executes {exe} and sends both its code and + :: result. + :: + |= [txt=cord exe=hoon] + :: XX revisit + :: + :: this double-virtualizes and clams to disable .^ + :: + =; tan=(list tank) + (say [%code txt tan] ~) + ;; (list tank) + =< +> + %+ mong + :- mute + =- |.([(sell (slap (slop !>(-) seed) exe))]~) + ^- [our=@p now=@da eny=@uvI] + [our-self now.bowl (shas %eny eny.bowl)] + |=(^ ~) + :: + ++ lookup-glyph + ::TODO we probably want a function for the (list tape) -> %mor %txt case + |= qur=(unit $@(glyph target)) ^- (quip move _this) - =. audience tars - [[prompt ~] this] + =- [[- ~] this] + ?^ qur + ?^ u.qur + =+ gyf=(~(get by bound) u.qur) + (print ?~(gyf "none" [u.gyf]~)) + =+ pan=~(tap in (~(get ju binds) `@t`u.qur)) + ?: =(~ pan) (print "~") + =< (effect %mor (turn pan .)) + |=(t=target [%txt ~(cr-phat cr t)]) + %+ effect %mor + %- ~(rep by binds) + |= $: [=glyph tars=(set target)] + lis=(list sole-effect:sole-sur) + == + %+ weld lis + ^- (list sole-effect:sole-sur) + %- ~(rep in tars) + |= [t=target l=(list sole-effect:sole-sur)] + %+ weld l + ^- (list sole-effect:sole-sur) + [%txt glyph ' ' ~(cr-phat cr t)]~ + :: + ++ show-settings + ^- (quip move _this) + :_ this + :~ %- print + %- zing + ^- (list tape) + :- "flags: " + %+ ^join ", " + (turn `(list @t)`~(tap in settings) trip) + :: + %- print + %+ weld "timezone: " + ^- tape + :- ?:(p.timez '+' '-') + (scow %ud q.timez) + :: + (print "width: {(scow %ud width)}") + == + :: + ++ set-setting + |= =term + ^- (quip move _this) + [~ this(settings (~(put in settings) term))] + :: + ++ unset-setting + |= =term + ^- (quip move _this) + [~ this(settings (~(del in settings) term))] + :: + ++ set-width + |= w=@ud + [~ this(width w)] + :: + ++ set-timezone + |= tz=[? @ud] + [~ this(timez tz)] + :: + ++ select + :: finds selected message, expand it. + :: + ::TODO this either needs a different implementation or extensive comments + |= num=$@(@ud [p=@u q=@ud]) + ^- (quip move _this) + |^ ?@ num + =+ tum=(scow %s (new:si | +(num))) + ?: (gte num count) + %- just-print + "{tum}: no such telegram" + (activate tum num) + ?. (gte q.num count) + ?: =(count 0) + (just-print "0: no messages") + =+ msg=(deli (dec count) num) + (activate (scow %ud msg) (sub count +(msg))) + %- just-print + "…{(reap p.num '0')}{(scow %ud q.num)}: no such telegram" + :: + ++ just-print + |= txt=tape + [[(print txt) ~] this] + :: + ++ deli + :: gets absolute message number from relative. + :: + |= [max=@ud nul=@u fin=@ud] + ^- @ud + =+ dog=|-(?:(=(0 fin) 1 (mul 10 $(fin (div fin 10))))) + =. dog (mul dog (pow 10 nul)) + =- ?:((lte - max) - (sub - dog)) + (add fin (sub max (mod max dog))) + :: + ++ activate + :: prints message details. + :: + |= [number=tape index=@ud] + ^- (quip move _this) + =+ gam=(snag index grams) + =+ tay=~(. tr settings gam) + =. audience [source.gam ~ ~] + :_ this + ^- (list move) + :~ (print ['?' ' ' number]) + (effect tr-fact:tay) + prompt + == + -- + :: + ++ chats + ^- (quip move _this) + :_ this + :_ ~ + %+ effect %mor + =/ all + ::TODO refactor + ::TODO remote scries fail... but moon support? + .^ (set path) + %gx + /(scot %p our-self)/chat-store/(scot %da now.bowl)/keys/noun + == + %+ turn ~(tap in all) + %+ cork path-to-target + |= target + :- %txt + (weld (scow %p ship) (spud path)) :: ++ help ^- (quip move _this) - :_ this - :~ (effect %txt "see https://urbit.org/docs/using/messaging/") - ::TODO tmp - `move`[ost.bowl %peer /chat-store [our.bowl %chat-store] /all] - == + =- [[- ~] this] + (print "see https://urbit.org/docs/using/messaging/") -- :: ++ sanity @@ -535,34 +787,34 @@ :: finds the circle(s) that match a glyph. :: |= cha=char - ^- (unit (set target)) + ^- (unit target) =+ lax=(~(get ju binds) cha) :: no circle. ?: =(~ lax) ~ :: single circle. - ?: ?=({* ~ ~} lax) `n.lax + ?: ?=([* ~ ~] lax) `n.lax :: in case of multiple audiences, pick the most recently active one. - |- ^- (unit (set target)) + |- ^- (unit target) + ~& %multi-bind-support-missing ?~ grams ~ ~ ::TODO - :: :: get first circle from a telegram's audience. :: =+ pan=(silt ~(tap in aud.i.grams)) :: ?: (~(has in lax) pan) `pan :: $(grams t.grams) :: ++ print-envelope - |= [=path =envelope] + |= [=target =envelope] ^- (list move) %+ weld ^- (list move) ?. =(0 (mod count 5)) ~ :_ ~ =+ num=(scow %ud count) - %+ effect %txt + %- print (runt [(sub 13 (lent num)) '-'] "[{num}]") ::TODO %notify logic? or do elsewhere? just check the %text msgs - =+ lis=~(render tr settings path envelope) + =+ lis=~(render tr settings target envelope) ?~ lis ~ :_ ~ %+ effect %mor @@ -574,6 +826,25 @@ == [%txt t] [%mor [%txt t] [%bel ~] ~] + :: + ++ show-create + |= =target + ^- move + (note "new: {~(cr-phat cr target)}") + :: + ++ show-delete + |= =target + ^- move + (note "del: {~(cr-phat cr target)}") + :: + ++ show-glyph + |= [=glyph target=(unit target)] + ^- (list move) + =- [prompt - ~] + %- note + %+ weld "set: {[glyph ~]} -> " + ?~ target "nothing" + ~(cr-phat cr u.target) -- :: :: @@ -605,7 +876,7 @@ :: remove ourselves from the audience. :: ^+ . - .(aud (~(del in aud) [our.bowl /])) + .(aud (~(del in aud) [our-self /inbox])) :: ++ ar-maud :: multiple audience @@ -649,30 +920,6 @@ :: render sender as the most relevant circle. :: (~(cr-show cr (need ar-best)) ~ ar-maud) - :: - ++ ar-dire - :: returns true if circle is a mailbox of ours. - :: - |= cir=target ^- ? - ?& =(ship.cir our-self) - ::TODO permissions check - == - :: - ++ ar-glyf - :: audience glyph - :: - :: get the glyph that corresponds to the audience. - :: for mailbox messages and complex audiences, use - :: reserved "glyphs". - :: - ^- tape - =+ cha=(~(get by bound) aud) - ?^ cha ~[u.cha] - ?. (lien ~(tap by aud) ar-dire) - "*" - ?: ?=({^ ~ ~} aud) - ":" - ";" -- :: ++ cr @@ -731,39 +978,21 @@ :: :: left-pads with spaces. :: - |= source=path - ^- tape - =/ nic=(unit cord) - ?: (~(has by nicks) ship.one) - (~(get by nicks) ship.one) - ::TODO get their-set nick from presence - ~ - ?~ nic (cr-curt |) - =+ raw=(scag 14 (trip u.nic)) - =+ len=(sub 14 (lent raw)) - (weld (reap len ' ') raw) - :: - :: todo: figure out why enabling the doccord causes a nest fail, even when - :: attached to the arm instead of the product. + |= source=target + ::TODO get nick from contacts store? + (cr-curt |) :: ++ cr-phat ::: render accurately - ::: prints a target fully, but still taking - ::: "shortcuts" where possible: - ::: ":" for local mailbox, "~ship" for foreign - ::: mailbox, "%/channel" for local target, - ::: "^/channel" for parent target. + :: prints a target fully as ~ship/path. + :: for local targets, print as /path. + :: for targets on our sponsor, ^/path. :: ^- tape - ?: =(our-self ship.one) - ?: =(/ path.one) - ":" - ['%' (spud path.one)] - =+ wun=(cite:title ship.one) - ?: =(path.one %inbox) - wun - ?: =(ship.one (^sein:title our-self)) - ['/' (spud path.one)] - :(welp wun "/" (spud path.one)) + %+ weld + ?: =(our-self ship.one) ~ + ?: =((sein:title our.bowl now.bowl our-self) ship.one) "^" + (scow %p ship.one) + (spud path.one) :: ++ cr-full (cr-show ~) :: render full width :: @@ -775,10 +1004,32 @@ ^- tape :: render target (as glyph if we can). ?~ moy - =+ cha=(~(get by bound) one ~ ~) + =+ cha=(~(get by bound) one) =- ?~(cha - "{u.cha ~}") ~(cr-phat cr one) (~(cr-curt cr one) u.moy) + :: + ++ cr-dire + :: returns true if circle is a mailbox of ours. + :: + |= cir=target ^- ? + ?& =(ship.cir our-self) + ::TODO permissions check + == + :: + ++ cr-glyph + :: target glyph + :: + :: get the glyph that corresponds to the target. + :: for mailboxes and complex audiences, use + :: reserved "glyphs". + :: + ^- tape + =+ gyf=(~(get by bound) one) + ?^ gyf ~[u.gyf] + ?. (cr-dire one) + "*" + ":" -- :: ++ tr @@ -789,7 +1040,7 @@ :: displayed in the cli. :: |_ $: settings=(set term) - source=path + source=target envelope == :: @@ -859,7 +1110,7 @@ ^- tang =. when (sub when (mod when (div when ~s0..0001))) :: round =+ hed=leaf+"{(scow %uv uid)} at {(scow %da when)}" - =/ src=tape (spud source) + =/ src=tape ~(cr-phat cr source) [%rose [" " ~ ~] [hed >author< [%rose [", " "to " ~] [leaf+src]~] ~]]~ :: ++ tr-body @@ -962,8 +1213,7 @@ =/ pef=tape ?: &(?=(^ pre) p.u.pre) q.u.pre =- (weld - q:(fall pre [p=| q=" "])) - %~ ar-glyf ar - [[our.bowl source] ~ ~] ::TODO just single source path + ~(cr-glyph cr source) =/ lis=(list tape) %+ simple-wrap `tape``(list @)`(tuba (trip text.letter)) From c0d07fa14abf5a5af2bb98043602a7c04fd8714c Mon Sep 17 00:00:00 2001 From: Fang Date: Mon, 7 Oct 2019 16:02:03 +0200 Subject: [PATCH 03/16] chat-cli: Clean up code Renames, refactors, and occasionally rewrites many of the arms used within the application. Splits +sh into +sh-in and +sh-out, improves naming for rendering cores, moves arms around for better organization, and adds descriptions to all arms. --- pkg/arvo/app/chat-cli.hoon | 1089 ++++++++++++++++-------------------- 1 file changed, 468 insertions(+), 621 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index 5608d507fa..b94686e756 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -9,19 +9,15 @@ :: we concat the ship onto the head of the path, :: and trust it to take care of the rest. :: -::NOTE the code is a mess. heavily wip! -:: /- sole-sur=sole, *chat-store, *chat-view, *chat-hook /+ sole-lib=sole /= seed /~ !>(.) :: |% +$ state - $: grams=(list mail) - known=(set [target serial]) + $: grams=(list mail) :: all messages + known=(set [target serial]) :: known message lookup count=@ud :: (lent grams) - :: ui state :: - ::TODO nicks from contacts bound=(map target char) :: bound circle glyphs binds=(jug char target) :: circle glyph lookup audience=(set target) :: active targets @@ -38,7 +34,7 @@ ++ glyphs "!@#$%^&()-=_+[]\{};'\\:\",.<>?" :: +$ command - $% [%target (set target)] :: set messaging target + $% [%target (set target)] :: set messaging target [%say (list letter)] :: send message [%eval cord hoon] :: send #-message :: @@ -56,7 +52,7 @@ [%width @ud] :: adjust display width [%timezone ? @ud] :: adjust time printing :: - [%select $@(back=@ud [zeros=@u num=@ud])] :: rel/abs msg selection + [%select $@(rel=@ud [zeros=@u abs=@ud])] :: rel/abs msg selection [%chats ~] :: list available chats [%help ~] :: print usage info == :: @@ -76,36 +72,36 @@ -- :: |_ [=bowl:gall state] +++ this . +:: +prep: setup & state adapter :: ++ prep |= old=(unit state) ~& %chat-cli-prep ?^ old - :_ this(+<+ u.old) - [ost.bowl %peer /chat-store [our-self %chat-store] /all]~ - =. audience [[our-self /inbox] ~ ~] - =. settings (sy %showtime %notify ~) - =. width 80 - :_ this - ::TODO %peer /all - ~ -:: -++ this . + [~ this(+<+ u.old)] + :- [ost.bowl %peer /chat-store [our-self %chat-store] /all]~ + %_ this + audience [[our-self /] ~ ~] + settings (sy %showtime %notify ~) + width 80 + == +:: +true-self: moons to planets :: ++ true-self |= who=ship ^- ship ?. ?=(%earl (clan:title who)) who - ::TODO but they're moons... isn't ^sein sufficient? (sein:title our.bowl now.bowl who) -:: ++ our-self (true-self our.bowl) +:: +target-to-path: prepend ship to the path :: ++ target-to-path |= target path ::TODO :: [(scot %p ship) path] +:: +path-to-target: deduces a target from a mailbox path :: ++ path-to-target |= =path @@ -116,6 +112,31 @@ =+ who=(slaw %p i.path) ?~ who [our-self path] [u.who path] +:: +poke-sole-action: handle cli input +:: +++ poke-sole-action + |= act=sole-action:sole-sur + ^- (quip move _this) + ?. =(bone.cli ost.bowl) + ~|(%strange-sole !!) + (sole:sh-in act) +:: +peer: accept only cli subscriptions from ourselves +:: +++ peer + |= =path + ^- (quip move _this) + ?. (team:title our-self src.bowl) + ~| [%peer-talk-stranger src.bowl] + !! + ?. ?=([%sole *] path) + ~| [%peer-talk-strange path] + !! + =. bone.cli ost.bowl + :: display a fresh prompt + :- [prompt:sh-out ~] + :: start with fresh sole state + this(state.cli *sole-share:sole-sur) +:: +diff-chat-initial: catch up on messages :: ++ diff-chat-initial |= [=wire =inbox] @@ -130,6 +151,16 @@ =^ mol this $(inbox l.inbox) =^ mor this $(inbox r.inbox) [:(weld mon mol mor) this] +:: +diff-chat-update: get new mailboxes & messages +:: +++ diff-chat-update + |= [=wire upd=chat-update] + ^- (quip move _this) + ?+ -.upd [~ this] + %create (notice-create (path-to-target path.upd)) + %delete [[(show-delete:sh-out (path-to-target path.upd)) ~] this] + %message (read-envelope (path-to-target path.upd) envelope.upd) + == :: ++ read-envelopes |= [=target envs=(list envelope)] @@ -139,15 +170,6 @@ =^ mot this $(envs t.envs) [(weld moi mot) this] :: -++ diff-chat-update - |= [=wire upd=chat-update] - ^- (quip move _this) - ?+ -.upd [~ this] - %create (notice-create (path-to-target path.upd)) - %delete [[(show-delete:sh (path-to-target path.upd)) ~] this] - %message (read-envelope (path-to-target path.upd) envelope.upd) - == -:: ++ notice-create |= =target ^- (quip move _this) @@ -155,7 +177,8 @@ ?: (~(has by bound) target) [~ this] (bind-default-glyph target) - [[(show-create:sh target) moz] this] + [[(show-create:sh-out target) moz] this] +:: +bind-default-glyph: :: ++ bind-default-glyph |= =target @@ -164,6 +187,7 @@ ::TODO try not to double-bind =- (snag - glyphs) (mod (mug target) (lent glyphs)) +:: +bind-glyph: add binding for glyph :: ++ bind-glyph |= [=glyph =target] @@ -172,10 +196,11 @@ ::TODO disallow double-binding glyphs? =. bound (~(put by bound) target glyph) =. binds (~(put ju binds) glyph target) - [(show-glyph:sh glyph `target) this] + [(show-glyph:sh-out glyph `target) this] +:: +unbind-glyph: remove all binding for glyph :: ++ unbind-glyph - |= =glyph ::TODO do we really not want this optionally per-audience? + |= =glyph ::TODO do we really not want this optionally per-target? ^- (quip move _this) =/ ole=(set target) (~(get ju binds) glyph) @@ -186,7 +211,27 @@ =. bound $(ole l.ole) =. bound $(ole r.ole) (~(del by bound) n.ole) - [(show-glyph:sh glyph ~) this] + [(show-glyph:sh-out glyph ~) this] +:: +decode-glyph: find the target that matches a glyph, if any +:: +++ decode-glyph + |= =glyph + ^- (unit target) + =+ lax=(~(get ju binds) glyph) + :: no circle. + ?: =(~ lax) ~ + :: single circle. + ?: ?=([* ~ ~] lax) `n.lax + :: in case of multiple audiences, pick the most recently active one. + |- ^- (unit target) + ~& %multi-bind-support-missing + ?~ grams ~ + ~ + ::TODO + :: =+ pan=(silt ~(tap in aud.i.grams)) + :: ?: (~(has in lax) pan) `pan + :: $(grams t.grams) +:: +read-envelope: add envelope to state and show it to user :: ++ read-envelope |= [=target =envelope] @@ -194,105 +239,34 @@ ?: (~(has in known) [target uid.envelope]) ::NOTE we no-op only because edits aren't possible [~ this] - :- (print-envelope:sh target envelope) + :- (show-envelope:sh-out target envelope) %_ this known (~(put in known) [target uid.envelope]) grams [[target envelope] grams] count +(count) == :: -++ peer - |= =path - ^- (quip move _this) - ?. (team:title our-self src.bowl) - ~| [%peer-talk-stranger src.bowl] - !! - ?. ?=([%sole *] path) - ~| [%peer-talk-strange path] - !! - =. bone.cli ost.bowl - :: display a fresh prompt - :- [prompt:sh ~] - :: start with fresh sole state - this(state.cli *sole-share:sole-sur) +:: +sh-in: handle user input :: -++ poke-sole-action - |= act=sole-action:sole-sur - ^- (quip move _this) - ?. =(bone.cli ost.bowl) - ~|(%strange-sole !!) - (sole:sh act) -:: -::TODO maybe separate +shin and +shout -++ sh +++ sh-in + ::NOTE interestingly, adding =, sh-out breaks compliation |% - ++ effect - :: console effect move - :: - |= fec=sole-effect:sole-sur - ^- move - [bone.cli %diff %sole-effect fec] - :: - ++ print - :: just puts some text into the cli as-is. - :: - |= txt=tape - (effect %txt txt) - :: - ++ note - :: shell message - :: - :: left-pads {txt} with heps and prints it. - :: - |= txt=tape - ^- move - =+ lis=(simple-wrap txt (sub width 16)) - %+ effect %mor - =+ ?:((gth (lent lis) 0) (snag 0 lis) "") - :- txt+(runt [14 '-'] '|' ' ' -) - %+ turn (slag 1 lis) - |=(a=tape txt+(runt [14 ' '] '|' ' ' a)) - :: - ++ prompt - :: show prompt - :: - :: makes and stores a move to modify the cli - :: prompt to display the current audience. - :: - ::TODO take arg? - ^- move - %+ effect %pro - :+ & %talk-line - ^- tape - =- ?: =(1 (lent -)) "{-} " - "[{-}] " - :: %- zing - :: %+ join " " - :: ^- (list tape) - :: %+ turn ~(tap in audience) - :: |= =target - :: ^- tape - :: =+ gyf=(~(get by bound) target) - :: ?^ gyf ~[u.gyf] - ~(ar-prom ar audience) + :: +sole: apply sole action :: ++ sole - :: applies sole action. - :: |= act=sole-action:sole-sur ^- (quip move _this) ?- -.act $det (edit +.act) - $clr [~ this] :: (sh-pact ~) ::TODO clear to PM-to-self? + $clr [~ this] $ret obey == + :: +edit: apply sole edit + :: + :: called when typing into the cli prompt. + :: applies the change and does sanitizing. :: ++ edit - :: apply sole edit - :: - :: called when typing into the cli prompt. - :: applies the change and does sanitizing. - :: |= cal=sole-change:sole-sur ^- (quip move _this) =^ inv state.cli (~(transceive sole-lib state.cli) cal) @@ -306,131 +280,46 @@ ?. &(?=($del -.inv) =(+(p.inv) (lent buf.state.cli))) [~ this] (slug fix) + :: +sanity: check input sanity + :: + :: parses cli prompt using +read. + :: if invalid, produces error correction description, for use with +slug. + :: + ++ sanity + |= [inv=sole-edit:sole-sur buf=(list @c)] + ^- [lit=(list sole-edit:sole-sur) err=(unit @u)] + =+ res=(rose (tufa buf) read) + ?: ?=(%& -.res) [~ ~] + [[inv]~ `p.res] + :: +slug: apply error correction to prompt input + :: + ++ slug + |= [lit=(list sole-edit:sole-sur) err=(unit @u)] + ^- (quip move _this) + ?~ lit [~ this] + =^ lic state.cli + %- ~(transmit sole-lib state.cli) + ^- sole-edit:sole-sur + ?~(t.lit i.lit [%mor lit]) + :_ this + :_ ~ + %+ effect:sh-out %mor + :- [%det lic] + ?~(err ~ [%err u.err]~) + :: +read: command parser + :: + :: parses the command line buffer. + :: produces commands which can be executed by +work. :: ++ read - :: command parser - :: - :: parses the command line buffer. produces work - :: items which can be executed by ++sh-work. - :: - =< work - :: # %parsers - :: various parsers for command line input. - |% - ++ expr - :: [cord hoon] - |= tub/nail %. tub - %+ stag (crip q.tub) - wide:(vang & [&1:% &2:% (scot %da now.bowl) |3:%]) - :: - ++ dare - :: @dr - %+ sear - |= a/coin - ?. ?=({$$ $dr @} a) ~ - (some `@dr`+>.a) - nuck:so - :: - ++ ship ;~(pfix sig fed:ag) :: ship - ++ shiz :: ship set - %+ cook - |=(a/(list ^ship) (~(gas in *(set ^ship)) a)) - (most ;~(plug com (star ace)) ship) - :: - ++ path - ;~(pfix net (most net urs:ab)) - :: - ++ tarl :: local target - (stag our-self path) - :: - ++ tarp :: sponsor target - ;~(pfix ket (stag (sein:title our.bowl now.bowl our-self) path)) - :: - ++ targ :: target - ;~ pose - tarl - tarp - ;~(plug ship path) - (sear glyf glyph) - == - :: - ++ tars :: non-empty circles - %+ cook ~(gas in *(set target)) - %+ most ;~(plug com (star ace)) - ;~(pose targ (sear glyf glyph)) - :: - ++ drat - :: @da or @dr - :: - :: pas: whether @dr's are in the past or not. - |= pas/? - =- ;~(pfix sig (sear - crub:so)) - |= a/^dime - ^- (unit @da) - ?+ p.a ~ - $da `q.a - $dr :- ~ - %. [now.bowl q.a] - ?:(pas sub add) - == - :: - ++ tarz :: non-empty sources - %+ cook ~(gas in *(set target)) - (most ;~(plug com (star ace)) targ) - :: - ++ pick :: message reference - ;~(pose nump (cook lent (star mic))) - :: - ++ nump :: number reference - ;~ pose - ;~(pfix hep dem:ag) - ;~ plug - (cook lent (plus (just '0'))) - ;~(pose dem:ag (easy 0)) - == - (stag 0 dem:ag) - == - :: - ++ lobe :: y/n loob - ;~ pose - (cold %& ;~(pose (jest 'y') (jest '&') (just 'true'))) - (cold %| ;~(pose (jest 'n') (jest '|') (just 'false'))) - == - :: - ++ message :: exp, lin or url msg - ;~ pose - ;~(plug (cold %eval hax) expr) - (stag %say letters) - == - :: - ++ letters :: lin or url msgs - %+ most (jest '•') - ;~ pose - ::TODO (stag %url aurf:de-purl:html) - :(stag %text ;~(less mic hax text)) - == - :: - ++ text :: msg without break - %+ cook crip - (plus ;~(less (jest '•') next)) - :: - ++ nick (cook crip (plus next)) :: nickname - ++ glyph (mask glyphs) :: circle postfix - ++ setting :: setting flag - %- perk :~ - %notify - %showtime - == - ++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib - ++ work :: full input + |^ + ~! (scan "" (cmd %create [path ~] [glyph ~])) %+ knee *command |. ~+ =- ;~(pose ;~(pfix mic -) message) - ::TODO refactor the optional trailing args, glue junk ;~ pose (stag %target tars) :: ;~((glue ace) (tag %create) ;~(plug path (punt ;~(pfix ace glyph)))) - :: ;~((glue ace) (tag %join) ;~(plug targ (punt ;~(pfix ace glyph)))) ;~((glue ace) (tag %leave) targ) :: @@ -439,8 +328,8 @@ ;~(plug (perk %what ~) (punt ;~(pfix ace ;~(pose glyph targ)))) :: ;~(plug (tag %settings) (easy ~)) - ;~((glue ace) (tag %set) setting) - ;~((glue ace) (tag %unset) setting) + ;~((glue ace) (tag %set) flag) + ;~((glue ace) (tag %unset) flag) ;~(plug (cold %width (jest 'set width ')) dem:ag) ;~ plug (cold %timezone (jest 'set timezone ')) @@ -458,26 +347,124 @@ ;~(plug (tag %chats) (easy ~)) ;~(plug (tag %help) (easy ~)) :: - (stag %select pick) + (stag %select nump) == + :: + ::TODO + :: ++ cmd + :: |* [cmd=term req=(list rule) opt=(list rule)] + :: |^ ;~ plug + :: (tag cmd) + :: :: + :: ::TODO this feels slightly too dumb + :: ?~ req + :: ?~ opt (easy ~) + :: (opt-rules opt) + :: ?~ opt (req-rules req) + :: ;~(plug (req-rules req) (opt-rules opt)) ::TODO rest-loop + :: == + :: ++ req-rules + :: |* req=(lest rule) + :: =- ;~(pfix ace -) + :: ?~ t.req i.req + :: ;~(plug i.req $(req t.req)) + :: ++ opt-rules + :: |* opt=(lest rule) + :: =- (punt ;~(pfix ace -)) + :: ?~ t.opt ;~(pfix ace i.opt) + :: ;~(pfix ace ;~(plug i.opt $(opt t.opt))) + :: -- + :: + ++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib + ++ ship ;~(pfix sig fed:ag) + ++ path ;~(pfix net (most net urs:ab)) + :: +tarl: local target, as /path + :: + ++ tarl (stag our-self path) + :: +tarp: sponsor target, as ^/path + :: + ++ tarp + =- ;~(pfix ket (stag - path)) + (sein:title our.bowl now.bowl our-self) + :: +targ: any target, as tarl, tarp, ~ship/path or glyph + :: + ++ targ + ;~ pose + tarl + tarp + ;~(plug ship path) + (sear decode-glyph glyph) + == + :: +tars: set of comma-separated targs + :: + ++ tars + %+ cook ~(gas in *(set target)) + (most ;~(plug com (star ace)) targ) + :: +glyph: shorthand character + :: + ++ glyph (mask glyphs) + :: +flag: valid flag + :: + ++ flag + %- perk :~ + %notify + %showtime + == + :: +nump: message number reference + :: + ++ nump + ;~ pose + ;~(pfix hep dem:ag) + ;~ plug + (cook lent (plus (just '0'))) + ;~(pose dem:ag (easy 0)) + == + (stag 0 dem:ag) + (cook lent (star mic)) + == + :: +message: lin, url, or #exp message + :: + ++ message + ;~ pose + ;~(plug (cold %eval hax) expr) + (stag %say letters) + == + :: +letters: •-separated text or url messages + :: + ++ letters + %+ most (jest '•') + ;~ pose + ::TODO (stag %url aurf:de-purl:html) + :(stag %text ;~(less mic hax text)) + == + :: +text: text message body + :: + ++ text + %+ cook crip + (plus ;~(less (jest '•') next)) + :: +expr: parse expression into [cord hoon] + :: + ++ expr + |= tub=nail + %. tub + %+ stag (crip q.tub) + wide:(vang & [&1:% &2:% (scot %da now.bowl) |3:%]) -- + :: +obey: apply result + :: + :: called upon hitting return in the prompt. + :: if input is invalid, +slug is called. + :: otherwise, the appropriate work is done and + :: the command (if any) gets echoed to the user. :: ++ obey - :: apply result - :: - :: called upon hitting return in the prompt. if - :: input is invalid, ++sh-slug is called. - :: otherwise, the appropriate work is done and - :: the entered command (if any) gets displayed - :: to the user. - :: ^- (quip move _this) =+ buf=buf.state.cli =+ fix=(sanity [%nop ~] buf) ?^ lit.fix (slug fix) =+ jub=(rust (tufa buf) read) - ?~ jub [[(effect %bel ~) ~] this] + ?~ jub [[(effect:sh-out %bel ~) ~] this] =^ cal state.cli (~(transmit sole-lib state.cli) [%set ~]) =^ moves this (work u.jub) :_ this @@ -485,46 +472,41 @@ ^- (list move) :: echo commands into scrollback ?. =(`0 (find ";" buf)) ~ - [(note (tufa `(list @)`buf)) ~] + [(note:sh-out (tufa `(list @)`buf)) ~] :_ moves - %+ effect %mor + %+ effect:sh-out %mor :~ [%nex ~] [%det cal] == + :: +work: run user command :: ++ work - :: do work - :: - :: implements worker arms for different talk - :: commands. - :: worker arms must produce updated state. - :: |= job=command ^- (quip move _this) - |^ ?- -.job ::~|([%unimplemented -.job] !!) - %target (set-target +.job) + |^ ?- -.job + %target (set-target +.job) + %say (say +.job) + %eval (eval +.job) :: - %join (join +.job) - %leave (leave +.job) - %create (create +.job) + %join (join +.job) + %leave (leave +.job) + %create (create +.job) :: - %say (say +.job) - %eval (eval +.job) - :: - %bind (bind-glyph +.job) - %unbind (unbind-glyph +.job) - %what (lookup-glyph +.job) + %bind (bind-glyph +.job) + %unbind (unbind-glyph +.job) + %what (lookup-glyph +.job) :: %settings show-settings - %set (set-setting +.job) - %unset (unset-setting +.job) - %width (set-width +.job) + %set (set-setting +.job) + %unset (unset-setting +.job) + %width (set-width +.job) %timezone (set-timezone +.job) :: - %select (select +.job) - %chats chats - %help help + %select (select +.job) + %chats chats + %help help == + :: +act: build action move :: ++ act |= [what=term app=term =out-action] @@ -535,12 +517,14 @@ [our-self app] out-action == + :: +set-target: set audience, update prompt :: ++ set-target |= tars=(set target) ^- (quip move _this) =. audience tars - [[prompt ~] this] + [[prompt:sh-out ~] this] + :: +create: new local mailbox :: ++ create ::TODO configurable security @@ -555,6 +539,7 @@ %^ act %do-create %chat-view :- %chat-view-action [%create path %channel ~ ~] + :: +join: sync with remote mailbox :: ++ join |= [=target gyf=(unit char)] @@ -566,6 +551,7 @@ %^ act %do-join %chat-hook :- %chat-hook-action [%add-synced target] + :: +leave: unsync & destroy mailbox :: ::TODO but if we leave our own circle, then it disappears for everyone? ++ leave @@ -574,6 +560,7 @@ %^ act %do-leave %chat-hook :- %chat-hook-action [%remove (target-to-path target)] + :: +say: send messages :: ++ say |= letters=(list letter) @@ -581,7 +568,6 @@ =/ =serial (shaf %msg-uid eny.bowl) :_ this(eny.bowl (shax eny.bowl)) ^- (list move) - ::TODO wait, so, is host irrelevant in target? only for joins? %+ turn ~(tap in audience) |= =target %^ act %out-message %chat-hook @@ -593,18 +579,12 @@ now.bowl (snag 0 letters) ::TODO support multiple == + :: +eval: run hoon, send code and result as message + :: + :: this double-virtualizes and clams to disable .^ for security reasons :: ++ eval - :: run - :: - :: executes {exe} and sends both its code and - :: result. - :: |= [txt=cord exe=hoon] - :: XX revisit - :: - :: this double-virtualizes and clams to disable .^ - :: =; tan=(list tank) (say [%code txt tan] ~) ;; (list tank) @@ -615,125 +595,131 @@ ^- [our=@p now=@da eny=@uvI] [our-self now.bowl (shas %eny eny.bowl)] |=(^ ~) + :: +lookup-glyph: print glyph info for all, glyph or target :: ++ lookup-glyph - ::TODO we probably want a function for the (list tape) -> %mor %txt case |= qur=(unit $@(glyph target)) ^- (quip move _this) =- [[- ~] this] ?^ qur ?^ u.qur =+ gyf=(~(get by bound) u.qur) - (print ?~(gyf "none" [u.gyf]~)) + (print:sh-out ?~(gyf "none" [u.gyf]~)) =+ pan=~(tap in (~(get ju binds) `@t`u.qur)) - ?: =(~ pan) (print "~") - =< (effect %mor (turn pan .)) - |=(t=target [%txt ~(cr-phat cr t)]) - %+ effect %mor + ?: =(~ pan) (print:sh-out "~") + =< (effect:sh-out %mor (turn pan .)) + |=(t=target [%txt ~(phat tr t)]) + %- print-more:sh-out %- ~(rep by binds) |= $: [=glyph tars=(set target)] - lis=(list sole-effect:sole-sur) + lis=(list tape) == %+ weld lis - ^- (list sole-effect:sole-sur) + ^- (list tape) %- ~(rep in tars) - |= [t=target l=(list sole-effect:sole-sur)] + |= [t=target l=(list tape)] %+ weld l - ^- (list sole-effect:sole-sur) - [%txt glyph ' ' ~(cr-phat cr t)]~ + ^- (list tape) + [glyph ' ' ~(phat tr t)]~ + :: +show-settings: print enabled flags, timezone and width settings :: ++ show-settings ^- (quip move _this) :_ this - :~ %- print + :~ %- print:sh-out %- zing ^- (list tape) :- "flags: " %+ ^join ", " (turn `(list @t)`~(tap in settings) trip) :: - %- print + %- print:sh-out %+ weld "timezone: " ^- tape :- ?:(p.timez '+' '-') (scow %ud q.timez) :: - (print "width: {(scow %ud width)}") + (print:sh-out "width: {(scow %ud width)}") == + :: +set-setting: enable settings flag :: ++ set-setting |= =term ^- (quip move _this) [~ this(settings (~(put in settings) term))] + :: +unset-setting: disable settings flag :: ++ unset-setting |= =term ^- (quip move _this) [~ this(settings (~(del in settings) term))] + :: +set-width: configure cli printing width :: ++ set-width |= w=@ud [~ this(width w)] + :: +set-timezone: configure timestamp printing adjustment :: ++ set-timezone |= tz=[? @ud] [~ this(timez tz)] + :: +select: expand message from number reference :: ++ select - :: finds selected message, expand it. + ::NOTE rel is the nth most recent message, + :: abs is the last message whose numbers ends in n + :: (with leading zeros used for precision) :: - ::TODO this either needs a different implementation or extensive comments - |= num=$@(@ud [p=@u q=@ud]) + |= num=$@(rel=@ud [zeros=@u abs=@ud]) ^- (quip move _this) |^ ?@ num =+ tum=(scow %s (new:si | +(num))) - ?: (gte num count) + ?: (gte rel.num count) %- just-print "{tum}: no such telegram" - (activate tum num) - ?. (gte q.num count) + (activate tum rel.num) + ?. (gte abs.num count) ?: =(count 0) (just-print "0: no messages") - =+ msg=(deli (dec count) num) + =+ msg=(index (dec count) num) (activate (scow %ud msg) (sub count +(msg))) %- just-print - "…{(reap p.num '0')}{(scow %ud q.num)}: no such telegram" + "…{(reap zeros.num '0')}{(scow %ud abs.num)}: no such telegram" + :: +just-print: full [moves state] output with a single print move :: ++ just-print |= txt=tape - [[(print txt) ~] this] + [[(print:sh-out txt) ~] this] + :: +index: get message index from absolute reference :: - ++ deli - :: gets absolute message number from relative. - :: + ++ index |= [max=@ud nul=@u fin=@ud] ^- @ud =+ dog=|-(?:(=(0 fin) 1 (mul 10 $(fin (div fin 10))))) =. dog (mul dog (pow 10 nul)) =- ?:((lte - max) - (sub - dog)) (add fin (sub max (mod max dog))) + :: +activate: echo message selector and print details :: ++ activate - :: prints message details. - :: |= [number=tape index=@ud] ^- (quip move _this) =+ gam=(snag index grams) - =+ tay=~(. tr settings gam) =. audience [source.gam ~ ~] :_ this ^- (list move) - :~ (print ['?' ' ' number]) - (effect tr-fact:tay) - prompt + :~ (print:sh-out ['?' ' ' number]) + (effect:sh-out ~(render-activate mr gam)) + prompt:sh-out == -- + :: +chats: display list of local mailboxes :: ++ chats ^- (quip move _this) :_ this :_ ~ - %+ effect %mor + %- print-more:sh-out =/ all ::TODO refactor ::TODO remote scries fail... but moon support? @@ -744,66 +730,78 @@ %+ turn ~(tap in all) %+ cork path-to-target |= target - :- %txt (weld (scow %p ship) (spud path)) + :: +help: print (link to) usage instructions :: ++ help ^- (quip move _this) =- [[- ~] this] - (print "see https://urbit.org/docs/using/messaging/") + (print:sh-out "see https://urbit.org/docs/using/messaging/") -- + -- +:: +:: +sh-out: output to the cli +:: +++ sh-out + |% + :: +effect: console effect move :: - ++ sanity - :: check input sanity - :: - :: parses cli prompt input using ++read and - :: describes error correction when invalid. - :: - |= [inv=sole-edit:sole-sur buf=(list @c)] - ^- [lit=(list sole-edit:sole-sur) err=(unit @u)] - =+ res=(rose (tufa buf) read) - ?: ?=(%& -.res) [~ ~] - [[inv]~ `p.res] + ++ effect + |= fec=sole-effect:sole-sur + ^- move + [bone.cli %diff %sole-effect fec] + :: +print: puts some text into the cli as-is :: - ++ slug - :: apply error correction to prompt input - :: - |= [lit=(list sole-edit:sole-sur) err=(unit @u)] - ^- (quip move _this) - ?~ lit [~ this] - =^ lic state.cli - %- ~(transmit sole-lib state.cli) - ^- sole-edit:sole-sur - ?~(t.lit i.lit [%mor lit]) - :_ this - :_ ~ + ++ print + |= txt=tape + ^- move + (effect %txt txt) + :: +print-more: puts lines of text into the cli + :: + ++ print-more + |= txs=(list tape) + ^- move %+ effect %mor - :- [%det lic] - ?~(err ~ [%err u.err]~) + (turn txs |=(t=tape [%txt t])) + :: +note: prints left-padded ---| txt :: - ++ glyf - :: decode glyph - :: - :: finds the circle(s) that match a glyph. - :: - |= cha=char - ^- (unit target) - =+ lax=(~(get ju binds) cha) - :: no circle. - ?: =(~ lax) ~ - :: single circle. - ?: ?=([* ~ ~] lax) `n.lax - :: in case of multiple audiences, pick the most recently active one. - |- ^- (unit target) - ~& %multi-bind-support-missing - ?~ grams ~ - ~ - ::TODO - :: =+ pan=(silt ~(tap in aud.i.grams)) - :: ?: (~(has in lax) pan) `pan - :: $(grams t.grams) + ++ note + |= txt=tape + ^- move + =+ lis=(simple-wrap txt (sub width 16)) + %- print-more + =+ ?:((gth (lent lis) 0) (snag 0 lis) "") + :- (runt [14 '-'] '|' ' ' -) + %+ turn (slag 1 lis) + |=(a=tape (runt [14 ' '] '|' ' ' a)) + :: +prompt: update prompt to display current audience :: - ++ print-envelope + ++ prompt + ^- move + %+ effect %pro + :+ & %talk-line + ^- tape + =- ?: =(1 (lent -)) "{-} " + "[{-}] " + =/ all + %+ sort ~(tap in audience) + |= [a=target b=target] + (~(beat tr a) b) + =+ fir=& + |- ^- tape + ?~ all ~ + ;: welp + ?:(fir "" " ") + ~(show tr i.all) + $(all t.all, fir |) + == + :: +show-envelope: print incoming message + :: + :: every five messages, prints the message number also. + :: if the message mentions the user's (shortened) ship name, + :: and the %notify flag is set, emit a bell. + :: + ++ show-envelope |= [=target =envelope] ^- (list move) %+ weld @@ -813,8 +811,7 @@ =+ num=(scow %ud count) %- print (runt [(sub 13 (lent num)) '-'] "[{num}]") - ::TODO %notify logic? or do elsewhere? just check the %text msgs - =+ lis=~(render tr settings target envelope) + =+ lis=~(render-inline mr target envelope) ?~ lis ~ :_ ~ %+ effect %mor @@ -826,16 +823,19 @@ == [%txt t] [%mor [%txt t] [%bel ~] ~] + :: +show-create: print mailbox creation notification :: ++ show-create |= =target ^- move - (note "new: {~(cr-phat cr target)}") + (note "new: {~(phat tr target)}") + :: +show-delete: print mailbox deletion notification :: ++ show-delete |= =target ^- move - (note "del: {~(cr-phat cr target)}") + (note "del: {~(phat tr target)}") + :: +show-glyph: print glyph un/bind notification :: ++ show-glyph |= [=glyph target=(unit target)] @@ -844,99 +844,18 @@ %- note %+ weld "set: {[glyph ~]} -> " ?~ target "nothing" - ~(cr-phat cr u.target) + ~(phat tr u.target) -- :: +:: +tr: render targets :: -::TODO code style -++ ar - :: audience renderer - :: - :: used for representing audiences (sets of circles) - :: as tapes. - :: - |_ :: aud: members of the audience. - :: - aud=(set target) - :: - ++ ar-best - :: find the most relevant circle in the set. - :: - ^- (unit target) - ?~ aud ~ - :- ~ - |- ^- target - =+ lef=`(unit target)`ar-best(aud l.aud) - =+ rit=`(unit target)`ar-best(aud r.aud) - =? n.aud ?=(^ lef) (~(cr-best cr n.aud) u.lef) - =? n.aud ?=(^ rit) (~(cr-best cr n.aud) u.rit) - n.aud - :: - ++ ar-deaf - :: remove ourselves from the audience. - :: - ^+ . - .(aud (~(del in aud) [our-self /inbox])) - :: - ++ ar-maud - :: multiple audience - :: - :: checks if there's multiple circles in the - :: audience via pattern matching. - :: - ^- ? - =. . ar-deaf - !?=($@(~ {* ~ ~}) aud) - :: - ++ ar-phat - :: render all circles, no glyphs. - :: - ^- tape - %- ~(rep in aud) - |= {c/target t/tape} - =? t ?=(^ t) - (weld t ", ") - (weld t ~(cr-phat cr c)) - :: - ++ ar-prom - :: render all circles, ordered by relevance. - :: - ^- tape - =. . ar-deaf - =/ all - %+ sort `(list target)`~(tap in aud) - |= {a/target b/target} - (~(cr-beat cr a) b) - =+ fir=& - |- ^- tape - ?~ all ~ - ;: welp - ?:(fir "" " ") - (~(cr-show cr i.all) ~) - $(all t.all, fir |) - == - :: - ++ ar-whom - :: render sender as the most relevant circle. - :: - (~(cr-show cr (need ar-best)) ~ ar-maud) - -- -:: -++ cr - :: target renderer - :: - :: used in both target and ship rendering. - :: +++ tr |_ :: one: the target. :: one=target + :: +beat: true if one is more "relevant" than two :: - ++ cr-beat - :: {one} more relevant? - :: - :: returns true if one is better to show, false - :: otherwise. prioritizes: our > main > size. - :: + ++ beat |= two=target ^- ? :: the target that's ours is better. @@ -955,126 +874,94 @@ (lth (lent path.one) (lent path.two)) :: if they're from different ships, neither ours, pick hierarchically. (lth (xeb ship.one) (xeb ship.two)) + :: +phat: render target fully :: - ++ cr-best - :: returns the most relevant target. - :: - |= two=target - ?:((cr-beat two) one two) + :: renders as ~ship/path. + :: for local mailboxes, renders just /path. + :: for sponsor's mailboxes, renders ^/path. :: - ++ cr-curt - :: prints a ship name in 14 characters. - :: - :: left-pads with spaces. {mup} signifies - :: "are there other targets besides this one?" - :: - |= mup=? - ^- tape - =+ raw=(cite:title ship.one) - (runt [(sub 14 (lent raw)) ' '] raw) + ::NOTE but, given current implementation, all will be local :: - ++ cr-nick - :: get nick for ship, or shortname if no nick. - :: - :: left-pads with spaces. - :: - |= source=target - ::TODO get nick from contacts store? - (cr-curt |) - :: - ++ cr-phat ::: render accurately - :: prints a target fully as ~ship/path. - :: for local targets, print as /path. - :: for targets on our sponsor, ^/path. - :: + ++ phat ^- tape %+ weld ?: =(our-self ship.one) ~ ?: =((sein:title our.bowl now.bowl our-self) ship.one) "^" (scow %p ship.one) (spud path.one) + :: +show: render as tape, as glyph if we can :: - ++ cr-full (cr-show ~) :: render full width - :: - ++ cr-show - :: renders a target as text. - :: - :: moy: multiple targets in audience? - |= moy=(unit ?) + ++ show ^- tape - :: render target (as glyph if we can). - ?~ moy - =+ cha=(~(get by bound) one) - =- ?~(cha - "{u.cha ~}") - ~(cr-phat cr one) - (~(cr-curt cr one) u.moy) + =+ cha=(~(get by bound) one) + ?~(cha phat "{u.cha ~}") + :: +glyph: tape for glyph of target, defaulting to * :: - ++ cr-dire - :: returns true if circle is a mailbox of ours. - :: - |= cir=target ^- ? - ?& =(ship.cir our-self) - ::TODO permissions check - == - :: - ++ cr-glyph - :: target glyph - :: - :: get the glyph that corresponds to the target. - :: for mailboxes and complex audiences, use - :: reserved "glyphs". - :: + ++ glyph ^- tape - =+ gyf=(~(get by bound) one) - ?^ gyf ~[u.gyf] - ?. (cr-dire one) - "*" - ":" + [(~(gut by bound) one '*') ~] -- :: -++ tr - :: telegram renderer - :: - :: responsible for converting telegrams and - :: everything relating to them to text to be - :: displayed in the cli. - :: - |_ $: settings=(set term) - source=target +:: +mr: render messages +:: +++ mr + |_ $: source=target envelope == + :: +activate: produce sole-effect for printing message details :: - ++ tr-fact - :: activate effect - :: - :: produces sole-effect for printing message - :: details. - :: + ++ render-activate ^- sole-effect:sole-sur - ~[%mor [%tan tr-meta] tr-body] + ~[%mor [%tan meta] body] + :: +meta: render message metadata (serial, timestamp, author, target) :: - ++ render - :: renders a telegram + ++ meta + ^- tang + =. when (sub when (mod when (div when ~s0..0001))) :: round + =+ hed=leaf+"{(scow %uv uid)} at {(scow %da when)}" + =/ src=tape ~(phat tr source) + [%rose [" " ~ ~] [hed >author< [%rose [", " "to " ~] [leaf+src]~] ~]]~ + :: +body: long-form render of message contents + :: + ++ body + |- ^- sole-effect:sole-sur + ?- -.letter + %text + tan+~[leaf+"{(trip text.letter)}"] :: - :: the first line will contain the author and - :: optional timestamp. + %url + url+url.letter :: + %code + =/ texp=tape ['>' ' ' (trip expression.letter)] + :- %mor + |- ^- (list sole-effect:sole-sur) + ?: =("" texp) [tan+output.letter ~] + =/ newl (find "\0a" texp) + ?~ newl [txt+texp $(texp "")] + =+ (trim u.newl texp) + :- txt+(scag u.newl texp) + $(texp [' ' ' ' (slag +(u.newl) texp)]) + == + :: +render-inline: produces lines to display message body in scrollback + :: + ++ render-inline ^- (list tape) =/ wyd - %+ sub width :: termwidth, - %+ add 14 :: minus author, - ?:((~(has in settings) %showtime) 10 0) :: minus timestamp. - =+ txs=(tr-text wyd) + :: termwidth, + %+ sub width + :: minus autor, + %+ add 14 + :: minus timestamp. + ?:((~(has in settings) %showtime) 10 0) + =+ txs=(line wyd) ?~ txs ~ - :: render the author. - =/ nom=tape - ?: (~(has in settings) %nicks) - (~(cr-nick cr [author /inbox]) source) - (~(cr-curt cr [author /inbox]) |) - :: regular indent. - =/ den=tape - (reap (lent nom) ' ') - :: timestamp, if desired. + :: nom: rendered author + :: den: regular indent + :: tam: timestamp, if desired + :: + =/ nom=tape (nome author) + =/ den=tape (reap (lent nom) ' ') =/ tam=tape ?. (~(has in settings) %showtime) "" =. when @@ -1100,76 +987,19 @@ |= [t=tape l=(list tape)] ?~ l [:(weld nom t tam) ~] [(weld den t) l] + :: +nome: prints a ship name in 14 characters, left-padding with spaces :: - ++ tr-meta - :: metadata - :: - :: builds string that display metadata, including - :: message serial, timestamp, author and audience. - :: - ^- tang - =. when (sub when (mod when (div when ~s0..0001))) :: round - =+ hed=leaf+"{(scow %uv uid)} at {(scow %da when)}" - =/ src=tape ~(cr-phat cr source) - [%rose [" " ~ ~] [hed >author< [%rose [", " "to " ~] [leaf+src]~] ~]]~ - :: - ++ tr-body - :: message content - :: - :: long-form display of message contents, specific - :: to each speech type. - :: - |- ^- sole-effect:sole-sur - ?- -.letter - %text - tan+~[leaf+"{(trip text.letter)}"] - :: - %url - url+url.letter - :: - %code - =/ texp=tape ['>' ' ' (trip expression.letter)] - :- %mor - |- ^- (list sole-effect:sole-sur) - ?: =("" texp) [tan+output.letter ~] - =/ newl (find "\0a" texp) - ?~ newl [txt+texp $(texp "")] - =+ (trim u.newl texp) - :- txt+(scag u.newl texp) - $(texp [' ' ' ' (slag +(u.newl) texp)]) - == - :: - ++ tr-chow - :: truncate - :: - :: truncates the {txt} to be of max {len} - :: characters. if it does truncate, indicates it - :: did so by appending _ or …. - :: - |= [len=@u txt=tape] + ++ nome + |= =ship ^- tape - ?: (gth len (lent txt)) txt - =. txt (scag len txt) - |- - ?~ txt txt - ?: =(' ' i.txt) - |- - :- '_' - ?. ?=({$' ' *} t.txt) - t.txt - $(txt t.txt) - ?~ t.txt "…" - [i.txt $(txt t.txt)] + =+ raw=(cite:title ship) + (runt [(sub 14 (lent raw)) ' '] raw) + :: +line: renders most important contents, tries to fit one line :: - ++ tr-text - :: compact contents - :: - :: renders just the most important data of the - :: message. if possible, these stay within a single - :: line. - :: + ::TODO this should probably be rewritten someday + ++ line :: pre: replace/append line prefix - ::TODO this should probably be redone someday. + :: =| pre=(unit (pair ? tape)) |= wyd=@ud ^- (list tape) @@ -1179,9 +1009,9 @@ =+ newline=(find "\0a" texp) =? texp ?=(^ newline) (weld (scag u.newline texp) " ...") - :- (tr-chow wyd '#' ' ' texp) + :- (truncate wyd '#' ' ' texp) ?~ output.letter ~ - =- [' ' (tr-chow (dec wyd) ' ' -)]~ + =- [' ' (truncate (dec wyd) ' ' -)]~ ~(ram re (snag 0 `(list tank)`output.letter)) :: %url @@ -1213,7 +1043,7 @@ =/ pef=tape ?: &(?=(^ pre) p.u.pre) q.u.pre =- (weld - q:(fall pre [p=| q=" "])) - ~(cr-glyph cr source) + ~(glyph tr source) =/ lis=(list tape) %+ simple-wrap `tape``(list @)`(tuba (trip text.letter)) @@ -1224,17 +1054,34 @@ %+ turn (slag 1 lis) |=(a=tape (runt [lef ' '] a)) == + :: +truncate: truncate txt to fit len, indicating truncation with _ or … + :: + ++ truncate + |= [len=@u txt=tape] + ^- tape + ?: (gth len (lent txt)) txt + =. txt (scag len txt) + |- + ?~ txt txt + ?: =(' ' i.txt) + |- + :- '_' + ?. ?=([%' ' *] t.txt) + t.txt + $(txt t.txt) + ?~ t.txt "…" + [i.txt $(txt t.txt)] -- :: ++ simple-wrap - |= {txt/tape wyd/@ud} + |= [txt=tape wid=@ud] ^- (list tape) ?~ txt ~ - =+ ^- {end/@ud nex/?} - ?: (lte (lent txt) wyd) [(lent txt) &] - =+ ace=(find " " (flop (scag +(wyd) `tape`txt))) - ?~ ace [wyd |] - [(sub wyd u.ace) &] + =+ ^- [end=@ud nex=?] + ?: (lte (lent txt) wid) [(lent txt) &] + =+ ace=(find " " (flop (scag +(wid) `tape`txt))) + ?~ ace [wid |] + [(sub wid u.ace) &] :- (tufa (scag end `(list @)`txt)) $(txt (slag ?:(nex +(end) end) `tape`txt)) -- \ No newline at end of file From 03b5a1cd719ce957dac04213d98a8ea4d2110583 Mon Sep 17 00:00:00 2001 From: Fang Date: Mon, 7 Oct 2019 20:45:58 +0200 Subject: [PATCH 04/16] chat-cli: Support %url and %me message types --- pkg/arvo/app/chat-cli.hoon | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index b94686e756..9af8fcd9f0 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -434,9 +434,17 @@ ++ letters %+ most (jest '•') ;~ pose - ::TODO (stag %url aurf:de-purl:html) + (stag %url turl) + :(stag %me ;~(pfix vat text)) :(stag %text ;~(less mic hax text)) == + :: +turl: url parser + :: + ++ turl + =- (sear - text) + |= t=cord + ^- (unit cord) + ?~((rush t aurf:de-purl:html) ~ `t) :: +text: text message body :: ++ text @@ -926,8 +934,9 @@ ++ body |- ^- sole-effect:sole-sur ?- -.letter - %text - tan+~[leaf+"{(trip text.letter)}"] + ?(%text %me) + =/ pre=tape ?:(?=(%me -.letter) "@ " "") + tan+~[leaf+"{pre}{(trip +.letter)}"] :: %url url+url.letter @@ -1027,8 +1036,9 @@ ?: (gte wyd (lent ful)) :(weld pef " " ful) :: if it doesn't, prefix with _ and render just (the tail of) the domain. %+ weld (weld pef "_") - ::TODO need kinda dangerous... - =+ hok=r.p:(need (de-purl:html url.letter)) + =+ prl=(rust ful aurf:de-purl:html) + ?~ prl (weld (scag (dec wyd) ful) "…") + =+ hok=r.p.p.u.prl =- (swag [a=(sub (max wyd (lent -)) wyd) b=wyd] -) ^- tape =< ?: ?=(%& -.hok) @@ -1038,15 +1048,16 @@ ?~ b (trip a) (welp b '.' (trip a)) :: - %text + ?(%text %me) :: glyph prefix =/ pef=tape ?: &(?=(^ pre) p.u.pre) q.u.pre + ?: ?=(%me -.letter) " " =- (weld - q:(fall pre [p=| q=" "])) ~(glyph tr source) =/ lis=(list tape) %+ simple-wrap - `tape``(list @)`(tuba (trip text.letter)) + `tape``(list @)`(tuba (trip +.letter)) (sub wyd (min (div wyd 2) (lent pef))) =+ lef=(lent pef) =+ ?:((gth (lent lis) 0) (snag 0 lis) "") From 12050d44a827c0b6bca36f4547536ce39d3b3ba7 Mon Sep 17 00:00:00 2001 From: Fang Date: Mon, 7 Oct 2019 20:46:35 +0200 Subject: [PATCH 05/16] chat-cli: Add debug poke for connecting to store --- pkg/arvo/app/chat-cli.hoon | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index 9af8fcd9f0..681d810b5b 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -80,12 +80,17 @@ ~& %chat-cli-prep ?^ old [~ this(+<+ u.old)] - :- [ost.bowl %peer /chat-store [our-self %chat-store] /all]~ + :- [connect ~] %_ this audience [[our-self /] ~ ~] settings (sy %showtime %notify ~) width 80 == +:: +connect: connect to the chat-store +:: +++ connect + ^- move + [ost.bowl %peer /chat-store [our-self %chat-store] /all] :: +true-self: moons to planets :: ++ true-self @@ -112,6 +117,14 @@ =+ who=(slaw %p i.path) ?~ who [our-self path] [u.who path] +:: +poke-noun: debug helpers +:: +++ poke-noun + |= a=* + ^- (quip move _this) + ?: ?=(%connect a) + [[connect ~] this] + [~ this] :: +poke-sole-action: handle cli input :: ++ poke-sole-action From 10b17ff1270e4b1b98e7fc4309b84631ebf32f7f Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 16:15:19 +0200 Subject: [PATCH 06/16] chat-cli: Update prompt on-create Creating a mailbox would refresh the prompt before setting a new audience, instead of after. This change corrects the behavior. Also updates glyph binding code and print style. --- pkg/arvo/app/chat-cli.hoon | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index 681d810b5b..c76833f60d 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -553,10 +553,11 @@ ^- (quip move _this) ::TODO check if already exists =/ =target [our-self path] + =. audience [target ~ ~] =^ moz this ?. ?=(^ gyf) [~ this] (bind-glyph u.gyf target) - =- [[- moz] this(audience [target ~ ~])] + =- [[- moz] this] %^ act %do-create %chat-view :- %chat-view-action [%create path %channel ~ ~] @@ -861,9 +862,9 @@ ++ show-glyph |= [=glyph target=(unit target)] ^- (list move) - =- [prompt - ~] + :_ [prompt ~] %- note - %+ weld "set: {[glyph ~]} -> " + %+ weld "set: {[glyph ~]} " ?~ target "nothing" ~(phat tr u.target) -- From 9c562f4c62a152a1a3f66f18045826135227394d Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 16:18:20 +0200 Subject: [PATCH 07/16] chat-cli: Match store and hook's path handling Now prefixes the host ship to the path, and parses it back out, only when appropriate. --- pkg/arvo/app/chat-cli.hoon | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index c76833f60d..6617ecb3c4 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -103,9 +103,7 @@ :: ++ target-to-path |= target - path - ::TODO - :: [(scot %p ship) path] + [(scot %p ship) path] :: +path-to-target: deduces a target from a mailbox path :: ++ path-to-target @@ -116,7 +114,7 @@ [our-self path] =+ who=(slaw %p i.path) ?~ who [our-self path] - [u.who path] + [u.who t.path] :: +poke-noun: debug helpers :: ++ poke-noun @@ -170,7 +168,7 @@ |= [=wire upd=chat-update] ^- (quip move _this) ?+ -.upd [~ this] - %create (notice-create (path-to-target path.upd)) + %create (notice-create +.upd) %delete [[(show-delete:sh-out (path-to-target path.upd)) ~] this] %message (read-envelope (path-to-target path.upd) envelope.upd) == From dac51a9ed8c8732a9dea2fdb15b6cfe8d82529b3 Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 19:26:30 +0200 Subject: [PATCH 08/16] chat-cli: Implement permission management Set security type during ;create. Use ;invite and ;banish to dis/allow ships from reading and/or writing. Talks to the group-store to modify permission groups. Scries into permission-store to check for white- vs blacklist. --- pkg/arvo/app/chat-cli.hoon | 100 +++++++++++++++++++++++++++++++++---- 1 file changed, 91 insertions(+), 9 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index 6617ecb3c4..f596d999ae 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -9,7 +9,9 @@ :: we concat the ship onto the head of the path, :: and trust it to take care of the rest. :: -/- sole-sur=sole, *chat-store, *chat-view, *chat-hook +/- *chat-store, *chat-view, *chat-hook, + *permission-store, *group-store, + sole-sur=sole /+ sole-lib=sole /= seed /~ !>(.) :: @@ -38,8 +40,11 @@ [%say (list letter)] :: send message [%eval cord hoon] :: send #-message :: - [%create path =(unit glyph)] :: create chat - [%join target =(unit glyph)] :: join target + [%create chat-security path (unit glyph)] :: create chat + [%invite ?(%r %w %rw) path (set ship)] :: allow + [%banish ?(%r %w %rw) path (set ship)] :: disallow + :: + [%join target (unit glyph)] :: join target [%leave target] :: nuke target :: [%bind glyph target] :: bind glyph @@ -68,6 +73,7 @@ $% [%chat-action chat-action] [%chat-view-action chat-view-action] [%chat-hook-action chat-hook-action] + [%group-action group-action] == -- :: @@ -324,13 +330,19 @@ :: ++ read |^ - ~! (scan "" (cmd %create [path ~] [glyph ~])) %+ knee *command |. ~+ =- ;~(pose ;~(pfix mic -) message) ;~ pose (stag %target tars) :: - ;~((glue ace) (tag %create) ;~(plug path (punt ;~(pfix ace glyph)))) + ;~ (glue ace) + (tag %create) + security + ;~(plug path (punt ;~(pfix ace glyph))) + == + ;~((glue ace) (perk %invite ~) rw path ships) + ;~((glue ace) (perk %banish ~) rw path ships) + :: ;~((glue ace) (tag %join) ;~(plug targ (punt ;~(pfix ace glyph)))) ;~((glue ace) (tag %leave) targ) :: @@ -411,6 +423,21 @@ ++ tars %+ cook ~(gas in *(set target)) (most ;~(plug com (star ace)) targ) + :: +ships: set of comma-separated ships + :: + ++ ships + %+ cook ~(gas in *(set ^ship)) + (most ;~(plug com (star ace)) ship) + :: + :: +security: security mode + :: + ++ security + (perk %channel %village %journal %mailbox ~) + :: +rw: read, write, or read-write + :: + ++ rw + (perk %rw %r %w ~) + :: :: +glyph: shorthand character :: ++ glyph (mask glyphs) @@ -506,10 +533,13 @@ %target (set-target +.job) %say (say +.job) %eval (eval +.job) + :: + %create (create +.job) + %invite (change-permission & +.job) + %banish (change-permission | +.job) :: %join (join +.job) %leave (leave +.job) - %create (create +.job) :: %bind (bind-glyph +.job) %unbind (unbind-glyph +.job) @@ -546,8 +576,7 @@ :: +create: new local mailbox :: ++ create - ::TODO configurable security - |= [=path gyf=(unit char)] + |= [security=chat-security =path gyf=(unit char)] ^- (quip move _this) ::TODO check if already exists =/ =target [our-self path] @@ -558,7 +587,58 @@ =- [[- moz] this] %^ act %do-create %chat-view :- %chat-view-action - [%create path %channel ~ ~] + :^ %create path security + :: ensure we can read from/write to our own chats + :: + :- :: read + ?- security + ?(%channel %journal) ~ + ?(%village %mailbox) [our-self ~ ~] + == + :: write + ?- security + ?(%channel %mailbox) ~ + ?(%village %journal) [our-self ~ ~] + == + :: +change-permission: modify permissions on a local chat + :: + ++ change-permission + |= [allow=? rw=?(%r %w %rw) =path ships=(set ship)] + ^- (quip move _this) + :_ this + %+ murn + ^- (list term) + ?- rw + %r [%read ~] + %w [%write ~] + %rw [%read %write ~] + == + |= =term + ^- (unit move) + =. path + =- (snoc `^path`- term) + [%chat (target-to-path our-self path)] + =/ whitelist=(unit ?) + =- ?~(- ~ `?=(%white kind.u)) + ::TODO +permission-of-target? + .^ (unit permission) + %gx + (scot %p our-self) + %permission-store + (scot %da now.bowl) + %permission + (snoc path %noun) + == + ?~ whitelist + ~& [%weird-no-permission path] + ~ + %- some + %^ act %do-permission %group-store + ^- out-action + :- %group-action + ?: =(u.whitelist allow) + [%add ships path] + [%remove ships path] :: +join: sync with remote mailbox :: ++ join @@ -568,6 +648,8 @@ ?. ?=(^ gyf) [~ this] (bind-glyph u.gyf target) =- [[- moz] this(audience [target ~ ~])] + ::TODO ideally we'd check permission first. attempting this and failing + :: gives ugly %chat-hook-reap %^ act %do-join %chat-hook :- %chat-hook-action [%add-synced target] From c7fbad61ee84797924bfcdfe300c165f93bc68fc Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 19:54:26 +0200 Subject: [PATCH 09/16] chat-cli: Simplify message command type & logic MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit By dropping support for •-separated multi-messaging, we can simplify the parsing and handling of message sending inputs. --- pkg/arvo/app/chat-cli.hoon | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index f596d999ae..f6441aeb8f 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -37,7 +37,7 @@ :: +$ command $% [%target (set target)] :: set messaging target - [%say (list letter)] :: send message + [%say letter] :: send message [%eval cord hoon] :: send #-message :: [%create chat-security path (unit glyph)] :: create chat @@ -460,17 +460,16 @@ (stag 0 dem:ag) (cook lent (star mic)) == - :: +message: lin, url, or #exp message + :: +message: all messages :: ++ message ;~ pose ;~(plug (cold %eval hax) expr) - (stag %say letters) + (stag %say letter) == - :: +letters: •-separated text or url messages + :: +letter: simple messages :: - ++ letters - %+ most (jest '•') + ++ letter ;~ pose (stag %url turl) :(stag %me ;~(pfix vat text)) @@ -665,7 +664,7 @@ :: +say: send messages :: ++ say - |= letters=(list letter) + |= =letter ^- (quip move _this) =/ =serial (shaf %msg-uid eny.bowl) :_ this(eny.bowl (shax eny.bowl)) @@ -675,12 +674,7 @@ %^ act %out-message %chat-hook :- %chat-action :+ %message (target-to-path target) - :* serial - *@ - our-self - now.bowl - (snag 0 letters) ::TODO support multiple - == + [serial *@ our-self now.bowl letter] :: +eval: run hoon, send code and result as message :: :: this double-virtualizes and clams to disable .^ for security reasons @@ -688,7 +682,7 @@ ++ eval |= [txt=cord exe=hoon] =; tan=(list tank) - (say [%code txt tan] ~) + (say %code txt tan) ;; (list tank) =< +> %+ mong From 9532857ef562b4896b016853f510f5e2d43e2909 Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 20:54:02 +0200 Subject: [PATCH 10/16] chat: Move eval logic into lib --- pkg/arvo/app/chat-cli.hoon | 14 ++------------ pkg/arvo/lib/chat-json.hoon | 3 ++- pkg/arvo/lib/chat/eval.hoon | 16 ++++++++++++++++ 3 files changed, 20 insertions(+), 13 deletions(-) create mode 100644 pkg/arvo/lib/chat/eval.hoon diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index f6441aeb8f..2fc1e7b18e 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -12,8 +12,7 @@ /- *chat-store, *chat-view, *chat-hook, *permission-store, *group-store, sole-sur=sole -/+ sole-lib=sole -/= seed /~ !>(.) +/+ sole-lib=sole, chat-eval :: |% +$ state @@ -681,16 +680,7 @@ :: ++ eval |= [txt=cord exe=hoon] - =; tan=(list tank) - (say %code txt tan) - ;; (list tank) - =< +> - %+ mong - :- mute - =- |.([(sell (slap (slop !>(-) seed) exe))]~) - ^- [our=@p now=@da eny=@uvI] - [our-self now.bowl (shas %eny eny.bowl)] - |=(^ ~) + (say %code txt (eval:chat-eval bowl exe)) :: +lookup-glyph: print glyph info for all, glyph or target :: ++ lookup-glyph diff --git a/pkg/arvo/lib/chat-json.hoon b/pkg/arvo/lib/chat-json.hoon index a36541867e..a84d491a7c 100644 --- a/pkg/arvo/lib/chat-json.hoon +++ b/pkg/arvo/lib/chat-json.hoon @@ -1,4 +1,5 @@ /- *chat-store, *chat-view +/+ chat-eval |% :: ++ slan |=(mod/@tas |=(txt/@ta (need (slaw mod txt)))) @@ -39,7 +40,7 @@ =/ res ((ot output+(ar dank) ~) a) ?^ res u.res - p:(mule |.([(sell (slap !>(..^zuse) (ream u.exp)))]~)) ::TODO oldz + (eval:chat-eval *bowl:gall (ream u.exp)) :: ++ lett |= =letter diff --git a/pkg/arvo/lib/chat/eval.hoon b/pkg/arvo/lib/chat/eval.hoon new file mode 100644 index 0000000000..d4fc383d51 --- /dev/null +++ b/pkg/arvo/lib/chat/eval.hoon @@ -0,0 +1,16 @@ +|% +++ eval + |= [=bowl:gall =hoon] + ^- (list tank) + =/ subj=[our=@p now=@da eny=@uvJ] + :+ our.bowl + now.bowl + (shaz (cat 3 (mix [now eny]:bowl) %eny)) + :: + ;; (list tank) + =< +> + %+ mong + :- mute + |.([(sell (slap (slop !>(subj) !>(..zuse)) hoon))]~) + |=(^ ~) +-- \ No newline at end of file From 42aa035530a6452f5f2205b0067d03d3cc75698d Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 21:59:25 +0200 Subject: [PATCH 11/16] chat-cli: Subscribe to /updates instead of /all On first boot (and debug poke) we scry for /all to ensure we know all messages. --- pkg/arvo/app/chat-cli.hoon | 53 ++++++++++++++++++++++---------------- 1 file changed, 31 insertions(+), 22 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index 2fc1e7b18e..efed16178a 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -85,17 +85,39 @@ ~& %chat-cli-prep ?^ old [~ this(+<+ u.old)] - :- [connect ~] - %_ this - audience [[our-self /] ~ ~] - settings (sy %showtime %notify ~) - width 80 - == + =^ moves this + %_ catch-up + audience [[our-self /] ~ ~] + settings (sy %showtime %notify ~) + width 80 + == + [[connect moves] this] +:: +catch-up: process all chat-store state +:: +++ catch-up + ^- (quip move _this) + =/ =inbox + .^ inbox + %gx + (scot %p our.bowl) + %chat-store + (scot %da now.bowl) + /all/noun + == + |- ^- (quip move _this) + ?~ inbox [~ this] + =* path p.n.inbox + =* mailbox q.n.inbox + =/ =target (path-to-target path) + =^ mon this (read-envelopes target envelopes.mailbox) + =^ mol this $(inbox l.inbox) + =^ mor this $(inbox r.inbox) + [:(weld mon mol mor) this] :: +connect: connect to the chat-store :: ++ connect ^- move - [ost.bowl %peer /chat-store [our-self %chat-store] /all] + [ost.bowl %peer /chat-store [our-self %chat-store] /updates] :: +true-self: moons to planets :: ++ true-self @@ -127,6 +149,8 @@ ^- (quip move _this) ?: ?=(%connect a) [[connect ~] this] + ?: ?=(%catch-up a) + catch-up [~ this] :: +poke-sole-action: handle cli input :: @@ -152,21 +176,6 @@ :- [prompt:sh-out ~] :: start with fresh sole state this(state.cli *sole-share:sole-sur) -:: +diff-chat-initial: catch up on messages -:: -++ diff-chat-initial - |= [=wire =inbox] - ^- (quip move _this) - =| moves=(list move) - |- ^- (quip move _this) - ?~ inbox [~ this] - =* path p.n.inbox - =* mailbox q.n.inbox - =/ =target (path-to-target path) - =^ mon this (read-envelopes target envelopes.mailbox) - =^ mol this $(inbox l.inbox) - =^ mor this $(inbox r.inbox) - [:(weld mon mol mor) this] :: +diff-chat-update: get new mailboxes & messages :: ++ diff-chat-update From 0da8e1efb374139dde00289537751a0799f01435 Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 22:27:43 +0200 Subject: [PATCH 12/16] chat-cli: Properly support deleting local chats Since the current implementation of ;leave is silently destroying state instead of unsubscribing, we disallow running ;leave on local chats and provide an explicit ;delete instead. --- pkg/arvo/app/chat-cli.hoon | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index efed16178a..40ac3cdae5 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -40,6 +40,7 @@ [%eval cord hoon] :: send #-message :: [%create chat-security path (unit glyph)] :: create chat + [%delete path] :: delete chat [%invite ?(%r %w %rw) path (set ship)] :: allow [%banish ?(%r %w %rw) path (set ship)] :: disallow :: @@ -348,8 +349,9 @@ security ;~(plug path (punt ;~(pfix ace glyph))) == - ;~((glue ace) (perk %invite ~) rw path ships) - ;~((glue ace) (perk %banish ~) rw path ships) + ;~((glue ace) (tag %delete) path) + ;~((glue ace) (tag %invite) rw path ships) + ;~((glue ace) (tag %banish) rw path ships) :: ;~((glue ace) (tag %join) ;~(plug targ (punt ;~(pfix ace glyph)))) ;~((glue ace) (tag %leave) targ) @@ -542,6 +544,7 @@ %eval (eval +.job) :: %create (create +.job) + %delete (delete +.job) %invite (change-permission & +.job) %banish (change-permission | +.job) :: @@ -607,6 +610,15 @@ ?(%channel %mailbox) ~ ?(%village %journal) [our-self ~ ~] == + :: +delete: delete local chats + :: + ++ delete + |= =path + ^- (quip move _this) + =- [[- ~] this] + %^ act %do-delete %chat-view + :- %chat-view-action + [%delete (target-to-path our-self path)] :: +change-permission: modify permissions on a local chat :: ++ change-permission @@ -662,10 +674,13 @@ [%add-synced target] :: +leave: unsync & destroy mailbox :: - ::TODO but if we leave our own circle, then it disappears for everyone? + ::TODO allow us to "mute" local chats using this ++ leave |= =target =- [[- ~] this] + ?: =(our-self ship.target) + %- print:sh-out + "can't ;leave local chats, maybe use ;delete instead" %^ act %do-leave %chat-hook :- %chat-hook-action [%remove (target-to-path target)] From e567de9c1841fd821b8208b95e2a6d739d5a0bf3 Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 22:44:20 +0200 Subject: [PATCH 13/16] chat: Move eval logic out of /lib/chat-json This allows us to always include the bowl when evaluating a code letter. --- pkg/arvo/app/chat-store.hoon | 6 +++++- pkg/arvo/lib/chat-json.hoon | 6 ++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/pkg/arvo/app/chat-store.hoon b/pkg/arvo/app/chat-store.hoon index 064616e8dd..4b27e34e71 100644 --- a/pkg/arvo/app/chat-store.hoon +++ b/pkg/arvo/app/chat-store.hoon @@ -1,6 +1,6 @@ :: chat-store: data store that holds linear sequences of chat messages :: -/+ *chat-json +/+ *chat-json, *chat-eval |% +$ move [bone card] :: @@ -193,6 +193,10 @@ =/ mailbox=(unit mailbox) (~(get by inbox) path.act) ?~ mailbox [~ this] + =* letter letter.envelope.act + =? letter &(?=(%code -.letter) ?=(~ output.letter)) + =/ =hoon (ream expression.letter) + letter(output (eval bol hoon)) =: length.config.u.mailbox +(length.config.u.mailbox) number.envelope.act length.config.u.mailbox envelopes.u.mailbox (snoc envelopes.u.mailbox envelope.act) diff --git a/pkg/arvo/lib/chat-json.hoon b/pkg/arvo/lib/chat-json.hoon index a84d491a7c..23380a6e89 100644 --- a/pkg/arvo/lib/chat-json.hoon +++ b/pkg/arvo/lib/chat-json.hoon @@ -37,10 +37,8 @@ ?~ exp [~ '' ~] :+ ~ u.exp - =/ res ((ot output+(ar dank) ~) a) - ?^ res - u.res - (eval:chat-eval *bowl:gall (ream u.exp)) + ::NOTE when sending, if output is an empty list, chat-store will evaluate + (fall ((ot output+(ar dank) ~) a) ~) :: ++ lett |= =letter From 24859907aa8c298cc7d9d92f03f73878a0c52598 Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 23:00:46 +0200 Subject: [PATCH 14/16] chat-cli: Cosmetic improvements Better variable naming. Trailing newline. --- pkg/arvo/app/chat-cli.hoon | 23 ++++++++++++----------- pkg/arvo/lib/chat/eval.hoon | 2 +- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index 40ac3cdae5..5e7a2059c2 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -110,10 +110,10 @@ =* path p.n.inbox =* mailbox q.n.inbox =/ =target (path-to-target path) - =^ mon this (read-envelopes target envelopes.mailbox) - =^ mol this $(inbox l.inbox) - =^ mor this $(inbox r.inbox) - [:(weld mon mol mor) this] + =^ moves-n this (read-envelopes target envelopes.mailbox) + =^ moves-l this $(inbox l.inbox) + =^ moves-r this $(inbox r.inbox) + [:(weld moves-n moves-l moves-r) this] :: +connect: connect to the chat-store :: ++ connect @@ -138,7 +138,8 @@ |= =path ^- target ?. ?=([@ @ *] path) - ::TODO but then doing target-to-path won't get us the same path... + ::TODO can we safely assert the above? + ~& [%path-without-host path] [our-self path] =+ who=(slaw %p i.path) ?~ who [our-self path] @@ -192,18 +193,18 @@ |= [=target envs=(list envelope)] ^- (quip move _this) ?~ envs [~ this] - =^ moi this (read-envelope target i.envs) - =^ mot this $(envs t.envs) - [(weld moi mot) this] + =^ moves-i this (read-envelope target i.envs) + =^ moves-t this $(envs t.envs) + [(weld moves-i moves-t) this] :: ++ notice-create |= =target ^- (quip move _this) - =^ moz this + =^ moves this ?: (~(has by bound) target) [~ this] (bind-default-glyph target) - [[(show-create:sh-out target) moz] this] + [[(show-create:sh-out target) moves] this] :: +bind-default-glyph: :: ++ bind-default-glyph @@ -1197,4 +1198,4 @@ [(sub wid u.ace) &] :- (tufa (scag end `(list @)`txt)) $(txt (slag ?:(nex +(end) end) `tape`txt)) --- \ No newline at end of file +-- diff --git a/pkg/arvo/lib/chat/eval.hoon b/pkg/arvo/lib/chat/eval.hoon index d4fc383d51..66726408fb 100644 --- a/pkg/arvo/lib/chat/eval.hoon +++ b/pkg/arvo/lib/chat/eval.hoon @@ -13,4 +13,4 @@ :- mute |.([(sell (slap (slop !>(subj) !>(..zuse)) hoon))]~) |=(^ ~) --- \ No newline at end of file +-- From 816535c311081d2bb38bf90a59b2d99bfdda41ca Mon Sep 17 00:00:00 2001 From: Fang Date: Tue, 8 Oct 2019 23:18:36 +0200 Subject: [PATCH 15/16] drum: Boot with %chat-cli, without %hall & %talk Also refactors the surrounding code in +deft-apes. --- pkg/arvo/lib/hood/drum.hoon | 72 +++++++++++++++---------------------- 1 file changed, 29 insertions(+), 43 deletions(-) diff --git a/pkg/arvo/lib/hood/drum.hoon b/pkg/arvo/lib/hood/drum.hoon index 60e6d57e1c..34231fcb97 100644 --- a/pkg/arvo/lib/hood/drum.hoon +++ b/pkg/arvo/lib/hood/drum.hoon @@ -76,56 +76,42 @@ |= [our/ship lit/?] %- ~(gas in *(set well:gall)) ^- (list well:gall) - ?: lit - :~ [%home %dojo] - [%home %azimuth-tracker] - == - =+ myr=(clan:title our) + :: boot all default apps off the home desk :: - ?: ?=($pawn myr) - :~ [%home %lens] - [%base %hall] - [%base %talk] - [%base %dojo] - [%base %modulo] - [%home %launch] - [%home %publish] - [%home %clock] - [%home %weather] - [%home %group-store] - [%home %group-hook] - [%home %permission-store] - [%home %permission-group-hook] - [%home %chat-store] - [%home %chat-hook] - [%home %chat-view] - == - :~ [%home %lens] - [%home %acme] - [%home %dns] - [%home %dojo] - [%home %hall] - [%home %talk] - [%home %modulo] - [%home %launch] - [%home %publish] - [%home %clock] - [%home %weather] - [%home %group-store] - [%home %group-hook] - [%home %permission-store] - [%home %permission-group-hook] - [%home %chat-store] - [%home %chat-hook] - [%home %chat-view] - [%home %azimuth-tracker] + =- (turn - |=(a=term home+a)) + ^- (list term) + ?: lit + :~ %dojo + %azimuth-tracker + == + %+ welp + ?: ?=(%pawn (clan:title our)) ~ + :~ %acme + %dns + %azimuth-tracker + == + :~ %lens + %dojo + %modulo + %launch + %publish + %clock + %weather + %group-store + %group-hook + %permission-store + %permission-group-hook + %chat-store + %chat-hook + %chat-view + %chat-cli == :: ++ deft-fish :: default connects |= our/ship %- ~(gas in *(set gill:gall)) ^- (list gill:gall) - [[our %talk] [our %dojo] ~] + [[our %chat-cli] [our %dojo] ~] :: ++ make :: initial part |= our/ship From 4dea1068b2d5c89a2822d95372811b5ab1ed4286 Mon Sep 17 00:00:00 2001 From: Fang Date: Wed, 9 Oct 2019 00:06:39 +0200 Subject: [PATCH 16/16] chat-cli: Add clarity --- pkg/arvo/app/chat-cli.hoon | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon index 5e7a2059c2..483278a41a 100644 --- a/pkg/arvo/app/chat-cli.hoon +++ b/pkg/arvo/app/chat-cli.hoon @@ -638,8 +638,11 @@ =. path =- (snoc `^path`- term) [%chat (target-to-path our-self path)] + :: whitelist: empty if no matching permission, else true if whitelist + :: =/ whitelist=(unit ?) - =- ?~(- ~ `?=(%white kind.u)) + =; perm=(unit permission) + ?~(perm ~ `?=(%white kind.u.perm)) ::TODO +permission-of-target? .^ (unit permission) %gx