@@ -1,3 +1,4 @@
1+/% kelvin %kelvin
12=, clay
23=* dude dude:gall
34|%
@@ -16,144 +17,192 @@
1617::
1718+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
1819+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
20+:: +truncate-hash: get last 5 digits of hash and convert to tape
21+::
22+++ truncate-hash
23+ |= hash=@uv
24+ ^- tape
25+ (slag 2 <`@uv`(mod hash 0v1.00000)>)
26+:: +report-prep: get data required for reports
27+::
28+++ report-prep
29+ |= [our=@p now=@da]
30+ =/ ego (scot %p our)
31+ =/ wen (scot %da now)
32+ :* .^(rock:tire %cx /[ego]//[wen]/tire)
33+ .^(=cone %cx /[ego]//[wen]/domes)
34+ .^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
35+ .^ (map [desk ship desk] sync-state) %gx
36+ /[ego]/hood/[wen]/kiln/syncs/noun
37+ ==
38+ ==
39+:: +report-vats: report on all desk installations
40+::
1941++ report-vats
20− =| $: =cone
21− sor=(map desk [ship desk])
22− zyn=(map [desk ship desk] sync-state)
23− desks=(set desk)
24− =pikes
25− =rock:tire:clay
26− kel=weft
42+ |= [our=@p now=@da desks=(list desk) filt=@tas verb=?]
43+ ^- tang
44+ =/ ego (scot %p our)
45+ =/ wen (scot %da now)
46+ =/ prep (report-prep our now)
47+ ?~ filt
48+ %- zing
49+ %+ turn (flop desks)
50+ |=(syd=@tas (report-vat prep our now syd verb))
51+ =/ deks
52+ ?~ desks
53+ %+ sort
54+ (sort ~(tap in -.prep) |=([[a=@ *] b=@ *] !(aor a b)))
55+ |=([[a=@ *] [b=@ *]] ?|(=(a %kids) =(b %base)))
56+ %+ skip ~(tap in -.prep)
57+ |=([syd=@tas *] =(~ (find ~[syd] desks)))
58+ ?: =(filt %blocking)
59+ =/ base-wic
60+ %+ sort ~(tap by wic:(~(got by -.prep) %base))
61+ |=([[* a=@ud] [* b=@ud]] (gth a b))
62+ ?~ base-wic ~[leaf+"%base already up-to-date"]
63+ =/ blockers=(list desk)
64+ %+ turn
65+ %+ skip ~(tap in -.prep)
66+ |= [* [zest=@tas wic=(set weft)]]
67+ ?. =(zest %live) &
68+ (~(has in wic) i.base-wic)
69+ |=([syd=desk *] syd)
70+ ?~ blockers ~[leaf+"No desks blocking upgrade, run |bump to apply"]
71+ :- [%rose [" %" "To unblock upgrade run |suspend %" ""] blockers]
72+ %- zing
73+ %+ turn (flop blockers)
74+ |=(syd=desk (report-vat prep our now syd verb))
75+ ::
76+ %- zing
77+ %+ turn
78+ ?+ filt !!
79+ ::
80+ %exists
81+ %+ skip deks
82+ |=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
83+ ::
84+ %running
85+ %+ skim deks
86+ |=([* [zest=@tas *]] =(zest %live))
87+ ::
88+ %suspended
89+ %+ skip deks
90+ |= [syd=@tas [zest=@tas *]]
91+ ?| =(syd %kids)
92+ =(zest %live)
93+ =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0)
2794 ==
28− |_ [our=@p now=@da]
29− +* ego (scot %p our)
30− wen (scot %da now)
31− ++ $
32− |= [? ? ? ? ?]
33− (report-vats:abed +<)
34− ++ abed
35− %= ..abed
36− cone .^(^cone %cx /[ego]//[wen]/domes)
37− sor .^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
38− zyn .^ (map [desk ship desk] sync-state) %gx
39− /[ego]/hood/[wen]/kiln/syncs/noun
40− ==
41− desks .^((set desk) %cd /[ego]/base/[wen])
42− pikes .^(^pikes %gx /[ego]/hood/[wen]/kiln/pikes/kiln-pikes)
43− rock .^(rock:tire:clay %cx /[ego]//[wen]/tire)
44− kel (weft .^(* cx/(en-beam [our %base da+now] /sys/kelvin)))
95+ ::
96+ %exists-not
97+ %+ skim deks
98+ |=([syd=desk *] =(ud:.^(cass %cw /[ego]/[syd]/[wen]) 0))
4599 ==
46− ++ vat-info
47− |= desk=_`desk`%base
48− =/ pike (~(got by pikes) desk)
49− =/ zest -:(~(got by rock) desk)
50− =/ kel-path /[ego]/[desk]/[wen]/sys/kelvin
51− =/ sink=sink
52− ?~ s=(~(get by sor) desk)
53− ~
54− ?~ z=(~(get by zyn) desk u.s)
55− ~
56− `[-.u.s +.u.s +.u.z]
57− =/ hash .^(@uv %cz /[ego]/[desk]/[wen])
58− =/ dek (~(got by rock) desk)
59− =/ =dome (~(got by cone) our desk)
60− =+ .^(=waft %cx kel-path)
61− :* &1 &2 &3 &4 &5 &6 &7 &8
62− desk=desk
63− ^= running =(%live zest)
64− ^= suspended =(%dead zest)
65− ^= exists !=(ud.cass 0):.^(=cass %cw /[ego]/[desk]/[wen])
66− ^= bad-desk ?!(.^(? %cu kel-path))
67− ^= meb :: =(list @uv)
68− ?~ sink [hash]~
69− (mergebase-hashes our desk now her.u.sink sud.u.sink)
70− ^- [on=(list [@tas ?]) of=(list [@tas ?])]
71− (skid ~(tap by ren.dome) |=([* ?] +<+))
72− ^= sat
73− ?- zest.dek
74− %live "running"
75− %dead "suspended"
76− %held "suspended until next update"
100+ |=([syd=desk *] (report-vat prep our now syd verb))
101+:: +report-vat: report on a single desk installation
102+::
103+++ report-vat
104+ |= $: $: tyr=rock:tire =cone sor=(map desk [ship desk])
105+ zyn=(map [desk ship desk] sync-state)
77106 ==
78− ^- kul=tape
79− %+ roll
80− %+ sort
81− ~(tap in (waft-to-wefts:clay waft))
82− |= [a=weft b=weft]
83− ?: =(lal.a lal.b)
84− (lte num.a num.b)
85− (lte lal.a lal.b)
86− |= [=weft =tape]
87− (welp " {<[lal num]:weft>}" tape)
88− ^= blocking
89− ?& !=(%base desk)
90− !=(%live zest.pike)
91− !(~(has in wic.pike) kel)
92− == ==
93− ++ report-vats
94− |= $: verb=?
95− show-suspended=?
96− show-running=?
97− show-blocking=?
98− show-nonexistent=?
99− ==
100− %+ turn
101− %+ skim
102− %+ turn ~(tap in desks)
103− |= =desk (vat-info desk)
104− |= vat-info
105− :: just unconditionally show "bad" desks, whatever that means
106− ?| bad-desk
107− &(suspended show-suspended)
108− &(running show-running)
109− &(blocking show-blocking)
110− &(!exists show-nonexistent)
107+ our=ship now=@da syd=desk verb=?
111108 ==
112− |= =vat-info
113− :+ %rose [" " " " "::"]
114− :- leaf+"{<desk.vat-info>}"
115− %- flop
116− %- report-vat
117− [verb vat-info]
118− ++ report-vat
119− |= [verb=? vat-info]
120− ^- tang
121− ?: !exists
122− ~[leaf+"desk does not yet exist: {<desk>}"]
123− ?: =(%kids desk)
124− ~[leaf+"%kids %cz hash: {<hash>}"]
125− ?: bad-desk
126− ~[leaf+"bad desk: {<desk>}"]
127− %- flop
128− ?. verb
129− :~ leaf/"/sys/kelvin: {kul}"
130− leaf/"app status: {sat}"
131− leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}"
132− leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
133− ==
134− :~ leaf/"/sys/kelvin: {kul}"
135− leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
136− leaf/"%cz hash: {<hash>}"
137− ::
138− leaf/"app status: {sat}"
139− leaf/"force on: {?:(=(~ on) "~" <on>)}"
140− leaf/"force off: {?:(=(~ of) "~" <of>)}"
141− ::
142− leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}"
143− leaf/"updates: {?~(sink "local" "remote")}"
144− leaf/"source ship: {?~(sink <~> <her.u.sink>)}"
145− leaf/"source desk: {?~(sink <~> <sud.u.sink>)}"
146− leaf/"source aeon: {?~(sink <~> <let.u.sink>)}"
147− leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> <u.kid.u.sink>))}"
148− leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
109+ ^- tang
110+ =- :: hack to force wrapped rendering
111+ ::
112+ :: edg=6 empirically prevents dedent
113+ ::
114+ %+ roll
115+ (~(win re -) [0 6])
116+ |=([a=tape b=(list @t)] [(crip a) b])
117+ ::
118+ ^- tank
119+ =/ ego (scot %p our)
120+ =/ wen (scot %da now)
121+ =+ .^(=cass %cw /[ego]/[syd]/[wen])
122+ ?: =(ud.cass 0)
123+ leaf+"desk does not yet exist: {<syd>}"
124+ ?: =(%kids syd)
125+ =+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
126+ leaf+"%kids %cz hash: {<hash>}"
127+ =/ kel-path
128+ /[ego]/[syd]/[wen]/sys/kelvin
129+ ?. .^(? %cu kel-path)
130+ leaf+"bad desk: {<syd>}"
131+ =+ .^(=waft %cx kel-path)
132+ :+ %rose ["" "{<syd>}" "::"]
133+ ^- tang
134+ =/ hash .^(@uv %cz /[ego]/[syd]/[wen])
135+ =/ =sink
136+ ?~ s=(~(get by sor) syd)
137+ ~
138+ ?~ z=(~(get by zyn) syd u.s)
139+ ~
140+ `[-.u.s +.u.s +.u.z]
141+ =/ meb=(list @uv)
142+ ?~ sink [hash]~
143+ (mergebase-hashes our syd now her.u.sink sud.u.sink)
144+ =/ dek (~(got by tyr) syd)
145+ =/ sat
146+ ?- zest.dek
147+ %live "running"
148+ %dead "suspended"
149+ %held "suspended until next update"
149150 ==
150− ++ report-kids
151− ^- tank
152− ?. (~(has in .^((set desk) %cd /[ego]//[wen])) %kids)
153− leaf/"no %kids desk"
154− =+ .^(hash=@uv %cz /[ego]/kids/[wen])
155− leaf/"%kids %cz hash: {<hash>}"
156− --
151+ =/ kul=tape
152+ %+ roll
153+ %+ sort
154+ ~(tap in (waft-to-wefts:clay waft))
155+ |= [a=weft b=weft]
156+ ?: =(lal.a lal.b)
157+ (lte num.a num.b)
158+ (lte lal.a lal.b)
159+ |= [=weft =tape]
160+ (welp " {<[lal num]:weft>}" tape)
161+ ?. verb
162+ =/ cut=(list tape) (turn meb truncate-hash)
163+ =/ len (lent cut)
164+ =/ base-hash
165+ ?: =(0 len) "~"
166+ ?: =(1 len) (head cut)
167+ "~[{`tape`(zing (join " " `(list tape)`cut))}]"
168+ :~ leaf/"/sys/kelvin: {kul}"
169+ leaf/"base hash ends in: {base-hash}"
170+ leaf/"%cz hash ends in: {(truncate-hash hash)}"
171+ leaf/"app status: {sat}"
172+ leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
173+ ==
174+ ::
175+ =/ [on=(list [@tas ?]) of=(list [@tas ?])]
176+ =/ =dome (~(got by cone) our syd)
177+ (skid ~(tap by ren.dome) |=([* ?] +<+))
178+ :~ leaf/"/sys/kelvin: {kul}"
179+ leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
180+ leaf/"%cz hash: {<hash>}"
181+ ::
182+ leaf/"app status: {sat}"
183+ leaf/"force on: {<(sort (turn on head) aor)>}"
184+ leaf/"force off: {<(sort (turn of head) aor)>}"
185+ ::
186+ leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}"
187+ leaf/"updates: {?~(sink "local" "remote")}"
188+ leaf/"source ship: {?~(sink <~> <her.u.sink>)}"
189+ leaf/"source desk: {?~(sink <~> <sud.u.sink>)}"
190+ leaf/"source aeon: {?~(sink <~> <let.u.sink>)}"
191+ leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> <u.kid.u.sink>))}"
192+ leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
193+ ==
194+:: +report-kids: non-vat cz hash report for kids desk
195+::
196+++ report-kids
197+ |= [our=ship now=@da]
198+ ^- tank
199+ =/ syd %kids
200+ =/ ego (scot %p our)
201+ =/ wen (scot %da now)
202+ ?. (~(has in .^((set desk) %cd /[ego]//[wen])) syd)
203+ leaf/"no %kids desk"
204+ =+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
205+ leaf/"%kids %cz hash: {<hash>}"
157206:: +read-bill-foreign: read /desk/bill from a foreign desk
158207::
159208++ read-bill-foreign
@@ -206,7 +255,7 @@
206255 |= [our=ship =desk now=@da]
207256 ^- (list [=dude live=?])
208257 %~ tap in
209− .^((set [=dude live=?]) ge+/(scot %p our)/[desk]/(scot %da now))
258+ .^((set [=dude live=?]) ge+/(scot %p our)/[desk]/(scot %da now)/$)
210259::
211260++ mergebase-hashes
212261 |= [our=@p syd=desk now=@da her=ship sud=desk]