1
1
mirror of https://github.com/urbit/shrub.git synced 2024-12-29 15:14:17 +03:00
shrub/pkg/arvo/sys/vane/dill.hoon

560 lines
19 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 ::
$: %6 ::
hey=(unit duct) :: default duct
dug=(map @tas axon) :: conversations
eye=(jug @tas 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) ::
egg=_| :: see +take, removeme
== ::
+$ axon :: dill session
$: ram=term :: console program
tem=(unit (list dill-belt)) :: pending, reverse
wid=_80 :: terminal width
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-poke p=(hypo poke)] ::
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
2022-09-07 09:52:59 +03:00
%zest ::
== ::
task:clay ::
== ::
$: %d ::
$> $? %crud ::
%heft ::
%text ::
%verb ::
== ::
task:dill ::
== ::
2019-11-19 07:36:21 +03:00
$: %g ::
2022-09-07 09:52:59 +03:00
$>(%deal 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 ::
%writ ::
== ::
gift:clay ::
== ::
2020-12-08 03:22:26 +03:00
$: %dill ::
$>(%blit gift:dill) ::
== ::
2020-12-08 03:22:26 +03:00
$: %gall ::
$>(%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)
|_ [hen=duct ses=@tas axon]
2016-11-24 07:25:07 +03:00
++ abet :: resolve
^- [(list move) axle]
[(flop moz) all(dug (~(put by dug.all) ses +<+>))]
2016-11-24 07:25:07 +03:00
::
++ 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] +>
%hail (send %hey ~)
%belt (send `dill-belt`p.kyz)
%talk (talk p.kyz)
%text (fore (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(wid p.p.kyz) %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)
::
%seat
%^ pass /seat %g
:+ %deal [our our]
[%hood %poke %kiln-install !>([desk.kyz our desk.kyz])]
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
::
?- lev
%hush +>.$
%soft (fore (tuba "crud: %{(trip err)} event failed") ~)
%loud (talk leaf+"crud: %{(trip err)} event failed" (flop tac))
==
::
++ talk
|= tac=(list tank)
%- fore
%- zing
%+ turn tac
|= a=tank
(turn (~(win re a) [0 wid]) tuba)
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 :: gift to viewers
2020-12-08 03:47:06 +03:00
|= git=gift
=- +>.$(moz (weld - moz))
%+ turn
~(tap in (~(get ju eye.all) ses))
|=(=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]))
::
++ fore :: send dill output
::NOTE there are still implicit assumptions
:: about the underlying console app's
:: semantics here. specifically, trailing
:: newlines are important to not getting
:: overwritten by the drum prompt, and a
:: bottom-of-screen cursor position gives
:: nicest results. a more agnostic solution
:: will need to replace this arm, someday.
:: perhaps +send this to .ram instead?
::
|= liz=(list (list @c))
~? !=(%$ ses) [%d %foreing-in-session ses]
^+ +>
=. +>
=| biz=(list blit)
|- ^+ +>.^$
?~ liz (done %blit [%hop 0] [%wyp ~] biz)
$(liz t.liz, biz (welp biz [%put i.liz] [%nel ~] ~))
:: since dill is acting on its own accord,
:: we %hey the term app so it may clean up.
::
(send %hey ~)
::
++ from :: receive blit
|= bit=dill-blit
2016-11-24 07:25:07 +03:00
^+ +>
?: ?=(%qit -.bit)
2016-11-24 07:25:07 +03:00
(dump %logo ~)
::TODO so why is this a (list blit) again?
(done %blit bit ~)
::
2021-08-09 02:31:53 +03:00
++ sponsor
^- 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
2021-07-14 01:00:13 +03:00
(pass /merg/base [%c %merg %kids our %base da+now %init])
2019-02-23 01:11:53 +03:00
::
++ mere :: continue init
^+ .
=/ myt (flop (fall tem ~))
2016-11-24 07:25:07 +03:00
=. tem ~
2022-09-07 09:52:59 +03:00
=. ..mere (pass /zest %c %zest %base %live)
2021-08-09 02:31:53 +03:00
=. ..mere (show-desk %kids)
=. ..mere (open ~)
2021-08-09 02:31:53 +03:00
|- ^+ ..mere
?~ myt ..mere
$(myt t.myt, ..mere (send i.myt))
2016-11-24 07:25:07 +03:00
::
++ into :: preinitialize
|= gyl=(list gill)
=. tem `(turn gyl |=(a=gill [%yow a]))
2021-07-14 01:00:13 +03:00
(pass / [%c %warp our %base `[%sing %y [%ud 1] /]])
2016-11-24 07:25:07 +03:00
::
++ open
|= gyl=(list gill)
::TODO should allow handlers from non-base desks
::TODO maybe ensure :ram is running?
=. +> peer
%+ roll gyl
|= [g=gill _..open]
(send [%yow g])
::
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])
(deal /send/[ses] [%poke [%dill-poke !>([ses bet])]])
::
2016-11-24 07:25:07 +03:00
++ peer
(deal /peer/[ses] %watch /dill/[ses])
::
++ pull
(deal /peer/[ses] %leave ~)
2016-11-24 07:25:07 +03:00
::
2021-08-09 02:31:53 +03:00
++ show-desk :: permit reads on desk
|= des=desk
2019-11-05 23:34:53 +03:00
(pass /show [%c %perm des / r+`[%black ~]])
::
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 %unto *]
2016-11-24 07:25:07 +03:00
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
2021-08-11 19:23:36 +03:00
%raw-fact !!
%kick peer
%poke-ack ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
%watch-ack
?~ p.p.+>.sih
+>.$
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
::
%fact
?. ?=(%dill-blit p.cage.p.+>.sih)
+>.$
(from ;;(dill-blit q.q.cage.p.+>.sih))
2016-11-24 07:25:07 +03:00
==
::
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 from name
|= [hen=duct ses=@tas]
^- (unit _as)
=/ nux (~(get by dug.all) ses)
?~ nux ~
(some ~(. as hen ses u.nux))
::
++ aw :: make ++as from wire
|= [hen=duct wir=wire]
^- (unit _as)
%+ ax hen
?+ wir %$
[?(%peer %send) @ *] i.t.wir
==
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)
:: unwrap session tasks, default to session %$
::
=^ ses=@tas task
?:(?=(%shot -.task) +.task [%$ 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
=/ say (tuba "<awaiting {(trip app)}, this may take a minute>")
=/ zon=axon [app input=[~ ~] width=80]
::
=^ moz all abet:(~(into as duc %$ zon) ~)
=. eye.all (~(put ju eye.all) %$ duc)
[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)
[~ ..^$]
:: %open opens a new dill session
::
?: ?=(%open -.task)
?: (~(has by dug.all) ses)
::TODO should we allow, and just send the %yow blits?
~| [%cannot-open-existing ses]
!!
=/ zon=axon [p.task ~ width=80]
=^ moz all abet:(~(open as hen ses zon) q.task)
=. eye.all (~(put ju eye.all) ses hen)
[moz ..^$]
:: %shut closes an existing dill session
::
?: ?=(%shut -.task)
?: =(%$ ses)
~| %cannot-shut-default-session
!!
=/ nus
~| [%no-session ses]
(need (ax hen ses))
::NOTE we do deletion from state outside of the core,
:: because +abet would re-insert.
::TODO send a %bye blit? xx
=^ moz all abet:pull:nus
=. dug.all (~(del by dug.all) ses)
=. eye.all (~(del by eye.all) ses)
[moz ..^$]
:: %view opens a subscription to the target session, on the current duct
::
?: ?=(%view -.task)
=/ nus
:: crash on viewing non-existent session
::
~| [%no-session ses]
(need (ax hen ses))
:: register the viewer and send a %hey so they get the full screen
::
=^ moz all
abet:(send:nus %hey ~)
:- moz
..^$(eye.all (~(put ju eye.all) ses hen))
:: %flee closes a subscription to the target session, from the current duct
::
?: ?=(%flee -.task)
:- ~
..^$(eye.all (~(del ju eye.all) ses hen))
::
=/ nus
(ax hen ses)
2016-11-24 07:25:07 +03:00
?~ nus
:: session :ses does not exist
2018-12-12 09:50:53 +03:00
:: could be before %boot (or %boot failed)
::
~& [%dill-call-no-session ses hen -.task]
2018-12-03 22:45:50 +03:00
=/ 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=any-axle
?- -.old
%6 ..^$(all old)
%5 $(old (axle-5-to-6 old))
%4 $(old (axle-4-to-5 old))
==
|%
+$ any-axle $%(axle axle-5 axle-4)
::
+$ axle-5
$: %5
hey=(unit duct) :: default duct
dug=(map @tas axon) :: conversations
eye=(jug @tas duct) :: outside listeners
lit=? :: boot in lite mode
veb=(map @tas log-level)
==
::
++ axle-5-to-6
|= a=axle-5
^- axle
:: [%6 hey `(map @tas axon)`dug eye lit veb |]
a(- %6, veb [veb.a &])
::
+$ axle-4
$: %4
hey=(unit duct)
dug=(map duct axon-4)
eye=(jug duct duct)
lit=?
veb=(map @tas log-level)
==
::
+$ axon-4
$: ram=term
tem=(unit (list dill-belt-4))
wid=_80
pos=$@(@ud [@ud @ud])
see=$%([%lin (list @c)] [%klr stub])
==
::
+$ dill-belt-4
$% [%ctl p=@c]
[%met p=@c]
dill-belt
==
::
++ axle-4-to-5
|= axle-4
^- axle-5
:- %5
=- [hey nug nay lit veb]
%+ roll ~(tap by dug)
|= [[=duct =axon-4] nug=(map @tas axon) nay=(jug @tas duct)]
=/ ses=@tas
~| [%unexpected-duct duct]
?>(=([//term/1]~ duct) %$)
:- (~(put by nug) ses (axon-4-to-5 axon-4))
%+ ~(put by nay) ses
(~(put in (~(get ju eye) duct)) duct)
::
++ axon-4-to-5
|= axon-4
^- axon
=; tem [ram tem wid]
?~ tem ~
%- some
%+ turn u.tem
|= b=dill-belt-4
^- dill-belt
?. ?=(?(%ctl %met) -.b) b
[%mod -.b p.b]
--
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)
==
~
:: /dy/sessions (set @tas) all existing sessions
:: /du/sessions/[ses] ? does session ses exist?
::
?+ [ren tyl] ~
[%y %sessions ~] ``noun+!>(~(key by dug.all))
[%u %sessions @ ~] ``noun+!>((~(has by dug.all) (snag 1 tyl)))
==
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))
::
=; [moz=(list move) lax=_..^$]
=? moz egg.all.lax
:: dill pre-release (version %5) in some cases ended up in a state
:: where it had both an old-style and new-style subscription open
:: for the default session. here, we obliterate both and establish
:: only the new-style subscription.
::
=/ hey (need hey.all.lax)
:* [hey %pass / %g %deal [our our] %hood %leave ~]
[hey %pass [%peer %$ ~] %g %deal [our our] %hood %leave ~]
[hey %pass [%peer %$ ~] %g %deal [our our] %hood %watch [%dill %$ ~]]
moz
==
=. egg.all.lax |
[moz lax]
::
=/ nus (aw hen tea)
?~ nus
:: :tea points to an unrecognized session
::
~& [%dill-take-no-session tea -.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 ..^$]
--