ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-18 12:22:10 +03:00
Code Issues Packages Projects Releases Wiki Activity

hood: options for +vats generator

Browse Source 
This commit refactors `sur/hood.hoon` and changes the signature of the
`+vats` generator thus:

```hoon
|=  $:  [now=@da eny=@uvJ bec=beak]
        $@(~ [?(%suspended %running %blocking %nonexistent) ~])
        $:  verb=?
            show-suspended=?
            show-running=?
            show-blocking=?
            show-nonexistent=?
        ==
    ==
```

Called with a single positional argument, `+vats` will show only those
desks fitting the description given, while keyword parameters allow
finer-grained control over which desks are described. The `verb`
parameter determines whether the full load of desk information be shown,
or a subset thereof.

Resolves #6297.
This commit is contained in:
James D. Amberger 2023-03-20 17:59:27 -04:00
parent e365a58a98
commit 821f99a351
3 changed files with 158 additions and 105 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkg/arvo/gen/vat.hoon
View File

@ -1,6 +1,11 @@
/- *hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
[syd=desk ~]
verb=?
==
[%tang ~[(report-vat (report-prep p.bec now) p.bec now desk)]]
=+ ~(abed report-vats p.bec now)
=+ %+ report-vat
verb
%- vat-info syd
[%tang -]

18
pkg/arvo/gen/vats.hoon
View File

@ -1,6 +1,20 @@
/- *hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=~ ~]
$@(~ [?(%suspended %running %blocking %nonexistent) ~])
$: verb=?
show-suspended=?
show-running=?
show-blocking=?
show-nonexistent=?
==
==
[%tang (report-vats p.bec now)]
=+ :- verb
?~ +<+< +<+>+
?- -.+<+<
%suspended [& | | |]
%running [| & | |]
%blocking [| | & |]
%nonexistent [| | | &]
==
tang+((report-vats p.bec now) -)

236
pkg/base-dev/sur/hood.hoon
View File

@ -16,110 +16,144 @@
::
+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
:: +report-prep: get data required for reports
::
++ report-prep
|= [our=@p now=@da]
=/ ego (scot %p our)
=/ wen (scot %da now)
:* .^(rock:tire %cx /(scot %p our)//(scot %da now)/tire)
.^(=cone %cx /(scot %p our)//(scot %da now)/domes)
.^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
.^ (map [desk ship desk] sync-state) %gx
/[ego]/hood/[wen]/kiln/syncs/noun
==
==
:: +report-vats: report on all desk installations
::
++ report-vats
|= [our=@p now=@da]
^- tang
=/ desks .^((set desk) %cd /(scot %p our)/base/(scot %da now))
=/ prep (report-prep our now)
%+ turn ~(tap in desks)
|=(syd=desk (report-vat prep our now syd))
:: +report-vat: report on a single desk installation
::
++ report-vat
|= $: $: tyr=rock:tire =cone sor=(map desk [ship desk])
zyn=(map [desk ship desk] sync-state)
==
our=ship now=@da syd=desk
=| $: =cone
sor=(map desk [ship desk])
zyn=(map [desk ship desk] sync-state)
desks=(set desk)
=pikes
=rock:tire:clay
kel=weft
==
^- tank
=/ ego (scot %p our)
=/ wen (scot %da now)
=+ .^(=cass %cw /[ego]/[syd]/[wen])
?: =(ud.cass 0)
leaf+"desk does not yet exist: {<syd>}"
?: =(%kids syd)
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
leaf+"%kids %cz hash: {<hash>}"
=/ kel-path
/[ego]/[syd]/[wen]/sys/kelvin
?. .^(? %cu kel-path)
leaf+"bad desk: {<syd>}"
=+ .^(=waft %cx kel-path)
:+ %rose ["" "{<syd>}" "::"]
^- tang
=/ hash .^(@uv %cz /[ego]/[syd]/[wen])
=/ =sink
?~ s=(~(get by sor) syd)
~
?~ z=(~(get by zyn) syd u.s)
~
`[-.u.s +.u.s +.u.z]
=/ meb=(list @uv)
?~ sink [hash]~
(mergebase-hashes our syd now her.u.sink sud.u.sink)
=/ dek (~(got by tyr) syd)
=/ =dome (~(got by cone) our syd)
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
(skid ~(tap by ren.dome) |=([* ?] +<+))
=/ sat
?- zest.dek
%live "running"
%dead "suspended"
%held "suspended until next update"
|_ [our=@p now=@da]
+* ego (scot %p our)
wen (scot %da now)
++ $
|= [? ? ? ? ?]
(report-vats:abed +<)
++ abed
%= ..abed
cone .^(^cone %cx /[ego]//[wen]/domes)
sor .^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
zyn .^ (map [desk ship desk] sync-state) %gx
/[ego]/hood/[wen]/kiln/syncs/noun
==
desks .^((set desk) %cd /[ego]/base/[wen])
pikes .^(^pikes %gx /[ego]/hood/[wen]/kiln/pikes/kiln-pikes)
rock .^(rock:tire:clay %cx /[ego]//[wen]/tire)
kel (weft .^(* cx/(en-beam [our %base da+now] /sys/kelvin)))
==
=/ kul=tape
%+ roll
%+ sort
~(tap in (waft-to-wefts:clay waft))
|= [a=weft b=weft]
?: =(lal.a lal.b)
(lte num.a num.b)
(lte lal.a lal.b)
|= [=weft =tape]
(welp " {<[lal num]:weft>}" tape)
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
leaf/"%cz hash: {<hash>}"
::
leaf/"app status: {sat}"
leaf/"force on: {?:(=(~ on) "~" <on>)}"
leaf/"force off: {?:(=(~ of) "~" <of>)}"
::
leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}"
leaf/"updates: {?~(sink "local" "remote")}"
leaf/"source ship: {?~(sink <~> <her.u.sink>)}"
leaf/"source desk: {?~(sink <~> <sud.u.sink>)}"
leaf/"source aeon: {?~(sink <~> <let.u.sink>)}"
leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> <u.kid.u.sink>))}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
:: +report-kids: non-vat cz hash report for kids desk
::
++ report-kids
|= [our=ship now=@da]
^- tank
=/ syd %kids
=/ ego (scot %p our)
=/ wen (scot %da now)
?. (~(has in .^((set desk) %cd /[ego]//[wen])) syd)
leaf/"no %kids desk"
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
leaf/"%kids %cz hash: {<hash>}"
++ vat-info
|= desk=_`desk`%base
=/ pike (~(got by pikes) desk)
=/ zest -:(~(got by rock) desk)
=/ kel-path /[ego]/[desk]/[wen]/sys/kelvin
=/ sink=sink
?~ s=(~(get by sor) desk)
~
?~ z=(~(get by zyn) desk u.s)
~
`[-.u.s +.u.s +.u.z]
=/ hash .^(@uv %cz /[ego]/[desk]/[wen])
=/ dek (~(got by rock) desk)
=/ =dome (~(got by cone) our desk)
=+ .^(=waft %cx kel-path)
:* &1 &2 &3 &4 &5 &6 &7 &8
desk=desk
^= running =(%live zest)
^= suspended =(%dead zest)
^= exists !=(ud.cass 0):.^(=cass %cw /[ego]/[desk]/[wen])
^= bad-desk ?!(.^(? %cu kel-path))
^= meb :: =(list @uv)
?~ sink [hash]~
(mergebase-hashes our desk now her.u.sink sud.u.sink)
^- [on=(list [@tas ?]) of=(list [@tas ?])]
(skid ~(tap by ren.dome) |=([* ?] +<+))
^= sat
?- zest.dek
%live "running"
%dead "suspended"
%held "suspended until next update"
==
^- kul=tape
%+ roll
%+ sort
~(tap in (waft-to-wefts:clay waft))
|= [a=weft b=weft]
?: =(lal.a lal.b)
(lte num.a num.b)
(lte lal.a lal.b)
|= [=weft =tape]
(welp " {<[lal num]:weft>}" tape)
^= blocking
?& !=(%base desk)
!=(%live zest.pike)
!(~(has in wic.pike) kel)
== ==
++ report-vats
|= $: verb=?
show-suspended=?
show-running=?
show-blocking=?
show-nonexistent=?
==
%+ turn
%+ skim
%+ turn ~(tap in desks)
|= =desk (vat-info desk)
|= vat-info
:: just unconditionally show "bad" desks, whatever that means
?| bad-desk
&(suspended show-suspended)
&(running show-running)
&(blocking show-blocking)
&(!exists show-nonexistent)
==
|= =vat-info
:+ %rose [" " " " "::"]
:- leaf+"{<desk.vat-info>}"
%- flop
%- report-vat
[verb vat-info]
++ report-vat
|= [verb=? vat-info]
^- tang
?: !exists
~[leaf+"desk does not yet exist: {<desk>}"]
?: =(%kids desk)
~[leaf+"%kids %cz hash: {<hash>}"]
?: bad-desk
~[leaf+"bad desk: {<desk>}"]
%- flop
?. verb
:~ leaf/"/sys/kelvin: {kul}"
leaf/"app status: {sat}"
leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
leaf/"%cz hash: {<hash>}"
::
leaf/"app status: {sat}"
leaf/"force on: {?:(=(~ on) "~" <on>)}"
leaf/"force off: {?:(=(~ of) "~" <of>)}"
::
leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}"
leaf/"updates: {?~(sink "local" "remote")}"
leaf/"source ship: {?~(sink <~> <her.u.sink>)}"
leaf/"source desk: {?~(sink <~> <sud.u.sink>)}"
leaf/"source aeon: {?~(sink <~> <let.u.sink>)}"
leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> <u.kid.u.sink>))}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
++ report-kids
^- tank
?. (~(has in .^((set desk) %cd /[ego]//[wen])) %kids)
leaf/"no %kids desk"
=+ .^(hash=@uv %cz /[ego]/kids/[wen])
leaf/"%kids %cz hash: {<hash>}"
--
:: +read-bill-foreign: read /desk/bill from a foreign desk
::
++ read-bill-foreign