urbit/pkg/arvo/sys/vane/dill.hoon

473 lines
17 KiB
Plaintext
Raw Normal View History

!:
:: dill (4d), terminal handling
2016-11-24 07:25:07 +03:00
::
2020-12-06 11:38:37 +03:00
|= our=ship
=, dill
2016-11-24 07:25:07 +03:00
=> |% :: interface tiles
+$ gill (pair ship term) :: general contact
2016-11-24 07:25:07 +03:00
-- ::
=> |% :: console protocol
+$ axle ::
$: %4 ::TODO replace ducts with session ids ::
hey=(unit duct) :: default duct
dug=(map duct axon) :: conversations
eye=(jug duct duct) :: outside listeners
lit=? :: boot in lite mode
2019-09-27 20:55:14 +03:00
$= veb :: vane verbosities
$~ (~(put by *(map @tas log-level)) %hole %soft) :: quiet packet crashes
(map @tas log-level) ::
== ::
+$ axon :: dill per duct
$: ram=term :: console program
tem=(unit (list dill-belt)) :: pending, reverse
wid=_80 :: terminal width
pos=@ud :: cursor position
see=$%([%lin (list @c)] [%klr stub]) :: current line
2016-11-24 07:25:07 +03:00
== ::
2019-09-27 20:55:14 +03:00
+$ log-level ?(%hush %soft %loud) :: none, line, full
2016-11-24 07:25:07 +03:00
-- => ::
|% :: protocol outward
+$ mess ::
$% [%dill-belt p=(hypo dill-belt)] ::
2016-11-24 07:25:07 +03:00
== ::
+$ move [p=duct q=(wind note gift)] :: local move
+$ note :: out request $->
$~ [%d %verb ~] ::
$% $: %$ ::
$>(?(%verb %whey) waif) ::
== ::
$: %c ::
$> $? %merg :: merge desks
%perm :: change permissions
%warp :: wait for clay hack
== ::
task:clay ::
== ::
$: %d ::
$> $? %crud ::
%heft ::
%text ::
%verb ::
== ::
task:dill ::
== ::
2019-11-19 07:36:21 +03:00
$: %g ::
$> $? %conf ::
%deal ::
2019-11-05 23:58:37 +03:00
%goad ::
== ::
task:gall ::
== ::
2019-08-07 01:42:37 +03:00
$: %j ::
$> $? %dawn ::
%fake ::
== ::
task:jael ::
== == ::
+$ sign :: in result $<-
2020-12-08 03:22:26 +03:00
$~ [%dill %blit ~] ::
$% $: %behn ::
$% $>(%writ gift:clay) :: XX %slip
$>(%mere gift:clay) :: XX %slip
== == ::
2020-12-08 03:22:26 +03:00
$: %clay ::
2020-05-07 11:51:08 +03:00
$> $? %mere ::
%note ::
%writ ::
== ::
gift:clay ::
== ::
2020-12-08 03:22:26 +03:00
$: %dill ::
$>(%blit gift:dill) ::
== ::
2020-12-08 03:22:26 +03:00
$: %gall ::
2020-05-07 11:51:08 +03:00
$> $? %onto ::
%unto ::
== ::
gift:gall ::
== == ::
2016-11-24 07:25:07 +03:00
:::::::: :: dill tiles
--
=| all=axle
2020-12-06 11:38:37 +03:00
|= [now=@da eny=@uvJ rof=roof] :: current invocation
=> ~% %dill ..part ~
|%
2016-11-24 07:25:07 +03:00
++ as :: per cause
=| moz=(list move)
2018-12-12 09:50:53 +03:00
|_ [hen=duct axon]
2016-11-24 07:25:07 +03:00
++ abet :: resolve
^- [(list move) axle]
2016-11-24 07:25:07 +03:00
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
::
++ call :: receive input
2020-12-08 03:47:06 +03:00
|= kyz=task
2016-11-24 07:25:07 +03:00
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
%flow +>
%harm +>
%hail (send %hey ~)
%text (from %out (tuba p.kyz))
%crud :: (send `dill-belt`[%cru p.kyz q.kyz])
2016-11-24 07:25:07 +03:00
(crud p.kyz q.kyz)
%blew (send %rez p.p.kyz q.p.kyz)
%heft (pass /whey %$ whey/~)
%meld (dump kyz)
%pack (dump kyz)
%crop (dump trim+p.kyz)
%verb (pass /verb %$ kyz)
::
%belt
%- send
::TMP forwards compatibility with next-dill
::
?@ p.kyz [%txt p.kyz ~]
?: ?=(%hit -.p.kyz) [%txt ~]
?. ?=(%mod -.p.kyz) p.kyz
=/ =@c
?@ key.p.kyz key.p.kyz
?:(?=(?(%bac %del %ret) -.key.p.kyz) `@`-.key.p.kyz ~-)
?:(?=(%met mod.p.kyz) [%met c] [%ctl c])
2016-11-24 07:25:07 +03:00
==
::
++ crud
|= [err=@tas tac=(list tank)]
2019-09-27 20:55:14 +03:00
:: unknown errors default to %loud
::
=/ lev=log-level (~(gut by veb.all) err %loud)
:: apply log level for this error tag
::
=/ =wall
?- lev
%hush ~
%soft ~["crud: %{(trip err)} event failed"]
%loud :- "crud: %{(trip err)} event failed"
%- zing
%+ turn (flop tac)
|=(a=tank (~(win re a) [0 wid]))
==
2016-11-24 07:25:07 +03:00
|- ^+ +>.^$
2019-09-27 20:55:14 +03:00
?~ wall +>.^$
$(wall t.wall, +>.^$ (from %out (tuba i.wall)))
2016-11-24 07:25:07 +03:00
::
++ dump :: pass down to hey
2020-12-08 03:47:06 +03:00
|= git=gift
2016-11-24 07:25:07 +03:00
?> ?=(^ hey.all)
+>(moz [[u.hey.all %give git] moz])
::
++ done :: return gift
2020-12-08 03:47:06 +03:00
|= git=gift
=- +>.$(moz (weld - moz))
%+ turn
:- hen
~(tap in (~(get ju eye.all) hen))
|=(=duct [duct %give git])
2016-11-24 07:25:07 +03:00
::
2019-11-05 23:34:53 +03:00
++ deal :: pass to %gall
2019-11-19 07:36:21 +03:00
|= [=wire =deal:gall]
(pass wire [%g %deal [our our] ram deal])
2019-11-05 23:34:53 +03:00
::
++ pass :: pass note
|= [=wire =note]
+>(moz :_(moz [hen %pass wire note]))
::
++ from :: receive blit
|= bit=dill-blit
2016-11-24 07:25:07 +03:00
^+ +>
?: ?=(%mor -.bit)
2016-11-24 07:25:07 +03:00
|- ^+ +>.^$
?~ p.bit +>.^$
$(p.bit t.p.bit, +>.^$ ^$(bit i.p.bit))
?: ?=(%out -.bit)
2016-11-24 07:25:07 +03:00
%+ done %blit
:~ [%lin p.bit]
[%mor ~]
see
2016-11-24 07:25:07 +03:00
[%hop pos]
==
?: ?=(%klr -.bit)
2016-11-24 07:25:07 +03:00
%+ done %blit
:~ [%klr p.bit]
2016-11-24 07:25:07 +03:00
[%mor ~]
see
2016-11-24 07:25:07 +03:00
[%hop pos]
==
?: ?=(%pro -.bit)
=. see [%lin p.bit]
(done %blit [see [%hop pos] ~])
?: ?=(%pom -.bit)
::NOTE treat "styled prompt" without style as plain prompt,
:: to allow rendering by older runtimes
::TODO remove me once v0.10.9+ has high/guaranteed adoption
::
?: (levy p.bit (cork head |*(s=stye =(*stye s))))
$(bit [%pro (zing (turn p.bit tail))])
=. see [%klr p.bit]
(done %blit [see [%hop pos] ~])
?: ?=(%hop -.bit)
2016-11-24 07:25:07 +03:00
(done(pos p.bit) %blit [bit ~])
?: ?=(%qit -.bit)
2016-11-24 07:25:07 +03:00
(dump %logo ~)
(done %blit [bit ~])
:: XX move
::
++ sein
^- ship
=/ dat=(unit (unit cage))
(rof `[our ~ ~] j/[[our sein/da/now] /(scot %p our)])
;;(ship q.q:(need (need dat)))
2016-11-24 07:25:07 +03:00
::
++ init :: initialize
(pass /merg/home [%c %merg %kids our %home da+now %init])
2019-02-23 01:11:53 +03:00
::
++ mere :: continue init
^+ .
=/ myt (flop (fall tem ~))
=/ can (clan:title our)
2016-11-24 07:25:07 +03:00
=. tem ~
=. +> (pass / %g %conf ram %home)
=? +> ?=(?(%earl %duke %king) can)
(ota sein %kids)
:: make kids desk publicly readable, so syncs work.
::
=. +> (show %kids)
=. +> hood-set-boot-apps
2016-11-24 07:25:07 +03:00
=. +> peer
|- ^+ +>+
?~ myt +>+
$(myt t.myt, +>+ (send i.myt))
::
++ into :: preinitialize
|= gyl=(list gill)
=. tem `(turn gyl |=(a=gill [%yow a]))
(pass / [%c %warp our %home `[%sing %y [%ud 1] /]])
2016-11-24 07:25:07 +03:00
::
++ send :: send action
|= bet=dill-belt
^+ +>
2016-11-24 07:25:07 +03:00
?^ tem
+>(tem `[bet u.tem])
2019-11-05 23:34:53 +03:00
(deal / [%poke [%dill-belt -:!>(bet) bet]])
::
++ hood-set-boot-apps
2019-11-05 23:34:53 +03:00
(deal / [%poke %drum-set-boot-apps !>(lit.all)])
::
2016-11-24 07:25:07 +03:00
++ peer
(deal / [%watch /drum])
2016-11-24 07:25:07 +03:00
::
++ show :: permit reads on desk
|= des=desk
2019-11-05 23:34:53 +03:00
(pass /show [%c %perm des / r+`[%black ~]])
::
++ ota
|= syn=[ship desk]
(deal /sync %poke %kiln-ota !>(`syn))
2016-11-24 07:25:07 +03:00
::
++ take :: receive
|= [tea=wire sih=sign]
2016-11-24 07:25:07 +03:00
^+ +>
?- sih
2020-12-08 03:22:26 +03:00
[%gall %onto *]
2016-11-24 07:25:07 +03:00
:: ~& [%take-gall-onto +>.sih]
?- -.+>.sih
2018-03-19 06:54:47 +03:00
%| (crud %onto p.p.+>.sih)
%& (done %blit [%lin (tuba "{<p.p.sih>}")]~)
2016-11-24 07:25:07 +03:00
==
::
2020-12-08 03:22:26 +03:00
[%gall %unto *]
2016-11-24 07:25:07 +03:00
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
%raw-fact !!
%poke-ack ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
%kick peer
%watch-ack ?~ p.p.+>.sih
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
%fact (from ;;(dill-blit q:`vase`+>+>.sih))
2016-11-24 07:25:07 +03:00
==
::
2020-12-08 03:22:26 +03:00
[%clay %note *]
2016-11-24 07:25:07 +03:00
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
2020-12-08 03:22:26 +03:00
[?(%behn %clay) %writ *]
2016-11-24 07:25:07 +03:00
init
2019-02-23 01:11:53 +03:00
::
2020-12-08 03:22:26 +03:00
[?(%behn %clay) %mere *]
2019-02-23 01:11:53 +03:00
?: ?=(%& -.p.sih)
mere
(mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih)
2016-11-24 07:25:07 +03:00
::
2020-12-08 03:22:26 +03:00
[%dill %blit *]
2016-11-24 07:25:07 +03:00
(done +.sih)
==
--
::
++ ax :: make ++as
|= hen=duct
^- (unit _as)
=/ nux (~(get by dug.all) hen)
?~ nux ~
2018-12-12 09:50:53 +03:00
(some ~(. as hen u.nux))
2016-11-24 07:25:07 +03:00
--
|% :: poke+peek pattern
++ call :: handle request
2018-12-03 22:45:50 +03:00
|= $: hen=duct
2020-02-11 01:03:03 +03:00
dud=(unit goof)
2020-12-08 03:47:06 +03:00
wrapped-task=(hobo task)
2016-11-24 07:25:07 +03:00
==
^+ [*(list move) ..^$]
~| wrapped-task
2020-12-08 03:47:06 +03:00
=/ task=task ((harden task) wrapped-task)
::
:: error notifications "downcast" to %crud
::
=? task ?=(^ dud)
~| %crud-in-crud
?< ?=(%crud -.task)
[%crud -.task tang.u.dud]
::
:: the boot event passes thru %dill for initial duct distribution
::
2018-12-03 22:45:50 +03:00
?: ?=(%boot -.task)
?> ?=(?(%dawn %fake) -.p.task)
?> =(~ hey.all)
=. hey.all `hen
=/ boot
2020-12-08 03:47:06 +03:00
((soft $>($?(%dawn %fake) task:jael)) p.task)
?~ boot
2019-08-01 23:17:14 +03:00
~& %dill-no-boot
~& p.task
~| invalid-boot-event+hen !!
=. lit.all lit.task
[[hen %pass / %j u.boot]~ ..^$]
:: we are subsequently initialized.
::
2018-12-03 22:45:50 +03:00
?: ?=(%init -.task)
?> =(~ dug.all)
:: configure new terminal, setup :hood and %clay
::
=* duc (need hey.all)
=/ app %hood
2018-12-04 23:20:55 +03:00
=/ see (tuba "<awaiting {(trip app)}, this may take a minute>")
=/ zon=axon [app input=[~ ~] width=80 cursor=(lent see) lin+see]
::
2018-12-12 09:50:53 +03:00
=^ moz all abet:(~(into as duc zon) ~)
[moz ..^$]
:: %flog tasks are unwrapped and sent back to us on our default duct
::
2018-12-03 22:45:50 +03:00
?: ?=(%flog -.task)
?~ hey.all
[~ ..^$]
:: this lets lib/helm send %heft a la |mass
::
=? p.task ?=([%crud %hax-heft ~] p.task) [%heft ~]
::
$(hen u.hey.all, wrapped-task p.task)
:: %vega and %trim notifications come in on an unfamiliar duct
::
?: ?=(?(%trim %vega) -.task)
[~ ..^$]
2019-09-27 20:55:14 +03:00
:: %knob sets a verbosity level for an error tag
::
2019-09-27 20:55:14 +03:00
?: ?=(%knob -.task)
=. veb.all (~(put by veb.all) tag.task level.task)
[~ ..^$]
::
?: ?=(%view -.task)
:: crash on viewing non-existent session
::
~| [%no-session session.task]
?> =(~ session.task)
=/ session (need hey.all)
=/ =axon (~(got by dug.all) session)
:: register the viewer and send them the prompt line
::
:- [hen %give %blit [see.axon]~]~
..^$(eye.all (~(put ju eye.all) session hen))
::
?: ?=(%flee -.task)
:- ~
~| [%no-session session.task]
?> =(~ session.task)
=/ session (need hey.all)
..^$(eye.all (~(del ju eye.all) session hen))
::
=/ nus (ax hen)
=? nus &(?=(~ nus) ?=(^ hey.all))
::TODO allow specifying target session in task
(ax u.hey.all)
2016-11-24 07:25:07 +03:00
?~ nus
2018-12-12 09:50:53 +03:00
:: :hen is an unrecognized duct
:: could be before %boot (or %boot failed)
::
2018-12-03 22:45:50 +03:00
~& [%dill-call-no-flow hen -.task]
=/ tan ?:(?=(%crud -.task) q.task ~)
[((slog (flop tan)) ~) ..^$]
::
2018-12-03 22:45:50 +03:00
=^ moz all abet:(call:u.nus task)
2016-11-24 07:25:07 +03:00
[moz ..^$]
::
2019-09-27 20:55:14 +03:00
++ load :: import old state
|= old=axle
..^$(all old)
2016-11-24 07:25:07 +03:00
::
++ scry
2020-12-08 00:52:12 +03:00
^- roon
|= [lyc=gang car=term bem=beam]
2016-11-24 07:25:07 +03:00
^- (unit (unit cage))
2020-12-08 00:52:12 +03:00
=* ren car
2020-11-24 00:06:50 +03:00
=* why=shop &/p.bem
=* syd q.bem
=* lot=coin $/r.bem
=* tyl s.bem
::
?. ?=(%& -.why) ~
=* his p.why
::TODO don't special-case whey scry
::
2020-05-07 11:51:08 +03:00
?: &(=(ren %$) =(tyl /whey))
=/ maz=(list mass)
:~ hey+&+hey.all
dug+&+dug.all
==
``mass+!>(maz)
:: only respond for the local identity, %$ desk, current timestamp
::
?. ?& =(&+our why)
=([%$ %da now] lot)
=(%$ syd)
==
~
:: /dx/sessions//line blit current line (prompt) of default session
:: /dx/sessions//cursor @ud current cursor position of default session
::TODO support asking for specific sessions once session ids are real
::
?. ?=(%x ren) ~
?+ tyl ~
[%sessions %$ *]
?~ hey.all [~ ~]
?~ session=(~(get by dug.all) u.hey.all) [~ ~]
?+ t.t.tyl ~
[%line ~] ``blit+!>(`blit`see.u.session)
[%cursor ~] ``atom+!>(pos.u.session)
==
==
2016-11-24 07:25:07 +03:00
::
++ stay all
2016-11-24 07:25:07 +03:00
::
++ take :: process move
2020-12-06 11:38:37 +03:00
|= [tea=wire hen=duct dud=(unit goof) hin=sign]
^+ [*(list move) ..^$]
?^ dud
~|(%dill-take-dud (mean tang.u.dud))
::
=/ nus (ax hen)
?~ nus
2018-12-12 09:50:53 +03:00
:: :hen is an unrecognized duct
:: could be before %boot (or %boot failed)
::
2020-12-06 11:38:37 +03:00
~& [%dill-take-no-flow hen -.hin +<.hin]
2016-11-24 07:25:07 +03:00
[~ ..^$]
2020-12-06 11:38:37 +03:00
=^ moz all abet:(take:u.nus tea hin)
2016-11-24 07:25:07 +03:00
[moz ..^$]
--