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

656 lines
24 KiB
Plaintext
Raw Normal View History

!:
:: dill (4d), terminal handling
2016-11-24 07:25:07 +03:00
::
|= pit/vase
=, dill
2016-11-24 07:25:07 +03:00
=> |% :: interface tiles
++ gill (pair ship term) :: general contact
-- ::
=> |% :: console protocol
++ axle ::
2019-11-05 23:58:37 +03:00
$: $2 ::
2016-11-24 07:25:07 +03:00
hey/(unit duct) :: default duct
dug/(map duct axon) :: conversations
lit/? :: boot in lite mode
2019-11-05 23:58:37 +03:00
dog/_| :: auto-goad
2016-11-24 07:25:07 +03:00
$= hef :: other weights
$: a/(unit mass) ::
b/(unit mass) ::
c/(unit mass) ::
2019-07-04 02:01:45 +03:00
e/(unit mass) ::
2016-11-24 07:25:07 +03:00
f/(unit mass) ::
g/(unit mass) ::
2019-07-04 03:08:23 +03:00
i/(unit mass) ::
2019-01-30 01:41:55 +03:00
j/(unit mass) ::
2016-11-24 07:25:07 +03:00
== ::
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) ::
== ::
2016-11-24 07:25:07 +03:00
++ axon :: dill per duct
$: ram/term :: console program
tem/(unit (list dill-belt)) :: pending, reverse
wid/_80 :: terminal width
pos/@ud :: cursor position
see/(list @c) :: current line
== ::
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)} ::
== ::
++ move {p/duct q/(wind note gift:able)} :: local move
2016-11-24 07:25:07 +03:00
++ note :: out request $->
$~ [%d %verb ~] ::
$% $: %a ::
$>(%wegh task:able:ames) ::
== ::
$: %b ::
2019-11-05 23:58:37 +03:00
$> $? %wait ::
%wegh ::
== ::
task:able:behn ::
== ::
$: %c ::
$> $? %merg :: merge desks
%perm :: change permissions
%warp :: wait for clay hack
%wegh :: memory measure
== ::
task:able:clay ::
== ::
$: %d ::
$> $? %crud ::
%heft ::
%init :: XX obsolete?
%lyra ::
%text ::
%veer ::
%verb ::
== ::
task:able:dill ::
== ::
2019-07-04 02:01:45 +03:00
$: %e ::
$>(%wegh task:able:eyre) ::
2019-07-04 02:01:45 +03:00
== ::
$: %f ::
$>(%wegh task:able:ford) ::
== ::
$: %g ::
$> $? %conf ::
%deal ::
2019-11-05 23:58:37 +03:00
%goad ::
%wegh ::
== ::
task:able:gall ::
== ::
2019-07-04 03:08:23 +03:00
$: %i ::
$>(%wegh task:able:iris) ::
2019-07-04 03:08:23 +03:00
== ::
2019-08-07 01:42:37 +03:00
$: %j ::
$> $? %dawn ::
%fake ::
%wegh ::
== ::
2019-08-07 01:42:37 +03:00
task:able:jael ::
== == ::
2016-11-24 07:25:07 +03:00
++ sign :: in result $<-
2019-08-07 01:42:37 +03:00
$~ [%j %init *@p] ::
$% $: %a ::
$% [%nice ~] :: XX obsolete
$> $? %mass ::
%send :: XX strange
== ::
gift:able:ames ::
== == ::
$: %b ::
2019-11-05 23:58:37 +03:00
$% $> $? %mass ::
%wake ::
== ::
gift:able:behn ::
$>(%writ gift:able:clay) :: XX %slip
== == ::
$: %c ::
$> $? %mack :: XX strange
%mass ::
%mere ::
%note ::
%writ ::
== ::
gift:able:clay ::
== ::
$: %d ::
$>(%blit gift:able:dill) ::
== ::
2019-07-04 02:01:45 +03:00
$: %e ::
$>(%mass gift:able:eyre) ::
2019-07-04 02:01:45 +03:00
== ::
$: %f ::
$>(%mass gift:able:ford) ::
== ::
$: %g ::
$> $? %mass ::
%onto ::
%unto ::
== ::
gift:able:gall ::
== ::
2019-07-04 03:08:23 +03:00
$: %i ::
$>(%mass gift:able:iris) ::
2019-07-04 03:08:23 +03:00
== ::
2019-08-07 01:42:37 +03:00
$: %j ::
$> $? %init ::
%mass ::
== ::
2019-08-07 01:42:37 +03:00
gift:able:jael ::
== == ::
2016-11-24 07:25:07 +03:00
:::::::: :: dill tiles
--
=| all/axle
2018-12-06 00:41:21 +03:00
|= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation
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}
[(flop moz) all(dug (~(put by dug.all) hen +<+))]
::
2019-11-05 23:58:37 +03:00
++ auto :: stage automation
^+ .
?. dog.all .
=. dog.all |
(pass /auto/one [%b %wait +(now)])
::
++ auto-wake :: resume automation
|= [=wire error=(unit tang)]
?+ wire
?~ error
~|(behn-bad-wake+wire !!)
(crud %wake u.error)
::
[%auto %one ~]
?~ error
~& %behn-goad
(pass / [%g %goad force=| ~])
:: %goad crashed, wait again, then force
::
~& %behn-goad-retry
%. [/auto/two [%b %wait +(now)]]
pass:(crud %goad u.error)
::
[%auto %two ~]
?~ error
~& %behn-goad-again
(pass / [%g %goad force=& ~])
:: %goad crashed again, bail out
::
~& %behn-goad-fail
(crud %goad u.error)
==
::
2016-11-24 07:25:07 +03:00
++ call :: receive input
|= kyz/task:able
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
$flow +>
$harm +>
2019-11-05 23:58:37 +03:00
$hail auto:(send %hey ~)
2016-11-24 07:25:07 +03:00
$belt (send `dill-belt`p.kyz)
$text (from %out (tuba p.kyz))
$crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
$blew (send %rez p.p.kyz q.p.kyz)
$heft heft
$lyra (dump kyz)
2016-11-24 07:25:07 +03:00
$veer (dump kyz)
$verb (dump kyz)
==
::
++ 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
|= git/gift:able
?> ?=(^ hey.all)
+>(moz [[u.hey.all %give git] moz])
::
++ done :: return gift
|= git/gift:able
+>(moz :_(moz [hen %give git]))
2016-11-24 07:25:07 +03:00
::
2019-11-05 23:34:53 +03:00
++ deal :: pass to %gall
|= [=wire act=agent-action:gall]
(pass wire [%g %deal [our our] ram act])
::
++ pass :: pass note
|= [=wire =note]
+>(moz :_(moz [hen %pass wire note]))
::
2016-11-24 07:25:07 +03:00
++ from :: receive belt
|= bit/dill-blit
^+ +>
?: ?=($mor -.bit)
|- ^+ +>.^$
?~ p.bit +>.^$
$(p.bit t.p.bit, +>.^$ ^$(bit i.p.bit))
?: ?=($out -.bit)
%+ done %blit
:~ [%lin p.bit]
[%mor ~]
[%lin see]
[%hop pos]
==
?: ?=($klr -.bit)
%+ done %blit
:~ [%lin (cvrt:ansi p.bit)]
[%mor ~]
[%lin see]
[%hop pos]
==
?: ?=($pro -.bit)
(done(see p.bit) %blit [[%lin p.bit] [%hop pos] ~])
?: ?=($pom -.bit)
=. see (cvrt:ansi p.bit)
(done %blit [[%lin see] [%hop pos] ~])
?: ?=($hop -.bit)
(done(pos p.bit) %blit [bit ~])
?: ?=($qit -.bit)
(dump %logo ~)
(done %blit [bit ~])
::
++ ansi
|%
++ cvrt :: stub to (list @c)
|= a/stub :: with ANSI codes
^- (list @c)
%- zing %+ turn a
|= a/(pair stye (list @c))
^- (list @c)
;: weld
?: =(0 ~(wyt in p.p.a)) ~
`(list @c)`(zing (turn ~(tap in p.p.a) ef))
2016-11-24 07:25:07 +03:00
(bg p.q.p.a)
(fg q.q.p.a)
q.a
?~(p.p.a ~ (ef ~))
(bg ~)
(fg ~)
==
::
++ ef |=(a/^deco (scap (deco a))) :: ANSI effect
::
++ fg |=(a/^tint (scap (tint a))) :: ANSI foreground
::
++ bg :: ANSI background
|= a/^tint
%- scap
=>((tint a) [+(p) q]) :: (add 10 fg)
::
++ scap :: ANSI escape seq
|= a/$@(@ (pair @ @))
2016-11-24 07:25:07 +03:00
%- (list @c)
:+ 27 '[' :: "\033[{a}m"
?@(a :~(a 'm') :~(p.a q.a 'm'))
::
++ deco :: ANSI effects
|= a/^deco ^- @
?- a
2018-02-10 02:15:32 +03:00
~ '0'
2016-11-24 07:25:07 +03:00
$br '1'
$un '4'
$bl '5'
==
::
++ tint :: ANSI colors (fg)
|= a/^tint
^- (pair @ @)
:- '3'
?- a
$k '0'
$r '1'
$g '2'
$y '3'
$b '4'
$m '5'
$c '6'
$w '7'
~ '9'
2019-11-05 23:58:37 +03:00
==
2016-11-24 07:25:07 +03:00
--
::
++ heft
2019-11-05 23:34:53 +03:00
=< (pass /heft/ames [%a %wegh ~])
=< (pass /heft/behn [%b %wegh ~])
=< (pass /heft/clay [%c %wegh ~])
=< (pass /heft/eyre [%e %wegh ~])
=< (pass /heft/ford [%f %wegh ~])
=< (pass /heft/gall [%g %wegh ~])
=< (pass /heft/iris [%i %wegh ~])
=< (pass /heft/jael [%j %wegh ~])
.
:: XX move
::
++ sein
|= who=ship
;; ship
%- need %- need
2018-12-11 00:22:56 +03:00
%- (sloy-light ski)
2019-08-07 01:42:37 +03:00
[[151 %noun] %j our %sein da+now /(scot %p who)]
2016-11-24 07:25:07 +03:00
::
++ init :: initialize
2019-11-05 23:34:53 +03:00
(pass /merg/home [%c %merg %home our %base 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 ~
2019-11-05 23:34:53 +03:00
=. +> (pass / [%g %conf [[our ram] our %home]])
2018-12-04 09:59:41 +03:00
=. +> (sync %home our %base)
2019-11-05 23:34:53 +03:00
=? +> ?=(?($earl $duke $king) can)
(sync %base (sein our) %kids)
=? +> ?=(?($duke $king $czar) can)
:: make kids desk publicly readable, so syncs work.
::
(show %kids):(sync %kids our %base)
2016-11-24 07:25:07 +03:00
=. +> autoload
=. +> 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)
2019-11-05 23:34:53 +03:00
=. tem `(turn gyl |=(a/gill [%yow a]))
(pass / [%c %warp our %base `[%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
2019-11-05 23:34:53 +03:00
(deal / [%peer /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 ~]])
::
2016-11-24 07:25:07 +03:00
++ sync
|= syn/{desk ship desk}
2019-11-05 23:34:53 +03:00
(deal /sync [%poke %hood-sync -:!>(syn) syn])
2016-11-24 07:25:07 +03:00
::
++ autoload
2019-11-05 23:34:53 +03:00
(deal /autoload [%poke %kiln-start-autoload [%atom %n `~] ~])
2016-11-24 07:25:07 +03:00
::
++ pump :: send diff ack
2019-11-05 23:34:53 +03:00
(deal / [%pump ~])
2016-11-24 07:25:07 +03:00
::
++ take :: receive
2019-11-05 23:58:37 +03:00
|= {tea/wire sih/sign}
2016-11-24 07:25:07 +03:00
^+ +>
?- sih
2019-08-07 01:42:37 +03:00
{?($a $b $c $e $f $g $i $j) $mass *}
2019-01-31 08:11:15 +03:00
(wegh -.sih p.sih)
2016-11-24 07:25:07 +03:00
::
{$a $nice *}
:: ~& [%take-nice-ames sih]
+>
::
2019-08-07 01:42:37 +03:00
[%j %init *]
:: pass thru to unix
::
2016-11-24 07:25:07 +03:00
+>(moz :_(moz [hen %give +.sih]))
::
{$a $send *}
+>(moz :_(moz [hen %give +.sih]))
2016-11-24 07:25:07 +03:00
::
{$g $onto *}
:: ~& [%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
==
::
{$g $unto *}
:: ~& [%take-gall-unto +>.sih]
?- -.+>.sih
$coup ?~(p.p.+>.sih +>.$ (crud %coup u.p.p.+>.sih))
$quit peer
$reap ?~ p.p.+>.sih
+>.$
2016-11-24 07:25:07 +03:00
(dump:(crud %reap u.p.p.+>.sih) %logo ~)
2019-05-09 22:46:19 +03:00
$diff pump:(from ;;(dill-blit q:`vase`+>+>.sih))
$http-response !!
2016-11-24 07:25:07 +03:00
==
::
{$c $note *}
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
2019-05-02 04:21:32 +03:00
{?($b $c) $writ *}
2016-11-24 07:25:07 +03:00
init
2019-02-23 01:11:53 +03:00
::
{$c $mere *}
?: ?=(%& -.p.sih)
mere
(mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih)
::
{$c $mack *}
?~ p.sih +>.$
(mean >%dill-clay-nack< u.p.sih)
2016-11-24 07:25:07 +03:00
::
{$d $blit *}
(done +.sih)
2019-11-05 23:58:37 +03:00
::
{$b $wake *}
(auto-wake tea error.sih)
2016-11-24 07:25:07 +03:00
==
2019-01-31 08:11:15 +03:00
:: +wegh: receive a memory report from a vane and maybe emit full report
2016-11-24 07:25:07 +03:00
::
++ wegh
2019-08-07 01:42:37 +03:00
|= [lal=?(%a %b %c %e %f %g %i %j) mas=mass]
2016-11-24 07:25:07 +03:00
^+ +>
2019-01-31 08:11:15 +03:00
:: update our listing of vane responses with this new one
::
2016-11-24 07:25:07 +03:00
=. hef.all
?- lal
2019-07-04 02:01:45 +03:00
%a ~?(?=(^ a.hef.all) %double-mass-a hef.all(a `mas))
%b ~?(?=(^ b.hef.all) %double-mass-b hef.all(b `mas))
%c ~?(?=(^ c.hef.all) %double-mass-c hef.all(c `mas))
%e ~?(?=(^ e.hef.all) %double-mass-e hef.all(e `mas))
%f ~?(?=(^ f.hef.all) %double-mass-f hef.all(f `mas))
%g ~?(?=(^ g.hef.all) %double-mass-g hef.all(g `mas))
2019-07-04 03:08:23 +03:00
%i ~?(?=(^ i.hef.all) %double-mass-i hef.all(i `mas))
2019-08-07 01:42:37 +03:00
%j ~?(?=(^ j.hef.all) %double-mass-j hef.all(j `mas))
2016-11-24 07:25:07 +03:00
==
2019-01-31 08:11:15 +03:00
:: if not all vanes have responded yet, no-op
::
2016-11-24 07:25:07 +03:00
?. ?& ?=(^ a.hef.all)
?=(^ b.hef.all)
?=(^ c.hef.all)
2019-07-04 02:01:45 +03:00
?=(^ e.hef.all)
2016-11-24 07:25:07 +03:00
?=(^ f.hef.all)
?=(^ g.hef.all)
2019-07-04 03:08:23 +03:00
?=(^ i.hef.all)
2019-01-30 01:41:55 +03:00
?=(^ j.hef.all)
2016-11-24 07:25:07 +03:00
==
+>.$
2019-01-31 08:11:15 +03:00
:: clear vane reports from our state before weighing ourself
::
:: Otherwise, the state of vanes printed after this one get absorbed
:: into Dill's %dot catchall report.
::
2019-07-04 03:08:23 +03:00
=/ ven=(list mass) ~[u.a u.b u.c u.e u.f u.g u.i u.j]:hef.all
2019-03-13 04:13:25 +03:00
=> .(hef.all [~ ~ ~ ~ ~ ~ ~ ~])
2019-01-31 08:11:15 +03:00
:: wegh ourself now that our state doesn't include other masses
::
=/ self=mass
:+ %dill %|
:~ hey+&+hey.all
dug+&+dug.all
dot+&+all
==
:: produce the memory report for all vanes
::
(done %mass %vanes %| [self ven])
2016-11-24 07:25:07 +03:00
--
::
++ 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
type=*
wrapped-task=(hobo task:able)
2016-11-24 07:25:07 +03:00
==
^+ [*(list move) ..^$]
2018-12-03 22:45:50 +03:00
=/ task=task:able
?. ?=(%soft -.wrapped-task)
wrapped-task
2019-05-09 22:46:19 +03:00
;;(task:able p.wrapped-task)
:: 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
2019-08-07 01:42:37 +03:00
((soft $>($?(%dawn %fake) task:able: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. single-home
::
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) 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
::
?: ?=(%knob -.task)
=. veb.all (~(put by veb.all) tag.task level.task)
[~ ..^$]
::
=/ nus (ax hen)
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
2019-11-05 23:58:37 +03:00
=> |%
:: without .dog
::
++ axle-one
$: $1
hey/(unit duct)
dug/(map duct axon)
lit/?
$= hef
$: a/(unit mass)
b/(unit mass)
c/(unit mass)
e/(unit mass)
f/(unit mass)
g/(unit mass)
i/(unit mass)
j/(unit mass)
==
$= veb
$~ (~(put by *(map @tas log-level)) %hole %soft)
(map @tas log-level)
==
::
++ axle-both
$%(axle-one axle)
--
::
|= old=axle-both
?- -.old
%1 $(old [%2 [hey dug lit dog=& hef veb]:old])
%2 ..^$(all old)
==
2016-11-24 07:25:07 +03:00
::
++ scry
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
^- (unit (unit cage))
2018-03-19 06:54:47 +03:00
?. ?=(%& -.why) ~
2016-11-24 07:25:07 +03:00
=* his p.why
[~ ~]
::
++ stay all
2016-11-24 07:25:07 +03:00
::
++ take :: process move
|= {tea/wire hen/duct hin/(hypo sign)}
^+ [*(list move) ..^$]
=/ nus (ax hen)
?~ nus
2018-12-12 09:50:53 +03:00
:: :hen is an unrecognized duct
:: could be before %boot (or %boot failed)
::
~& [%dill-take-no-flow hen -.q.hin +<.q.hin]
2016-11-24 07:25:07 +03:00
[~ ..^$]
2019-11-05 23:58:37 +03:00
=^ moz all abet:(take:u.nus tea q.hin)
2016-11-24 07:25:07 +03:00
[moz ..^$]
--