shrub/pkg/arvo/lib/hood/kiln.hoon

777 lines
26 KiB
Plaintext
Raw Normal View History

:: :: ::
2017-11-29 23:40:44 +03:00
:::: /hoon/kiln/hood/lib :: ::
2015-05-12 03:31:37 +03:00
:: :: ::
/? 310 :: version
:: :: ::
:::: :: ::
:: :: ::
=, clay
2016-12-02 02:59:17 +03:00
=, space:userlib
=, format
2015-05-12 03:31:37 +03:00
|% :: ::
2017-11-30 00:29:35 +03:00
++ part {$kiln $0 pith} :: kiln state
++ pith :: ::
$: rem/(map desk per-desk) ::
2019-11-14 21:39:50 +03:00
syn/(map kiln-sync let/@ud) ::
2016-12-03 00:41:06 +03:00
autoload-on/? ::
cur-hoon/@uvI ::
2016-12-12 21:08:46 +03:00
cur-arvo/@uvI ::
cur-zuse/@uvI ::
cur-vanes/(map @tas @uvI) ::
2019-08-25 12:00:26 +03:00
commit-timer/{way/wire nex/@da tim/@dr mon=term}
2015-05-26 04:20:45 +03:00
== ::
2017-11-30 00:29:35 +03:00
++ per-desk :: per-desk state
2015-12-20 23:50:45 +03:00
$: auto/? :: escalate on failure
gem/germ :: strategy
her/@p :: from ship
sud/@tas :: from desk
cas/case :: at case
2015-05-12 03:31:37 +03:00
== ::
:: :: ::
:::: :: ::
:: :: ::
2017-01-12 18:50:35 +03:00
++ kiln-commit term ::
++ kiln-mount ::
2015-12-20 23:50:45 +03:00
$: pax/path ::
pot/term ::
2015-05-12 03:31:37 +03:00
== ::
++ kiln-unmount $@(term {knot path}) ::
++ kiln-sync ::
2015-12-20 23:50:45 +03:00
$: syd/desk ::
her/ship ::
sud/desk ::
2015-05-12 03:31:37 +03:00
== ::
++ kiln-unsync ::
2015-12-20 23:50:45 +03:00
$: syd/desk ::
her/ship ::
sud/desk ::
2015-06-04 00:18:13 +03:00
== ::
++ kiln-merge ::
2015-12-20 23:50:45 +03:00
$: syd/desk ::
ali/ship ::
sud/desk ::
cas/case ::
2015-12-20 23:50:45 +03:00
gim/?($auto germ) ::
2015-05-12 03:31:37 +03:00
== ::
-- ::
:: :: ::
:::: :: ::
2016-11-17 04:42:58 +03:00
:: :: ::
2019-11-19 07:36:21 +03:00
|= {bowl:gall part} :: main kiln work
2015-09-02 01:20:17 +03:00
?> =(src our)
2019-11-19 07:36:21 +03:00
|_ moz/(list card:agent:gall)
2015-12-09 04:54:26 +03:00
++ abet :: resolve
2017-11-30 00:29:35 +03:00
[(flop moz) `part`+<+.$]
2015-09-02 01:20:17 +03:00
::
2019-11-14 21:39:50 +03:00
++ emit
2019-11-19 07:36:21 +03:00
|= card:agent:gall
2019-11-14 21:39:50 +03:00
%_(+> moz [+< moz])
::
++ emil :: return cards
2019-11-19 07:36:21 +03:00
|= (list card:agent:gall)
2015-09-02 01:20:17 +03:00
^+ +>
?~(+< +> $(+< t.+<, +> (emit i.+<)))
::
++ render
2015-12-20 23:50:45 +03:00
|= {mez/tape sud/desk who/ship syd/desk}
2015-12-21 00:16:39 +03:00
:^ %palm [" " ~ ~ ~] leaf+mez
~[leaf+"from {<sud>}" leaf+"on {<who>}" leaf+"to {<syd>}"]
2015-09-02 01:20:17 +03:00
::
2017-01-12 18:50:35 +03:00
++ poke-commit
2020-01-29 21:42:52 +03:00
|= [mon/kiln-commit auto=?]
=< abet
=. +>.$ (emit %pass /commit %arvo %c [%dirk mon])
?. auto
+>.$
=/ recur ~s1
=. commit-timer
[/kiln/autocommit (add now recur) recur mon]
(emit %pass way.commit-timer %arvo %b [%wait nex.commit-timer])
::
++ poke-autocommit
2019-08-25 12:00:26 +03:00
|= [mon/kiln-commit auto=?]
=< abet
2019-11-14 21:39:50 +03:00
=. +>.$ (emit %pass /commit %arvo %c [%dirk mon])
2019-08-25 12:00:26 +03:00
?. auto
+>.$
=/ recur ~s1
=. commit-timer
[/kiln/autocommit (add now recur) recur mon]
2019-11-14 21:39:50 +03:00
(emit %pass way.commit-timer %arvo %b [%wait nex.commit-timer])
2019-08-25 12:00:26 +03:00
::
++ poke-cancel-autocommit
|= ~
2019-11-14 21:39:50 +03:00
abet:(emit %pass way.commit-timer %arvo %b [%rest nex.commit-timer])
2017-01-12 18:50:35 +03:00
::
2015-09-02 01:20:17 +03:00
++ poke-mount
|= kiln-mount
2016-12-02 02:59:17 +03:00
=+ bem=(de-beam pax)
2015-09-02 01:20:17 +03:00
?~ bem
=+ "can't mount bad path: {<pax>}"
2015-12-21 00:16:39 +03:00
abet:(spam leaf+- ~)
2019-11-14 21:39:50 +03:00
abet:(emit %pass /mount %arvo %c [%mont pot u.bem])
2015-09-02 01:20:17 +03:00
::
++ poke-unmount
2015-12-20 23:50:45 +03:00
|= mon/kiln-unmount
2015-09-02 01:20:17 +03:00
?^ mon
2016-12-02 02:59:17 +03:00
=+ bem=(de-beam mon)
2015-06-12 06:52:42 +03:00
?~ bem
2015-09-02 01:20:17 +03:00
=+ "can't unmount bad path: {<mon>}"
2015-12-21 00:16:39 +03:00
abet:(spam leaf+- ~)
2019-11-14 21:39:50 +03:00
abet:(emit %pass /unmount-beam %arvo %c [%ogre [[p q r] s]:u.bem])
abet:(emit %pass /unmount-point %arvo %c [%ogre mon])
2015-09-02 01:20:17 +03:00
::
2016-01-07 01:08:46 +03:00
++ poke-track ::
2016-02-01 09:16:26 +03:00
|= hos/kiln-sync
2016-01-07 01:08:46 +03:00
?: (~(has by syn) hos)
abet:(spam (render "already tracking" [sud her syd]:hos) ~)
2016-01-07 01:08:46 +03:00
abet:abet:start-track:(auto hos)
::
2015-09-02 01:20:17 +03:00
++ poke-sync ::
2015-12-20 23:50:45 +03:00
|= hos/kiln-sync
2015-09-02 01:20:17 +03:00
?: (~(has by syn) hos)
abet:(spam (render "already syncing" [sud her syd]:hos) ~)
2018-12-04 09:59:41 +03:00
abet:abet:start-sync:(auto hos)
2016-02-26 02:19:44 +03:00
::
2016-09-08 20:07:55 +03:00
++ poke-syncs :: print sync config
2018-03-19 07:18:20 +03:00
|= ~
=< abet %- spam
2016-09-08 20:07:55 +03:00
?: =(0 ~(wyt by syn))
[%leaf "no syncs configured"]~
%+ turn ~(tap in ~(key by syn))
2016-09-08 20:07:55 +03:00
|=(a/kiln-sync (render "sync configured" [sud her syd]:a))
::
2015-09-02 01:20:17 +03:00
++ poke-unsync ::
2015-12-20 23:50:45 +03:00
|= hus/kiln-unsync
2015-09-02 01:20:17 +03:00
?. (~(has by syn) hus)
abet:(spam (render "not syncing" [sud her syd]:hus) ~)
%* . abet:abet:stop:(auto hus)
syn (~(del by syn) hus)
==
::
++ poke-merge ::
|= kiln-merge
2016-01-07 01:08:46 +03:00
abet:abet:(merge:(work syd) ali sud cas gim)
2015-09-02 01:20:17 +03:00
::
2015-09-16 03:24:44 +03:00
++ poke-cancel
|= ~
abet:(emit %pass /cancel %arvo %c [%drop %foo])
2015-09-16 03:24:44 +03:00
::
2016-05-07 02:21:29 +03:00
++ poke-info
|= {mez/tape tor/(unit toro)}
?~ tor
abet:(spam leaf+mez ~)
2019-11-14 21:39:50 +03:00
abet:(emit:(spam leaf+mez ~) %pass /kiln %arvo %c [%info u.tor])
2015-09-02 01:20:17 +03:00
::
++ poke-rm
|= a/path
=+ b=.^(arch %cy a)
?~ fil.b
=+ ~[leaf+"No such file:" leaf+"{<a>}"]
abet:(spam -)
(poke-info "removed" `(fray a))
::
2015-09-02 01:20:17 +03:00
++ poke-label
2015-12-20 23:50:45 +03:00
|= {syd/desk lab/@tas}
2015-09-02 01:20:17 +03:00
=+ pax=/(scot %p our)/[syd]/[lab]
(poke-info "labeled {(spud pax)}" `[syd %| lab])
2015-09-02 01:20:17 +03:00
::
++ poke-schedule
2015-12-20 23:50:45 +03:00
|= {where/path tym/@da eve/@t}
2015-09-02 01:20:17 +03:00
=. where (welp where /sched)
2016-05-07 02:21:29 +03:00
%+ poke-info "scheduled"
2015-12-09 04:54:26 +03:00
=+ old=;;((map @da cord) (fall (file where) ~))
`(foal where %sched !>((~(put by old) tym eve)))
2015-09-02 01:20:17 +03:00
::
++ poke-permission
|= {syd/desk pax/path pub/?}
=< abet
2018-12-13 20:56:56 +03:00
%- emit
2019-11-14 21:39:50 +03:00
=/ =rite [%r ~ ?:(pub %black %white) ~]
[%pass /kiln/permission %arvo %c [%perm syd pax rite]]
::
2016-12-03 00:41:06 +03:00
++ poke-autoload |=(lod/(unit ?) abet:(poke:autoload lod))
2018-03-19 07:18:20 +03:00
++ poke-start-autoload |=(~ abet:start:autoload)
2019-11-14 21:39:50 +03:00
++ poke
|= [=mark =vase]
?+ mark ~|([%poke-kiln-bad-mark mark] !!)
%kiln-commit =;(f (f !<(_+<.f vase)) poke-commit)
2020-01-29 21:42:52 +03:00
%kiln-autocommit =;(f (f !<(_+<.f vase)) poke-autocommit)
2019-11-14 21:39:50 +03:00
%kiln-info =;(f (f !<(_+<.f vase)) poke-info)
%kiln-label =;(f (f !<(_+<.f vase)) poke-label)
%kiln-cancel =;(f (f !<(_+<.f vase)) poke-cancel)
%kiln-mount =;(f (f !<(_+<.f vase)) poke-mount)
%kiln-rm =;(f (f !<(_+<.f vase)) poke-rm)
%kiln-schedule =;(f (f !<(_+<.f vase)) poke-schedule)
%kiln-track =;(f (f !<(_+<.f vase)) poke-track)
%kiln-sync =;(f (f !<(_+<.f vase)) poke-sync)
%kiln-syncs =;(f (f !<(_+<.f vase)) poke-syncs)
%kiln-wipe-ford =;(f (f !<(_+<.f vase)) poke-wipe-ford)
%kiln-keep-ford =;(f (f !<(_+<.f vase)) poke-keep-ford)
%kiln-autoload =;(f (f !<(_+<.f vase)) poke-autoload)
%kiln-overload =;(f (f !<(_+<.f vase)) poke-overload)
2020-04-21 05:55:40 +03:00
%kiln-goad-gall =;(f (f !<(_+<.f vase)) poke-goad-gall)
2019-11-14 21:39:50 +03:00
%kiln-unmount =;(f (f !<(_+<.f vase)) poke-unmount)
%kiln-unsync =;(f (f !<(_+<.f vase)) poke-unsync)
%kiln-permission =;(f (f !<(_+<.f vase)) poke-permission)
%kiln-cancel-autocommit =;(f (f !<(_+<.f vase)) poke-cancel-autocommit)
%kiln-start-autoload =;(f (f !<(_+<.f vase)) poke-start-autoload)
%kiln-merge =;(f (f !<(_+<.f vase)) poke-merge)
==
2015-09-17 02:40:53 +03:00
::
2016-12-03 00:41:06 +03:00
++ autoload
|%
2019-11-14 21:39:50 +03:00
++ emit
2019-11-19 07:36:21 +03:00
|= a/card:agent:gall
2019-11-14 21:39:50 +03:00
+>(..autoload (^emit a))
::
2016-12-03 00:41:06 +03:00
++ tracked-vanes
^- (list @tas)
2019-11-27 11:25:56 +03:00
~[%ames %behn %clay %dill %eyre %ford %gall %iris %jael]
2016-12-03 00:41:06 +03:00
::
++ our-home /(scot %p our)/home/(scot %da now)
++ sys-hash |=(pax/path .^(@uvI %cz :(welp our-home /sys pax)))
++ hash-vane
|= syd/@tas ^- (pair term @uvI)
[syd (sys-hash /vane/[syd]/hoon)]
::
++ rehash-vanes
^+ cur-vanes
(malt (turn tracked-vanes hash-vane))
::
::
++ poke
|= lod/(unit ?)
?^ lod
..autoload(autoload-on u.lod)
=. autoload-on !autoload-on
(spam leaf+"turned autoload {?:(autoload-on "on" "off")}" ~)
::
++ start
=. cur-hoon (sys-hash /hoon/hoon)
2016-12-12 21:08:46 +03:00
=. cur-arvo (sys-hash /arvo/hoon)
2016-12-03 00:41:06 +03:00
=. cur-zuse (sys-hash /zuse/hoon)
=. cur-vanes rehash-vanes
subscribe-next
::
++ subscribe-next
%- emit
2019-11-14 21:39:50 +03:00
[%pass /kiln/autoload %arvo %c [%warp our %home `[%next %z da+now /sys]]]
2016-12-03 00:41:06 +03:00
::
++ writ =>(check-new subscribe-next)
++ check-new
?. autoload-on
..check-new
=/ new-hoon (sys-hash /hoon/hoon)
2016-12-12 21:08:46 +03:00
=/ new-arvo (sys-hash /arvo/hoon)
?: |(!=(new-hoon cur-hoon) !=(new-arvo cur-arvo))
2016-12-03 00:41:06 +03:00
=. cur-hoon new-hoon
2016-12-12 21:08:46 +03:00
=. cur-arvo new-arvo
2016-12-03 00:41:06 +03:00
=. cur-vanes rehash-vanes
2019-11-14 21:39:50 +03:00
(emit %pass /kiln/reload/hoon %agent [our %hood] %poke %helm-reset !>(~))
2016-12-03 00:41:06 +03:00
:: XX updates cur-vanes?
=/ new-zuse (sys-hash /zuse/hoon)
?: !=(new-zuse cur-zuse)
=. cur-zuse new-zuse
=. cur-vanes rehash-vanes
2019-11-14 21:39:50 +03:00
=/ =cage [%helm-reload !>([%zuse tracked-vanes])]
(emit [%pass /kiln/reload/zuse %agent [our %hood] %poke cage])
2016-12-03 00:41:06 +03:00
(roll tracked-vanes load-vane)
::
++ load-vane
=< %_(. con ..load-vane)
2018-01-23 04:15:34 +03:00
|: $:{syd/@tas con/_.}
2016-12-03 00:41:06 +03:00
=. +>.$ con
=/ new-vane q:(hash-vane syd)
?: =(`new-vane (~(get by cur-vanes) syd))
+>.$
=. cur-vanes (~(put by cur-vanes) syd new-vane)
2019-11-14 21:39:50 +03:00
=/ =cage [%helm-reload !>(~[syd])]
(emit %pass /kiln/reload/[syd] %agent [our %hood] %poke cage)
2017-11-30 07:31:13 +03:00
::
++ coup-reload
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-reload-lame u.saw]
+>.$
2016-12-03 00:41:06 +03:00
--
2015-09-17 01:39:11 +03:00
::
2015-09-26 03:23:06 +03:00
++ poke-overload
2018-05-25 01:39:56 +03:00
:: +poke-overload: wipes ford cache at {start}, and then every {recur}.
|= [recur=@dr start=@da]
?> (gte start now)
2019-11-14 21:39:50 +03:00
abet:(emit %pass /kiln/overload/(scot %dr recur) %arvo %b [%wait start])
2015-09-26 03:23:06 +03:00
::
2018-06-22 07:00:07 +03:00
++ poke-wipe-ford
2019-11-14 21:39:50 +03:00
|=(percent=@ud abet:(emit %pass /kiln %arvo %f [%wipe percent]))
2018-06-22 07:00:07 +03:00
::
++ poke-keep-ford
2018-08-21 03:30:56 +03:00
|= [compiler-cache-size=@ud build-cache-size=@ud]
2019-11-14 21:39:50 +03:00
=< abet
(emit %pass /kiln %arvo %f [%keep compiler-cache-size build-cache-size])
2017-05-25 02:04:27 +03:00
::
2019-11-05 10:37:58 +03:00
++ poke-goad-gall
|= [force=? agent=(unit dude:gall)]
2019-11-19 07:36:21 +03:00
abet:(emit %pass /kiln %arvo %g %goad force agent)
2019-11-05 10:37:58 +03:00
::
++ done
|= {way/wire saw/(unit error:ames)}
~? ?=(^ saw) [%kiln-nack u.saw]
abet
::
2019-11-14 21:39:50 +03:00
++ take-agent
2019-11-19 07:36:21 +03:00
|= [=wire =sign:agent:gall]
2019-11-14 21:39:50 +03:00
?+ wire ~|([%kiln-bad-take-agent wire -.sign] !!)
2020-01-04 00:06:42 +03:00
[%kiln %fancy *] ?> ?=(%poke-ack -.sign)
2019-11-14 21:39:50 +03:00
(take-coup-fancy t.t.wire p.sign)
[%kiln %reload *] ?> ?=(%poke-ack -.sign)
(take-coup-reload t.t.wire p.sign)
2020-01-04 00:06:42 +03:00
[%kiln %spam *] ?> ?=(%poke-ack -.sign)
2019-11-14 21:39:50 +03:00
(take-coup-spam t.t.wire p.sign)
==
::
++ take-general
|= [=wire =sign-arvo]
?- wire
[%sync %merg *] %+ take-mere-sync t.t.wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
[%autoload *] %+ take-writ-autoload t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%find-ship *] %+ take-writ-find-ship t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%sync *] %+ take-writ-sync t.wire
?>(?=(%writ +<.sign-arvo) +>.sign-arvo)
[%overload *] %+ take-wake-overload t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%autocommit *] %+ take-wake-autocommit t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
*
?+ +<.sign-arvo ~|([%kiln-bad-take-card +<.sign-arvo] !!)
%done %+ done wire
?>(?=(%done +<.sign-arvo) +>.sign-arvo)
2019-11-14 21:39:50 +03:00
%made %+ take-made wire
?>(?=(%made +<.sign-arvo) +>.sign-arvo)
%mere %+ take-mere wire
?>(?=(%mere +<.sign-arvo) +>.sign-arvo)
==
==
2018-03-19 07:18:20 +03:00
++ take |=(way/wire ?>(?=({@ ~} way) (work i.way))) :: general handler
2015-09-02 01:20:17 +03:00
++ take-mere ::
2015-12-20 23:50:45 +03:00
|= {way/wire are/(each (set path) (pair term tang))}
2015-09-02 01:20:17 +03:00
abet:abet:(mere:(take way) are)
::
2018-08-09 01:14:26 +03:00
++ take-made
2018-08-09 21:22:37 +03:00
|= [way=wire date=@da result=made-result:ford]
2018-03-17 01:21:59 +03:00
:: hack for |overload
::
:: We might have gotten an ignorable response back for our cache priming
:: ford call. If it matches our magic wire, ignore it.
::
?: =(/prime/cache way)
~& %cache-primed
abet
2018-08-09 21:22:37 +03:00
abet:abet:(made:(take way) date result)
2015-09-02 01:20:17 +03:00
::
++ take-coup-fancy ::
2015-12-20 23:50:45 +03:00
|= {way/wire saw/(unit tang)}
2015-09-02 01:20:17 +03:00
abet:abet:(coup-fancy:(take way) saw)
::
2017-11-30 07:31:13 +03:00
++ take-coup-reload ::
|= {way/wire saw/(unit tang)}
abet:(coup-reload:autoload way saw)
::
++ take-coup-spam ::
|= {way/wire saw/(unit tang)}
~? ?=(^ saw) [%kiln-spam-lame u.saw]
abet
::
2015-09-02 01:20:17 +03:00
++ take-mere-sync ::
2015-12-20 23:50:45 +03:00
|= {way/wire mes/(each (set path) (pair term tang))}
2016-02-26 02:19:44 +03:00
?> ?=({@ @ @ *} way)
=/ hos/kiln-sync
2015-09-02 01:20:17 +03:00
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
2018-12-04 09:59:41 +03:00
abet:abet:(mere:(auto hos) mes)
2015-09-02 01:20:17 +03:00
::
2019-04-30 20:40:38 +03:00
++ take-writ-find-ship ::
|= {way/wire rot/riot}
?> ?=({@ @ @ *} way)
=/ hos/kiln-sync
2019-04-30 20:40:38 +03:00
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(take-find-ship:(auto hos) rot)
::
2015-09-17 01:39:11 +03:00
++ take-writ-sync ::
2015-12-20 23:50:45 +03:00
|= {way/wire rot/riot}
2016-02-26 02:19:44 +03:00
?> ?=({@ @ @ *} way)
=/ hos/kiln-sync
2015-09-02 01:20:17 +03:00
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
2018-12-04 09:59:41 +03:00
abet:abet:(writ:(auto hos) rot)
2015-09-02 01:20:17 +03:00
::
2015-09-17 01:39:11 +03:00
++ take-writ-autoload
2015-12-20 23:50:45 +03:00
|= {way/wire rot/riot}
2018-03-19 07:18:20 +03:00
?> ?=(~ way)
2015-09-17 01:39:11 +03:00
?> ?=(^ rot)
2016-12-03 00:41:06 +03:00
abet:writ:autoload
2015-09-17 01:39:11 +03:00
::
2015-09-26 03:23:06 +03:00
++ take-wake-overload
2019-04-13 01:48:22 +03:00
|= {way/wire error=(unit tang)}
?^ error
%- (slog u.error)
~& %kiln-take-wake-overload-fail
abet
2018-03-19 07:18:20 +03:00
?> ?=({@ ~} way)
=+ tym=(slav %dr i.way)
2018-08-09 21:22:37 +03:00
~& %wake-overload-deprecated
2015-09-26 03:23:06 +03:00
abet
::
2019-08-25 12:00:26 +03:00
++ take-wake-autocommit
|= [way=wire error=(unit tang)]
?^ error
%- (slog u.error)
~& %kiln-wake-autocommit-fail
abet
=. nex.commit-timer (add now tim.commit-timer)
=< abet
%- emil
2019-11-14 21:39:50 +03:00
:~ [%pass /commit %arvo %c [%dirk mon.commit-timer]]
[%pass way.commit-timer %arvo %b [%wait nex.commit-timer]]
2019-08-25 12:00:26 +03:00
==
::
::
2015-09-02 01:20:17 +03:00
++ spam
2015-12-20 23:50:45 +03:00
|= mes/(list tank)
2015-09-02 01:20:17 +03:00
((slog mes) ..spam)
::
++ auto
|= kiln-sync
2019-11-14 21:39:50 +03:00
=+ (~(gut by syn) [syd her sud] let=*@ud)
2015-09-02 01:20:17 +03:00
|%
++ abet
2019-11-14 21:39:50 +03:00
..auto(syn (~(put by syn) [syd her sud] let))
2015-06-18 02:44:00 +03:00
::
2015-09-02 01:20:17 +03:00
++ blab
2019-11-19 07:36:21 +03:00
|= new/(list card:agent:gall)
2015-09-02 01:20:17 +03:00
^+ +>
+>.$(moz (welp new moz))
2015-05-12 03:31:37 +03:00
::
2019-11-14 21:39:50 +03:00
++ warp
|= [=wire =ship =riff]
(blab [%pass wire %arvo %c [%warp ship riff]] ~)
::
2015-09-02 01:20:17 +03:00
++ spam |*(* %_(+> ..auto (^spam +<)))
++ stop
=> (spam (render "ended autosync" sud her syd) ~)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud ~)
2018-12-04 09:59:41 +03:00
:: XX duplicate of start-sync? see |track
2015-06-04 00:18:13 +03:00
::
2016-01-07 01:08:46 +03:00
++ start-track
=> (spam (render "activated track" sud her syd) ~)
=. let 1
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud `[%sing %y ud+let /])
2016-01-07 01:08:46 +03:00
::
++ start-sync
2019-04-30 20:40:38 +03:00
=> (spam (render "finding ship and desk" sud her syd) ~)
=/ =wire /kiln/find-ship/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud `[%sing %y ud+1 /])
2019-04-30 20:40:38 +03:00
::
++ take-find-ship
|= rot=riot
2019-05-14 00:45:53 +03:00
=> (spam (render "activated sync" sud her syd) ~)
2018-12-04 09:59:41 +03:00
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud `[%sing %w [%da now] /])
2015-05-12 03:31:37 +03:00
::
2015-09-02 01:20:17 +03:00
++ writ
2018-12-04 09:59:41 +03:00
|= rot=riot
2015-09-02 01:20:17 +03:00
?~ rot
=. +>.$
%^ spam
leaf+"sync cancelled, retrying"
(render "on sync" sud her syd)
~
start-sync
2019-05-09 22:46:19 +03:00
=. let ?. ?=($w p.p.u.rot) let ud:;;(cass:clay q.q.r.u.rot)
2019-11-14 21:39:50 +03:00
=/ =wire /kiln/sync/merg/[syd]/(scot %p her)/[sud]
:: germ: merge mode for sync merges
::
:: Initial merges from any source must use the %init germ.
:: Subsequent merges may use any germ, but if the source is
:: a remote ship with which we have not yet merged, we won't
:: share a merge-base commit and all germs but %that will fail.
::
:: We want to always use %that for the first remote merge.
:: But we also want local syncs (%base to %home or %kids)
:: to succeed after that first remote sync. To accomplish both
:: we simply use %that for the first three sync merges.
:: (The first two are from the pill.)
::
=/ =germ
=/ =cass
.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now))
?: =(0 ud.cass)
%init
?:((gth 3 ud.cass) %that %mate)
=< %- spam
?: =(our her) ~
[(render "beginning sync" sud her syd) ~]
2019-11-14 21:39:50 +03:00
(blab [%pass wire %arvo %c [%merg syd her sud ud+let germ]] ~)
2015-06-04 00:18:13 +03:00
::
2015-09-02 01:20:17 +03:00
++ mere
2018-12-04 09:59:41 +03:00
|= mes=(each (set path) (pair term tang))
2019-05-03 04:06:31 +03:00
?: ?=([%| %bad-fetch-ali *] mes)
2019-02-02 00:46:09 +03:00
=. +>.$
%^ spam
2019-05-03 04:06:31 +03:00
leaf+"merge cancelled, maybe because sunk; restarting"
2019-02-02 00:46:09 +03:00
(render "on sync" sud her syd)
~
start-sync:stop
2015-09-02 01:20:17 +03:00
=. let +(let)
=. +>.$
%- spam
2018-03-19 06:54:47 +03:00
?: ?=(%& -.mes)
2015-09-02 01:20:17 +03:00
[(render "sync succeeded" sud her syd) ~]
?+ p.p.mes
:* (render "sync failed" sud her syd)
2015-12-21 00:16:39 +03:00
leaf+"please manually merge the desks with"
leaf+"|merge %{(trip syd)} {(scow %p her)} %{(trip sud)}"
leaf+""
leaf+"error code: {<p.p.mes>}"
2015-09-02 01:20:17 +03:00
q.p.mes
==
::
2019-05-23 08:35:09 +03:00
$no-ali-disc
:~ (render "sync activated" sud her syd)
2015-12-21 00:16:39 +03:00
leaf+"note: blank desk {<sud>} on {<her>}"
2015-09-02 01:20:17 +03:00
==
==
2018-12-04 09:59:41 +03:00
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
2019-11-14 21:39:50 +03:00
(warp wire her sud `[%sing %y ud+let /])
2015-09-02 01:20:17 +03:00
--
::
++ work :: state machine
2015-12-20 23:50:45 +03:00
|= syd/desk
=/ ,per-desk
%+ ~(gut by rem) syd
2017-11-30 00:29:35 +03:00
=+ *per-desk
2015-09-02 01:20:17 +03:00
%_(- cas [%da now])
|%
++ abet :: resolve
..work(rem (~(put by rem) syd auto gem her sud cas))
2015-05-28 05:46:58 +03:00
::
2015-09-02 01:20:17 +03:00
++ blab
2019-11-19 07:36:21 +03:00
|= new/(list card:agent:gall)
2015-09-02 01:20:17 +03:00
^+ +>
+>.$(moz (welp new moz))
2015-05-28 05:46:58 +03:00
::
2015-09-02 01:20:17 +03:00
++ win . :: successful poke
++ lose
^+ .
~| %kiln-work-fail
.
::
2015-09-02 01:20:17 +03:00
++ ford-fail
2015-12-20 23:50:45 +03:00
|=(tan/tang ~|(%ford-fail (mean tan)))
::
2015-09-02 01:20:17 +03:00
++ unwrap-tang
2015-12-20 23:50:45 +03:00
|* res/(each * tang)
2018-03-19 06:54:47 +03:00
?: ?=(%& -.res)
2015-09-02 01:20:17 +03:00
p.res
(ford-fail p.res)
2015-05-12 03:31:37 +03:00
::
++ perform ::
2015-09-02 01:20:17 +03:00
^+ .
2019-11-14 21:39:50 +03:00
(blab [%pass /kiln/[syd] %arvo %c [%merg syd her sud cas gem]] ~)
2015-05-26 04:20:45 +03:00
::
2015-09-02 01:20:17 +03:00
++ fancy-merge :: send to self
2015-12-20 23:50:45 +03:00
|= {syd/desk her/@p sud/desk gem/?($auto germ)}
2015-09-02 01:20:17 +03:00
^+ +>
2019-11-14 21:39:50 +03:00
=/ =cage [%kiln-merge !>([syd her sud cas gem])]
2015-09-02 01:20:17 +03:00
%- blab :_ ~
2019-11-14 21:39:50 +03:00
[%pass /kiln/fancy/[^syd] %agent [our %hood] %poke cage]
2015-05-26 04:20:45 +03:00
::
2015-09-02 01:20:17 +03:00
++ spam ::|=(tang ((slog +<) ..spam))
|*(* +>(..work (^spam +<)))
++ merge
|= {her/@p sud/@tas cas/case gim/?($auto germ)}
2015-09-02 01:20:17 +03:00
^+ +>
2015-12-09 04:54:26 +03:00
?. ?=($auto gim)
2016-01-07 01:08:46 +03:00
perform(auto |, gem gim, her her, cas cas, sud sud)
?: =(0 ud:.^(cass:clay %cw /(scot %p our)/[syd]/(scot %da now)))
2015-09-02 01:20:17 +03:00
=> $(gim %init)
.(auto &)
=> $(gim %fine)
.(auto &)
2015-05-26 04:20:45 +03:00
::
2015-09-02 01:20:17 +03:00
++ coup-fancy
|= saw/(unit tang)
2015-09-02 01:20:17 +03:00
?~ saw
2015-12-21 00:16:39 +03:00
=> (spam leaf+"%melding %{(trip sud)} into scratch space" ~)
2015-06-04 00:18:13 +03:00
%- blab :_ ~
2019-11-14 21:39:50 +03:00
=/ note [%merg (cat 3 syd '-scratch') her sud cas gem]
[%pass /kiln/[syd] %arvo %c note]
2015-09-02 01:20:17 +03:00
=+ :- "failed to set up conflict resolution scratch space"
"I'm out of ideas"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+-< leaf+-> u.saw)
2015-05-26 04:20:45 +03:00
::
2015-09-02 01:20:17 +03:00
++ mere
|= are/(each (set path) (pair term tang))
2015-09-02 01:20:17 +03:00
^+ +>
?: =(%meld gem)
2018-03-19 06:54:47 +03:00
?: ?=(%& -.are)
2015-09-02 01:20:17 +03:00
?. auto
=+ "merged with strategy {<gem>}"
2015-12-21 00:16:39 +03:00
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
2015-09-02 01:20:17 +03:00
:: ~? > =(~ p.are) [%mere-no-conflict syd]
=+ "mashing conflicts"
2015-12-21 00:16:39 +03:00
=> .(+>.$ (spam leaf+- ~))
2015-09-02 01:20:17 +03:00
=+ tic=(cat 3 syd '-scratch')
2015-05-12 03:31:37 +03:00
%- blab :_ ~
2018-08-09 21:22:37 +03:00
=, ford
2019-11-14 21:39:50 +03:00
:* %pass /kiln/[syd] %arvo %f
:* %build live=%.n
2018-08-09 21:22:37 +03:00
^- schematic
:- %list
^- (list schematic)
2015-12-21 00:16:39 +03:00
:: ~& > kiln-mashing+[p.are syd=syd +<.abet]
%+ turn ~(tap in p.are)
2015-12-20 23:50:45 +03:00
|= pax/path
2018-08-09 21:22:37 +03:00
^- [schematic schematic]
2015-09-02 01:20:17 +03:00
:- [%$ %path -:!>(*path) pax]
2018-08-09 21:22:37 +03:00
=/ base=schematic [%scry %c %x `rail`[[our tic] (flop pax)]]
?> ?=([%da @] cas)
=/ alis=schematic
[%pin p.cas `schematic`[%scry %c %x [[our syd] (flop pax)]]]
=/ bobs=schematic
[%scry %c %x [[our syd] (flop pax)]]
=/ dali=schematic [%diff [our syd] base alis]
=/ dbob=schematic [%diff [our syd] base bobs]
=/ for=mark
2015-09-02 01:20:17 +03:00
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
2018-08-09 21:22:37 +03:00
^- schematic
[%mash [our tic] for [[her sud] for dali] [[our syd] for dbob]]
2019-11-14 21:39:50 +03:00
== ==
2015-09-02 01:20:17 +03:00
=+ "failed to merge with strategy meld"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
2018-03-19 06:54:47 +03:00
?: ?=(%& -.are)
2015-09-02 01:20:17 +03:00
=+ "merged with strategy {<gem>}"
2015-12-21 00:16:39 +03:00
win:(spam leaf+- ?~(p.are ~ [>`(set path)`p.are< ~]))
2015-09-02 01:20:17 +03:00
?. auto
=+ "failed to merge with strategy {<gem>}"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
2015-09-02 01:20:17 +03:00
?+ gem
2015-12-21 00:16:39 +03:00
(spam leaf+"strange auto" >gem< ~)
2015-09-02 01:20:17 +03:00
::
2015-12-09 04:54:26 +03:00
$init
2015-09-02 01:20:17 +03:00
=+ :- "auto merge failed on strategy %init"
2015-05-12 03:31:37 +03:00
"I'm out of ideas"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+-< leaf+-> [>p.p.are< q.p.are])
2015-05-12 03:31:37 +03:00
::
2015-12-09 04:54:26 +03:00
$fine
?. ?=($bad-fine-merge p.p.are)
2015-09-02 01:20:17 +03:00
=+ "auto merge failed on strategy %fine"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
=> (spam leaf+"%fine merge failed, trying %meet" ~)
2015-09-02 01:20:17 +03:00
perform(gem %meet)
2015-07-28 01:39:36 +03:00
::
2015-12-09 04:54:26 +03:00
$meet
?. ?=($meet-conflict p.p.are)
2015-09-02 01:20:17 +03:00
=+ "auto merge failed on strategy %meet"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
=> (spam leaf+"%meet merge failed, trying %mate" ~)
2015-09-02 01:20:17 +03:00
perform(gem %mate)
2015-07-28 01:39:36 +03:00
::
2015-12-09 04:54:26 +03:00
$mate
?. ?=($mate-conflict p.p.are)
2015-09-02 01:20:17 +03:00
=+ "auto merge failed on strategy %mate"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
2015-09-02 01:20:17 +03:00
=> .(gem %meld)
=+ tic=(cat 3 syd '-scratch')
=> =+ :- "%mate merge failed with conflicts,"
"setting up scratch space at %{(trip tic)}"
2015-12-21 00:16:39 +03:00
[tic=tic (spam leaf+-< leaf+-> q.p.are)]
2015-09-11 03:25:27 +03:00
(fancy-merge tic our syd %init)
2015-09-02 01:20:17 +03:00
==
::
++ tape-to-tanks
2015-12-20 23:50:45 +03:00
|= a/tape ^- (list tank)
2015-12-21 00:16:39 +03:00
(scan a (more (just '\0a') (cook |=(a/tape leaf+a) (star prn))))
2015-09-02 01:20:17 +03:00
::
++ tanks-if-any
2015-12-20 23:50:45 +03:00
|= {a/tape b/(list path) c/tape} ^- (list tank)
2015-09-02 01:20:17 +03:00
?: =(~ b) ~
(welp (tape-to-tanks "\0a{c}{a}") >b< ~)
::
++ made
|= [date=@da result=made-result:ford]
:: |= {dep/@uvH reg/gage:ford}
2015-09-02 01:20:17 +03:00
^+ +>
2018-08-09 21:22:37 +03:00
::
?: ?=([%incomplete *] result)
=+ "failed to mash"
lose:(spam leaf+- tang.result)
?: ?=([%complete %error *] result)
2015-09-02 01:20:17 +03:00
=+ "failed to mash"
2018-08-09 21:22:37 +03:00
lose:(spam leaf+- message.build-result.result)
?> ?=([%complete %success %list *] result)
=/ can=(list (pair path (unit miso)))
2018-08-09 21:22:37 +03:00
%+ turn results.build-result.result
|= res=build-result:ford
2015-09-02 01:20:17 +03:00
^- (pair path (unit miso))
2018-08-09 21:22:37 +03:00
?> ?=([%success ^ *] res)
~! res
=+ pax=(result-to-cage:ford head.res)
=+ dif=(result-to-cage:ford tail.res)
::
2015-12-09 04:54:26 +03:00
?. ?=($path p.pax)
2015-09-02 01:20:17 +03:00
~| "strange path mark: {<p.pax>}"
!!
2019-05-09 22:46:19 +03:00
[;;(path q.q.pax) ?:(?=($null p.dif) ~ `[%dif dif])]
2015-12-21 00:16:39 +03:00
:: ~& > kiln-made+[(turn can head) syd=syd +<.abet]
2015-12-20 23:50:45 +03:00
=+ notated=(skid can |=({path a/(unit miso)} ?=(^ a)))
2015-12-10 12:17:19 +03:00
=+ annotated=(turn `(list (pair path *))`-.notated head)
=+ unnotated=(turn `(list (pair path *))`+.notated head)
2015-09-02 01:20:17 +03:00
=+ `desk`(cat 3 syd '-scratch')
=/ tan=(list tank)
2015-09-02 01:20:17 +03:00
%- zing
^- (list (list tank))
:~ %- tape-to-tanks
"""
done setting up scratch space in {<[-]>}
please resolve the following conflicts and run
2015-09-18 02:20:07 +03:00
|merge {<syd>} our {<[-]>}
2015-09-02 01:20:17 +03:00
"""
%^ tanks-if-any
"annotated conflicts in:" annotated
""
%^ tanks-if-any
"unannotated conflicts in:" unnotated
"""
some conflicts could not be annotated.
for these, the scratch space contains
the most recent common ancestor of the
conflicting content.
"""
==
=< win
%- blab:(spam tan)
:_ ~
2019-11-14 21:39:50 +03:00
:* %pass /kiln/[syd] %arvo %c
:* %info
2015-09-06 04:14:00 +03:00
(cat 3 syd '-scratch') %&
2015-09-02 01:20:17 +03:00
%+ murn can
2015-12-20 23:50:45 +03:00
|= {p/path q/(unit miso)}
2015-09-02 01:20:17 +03:00
`(unit (pair path miso))`?~(q ~ `[p u.q])
2019-11-14 21:39:50 +03:00
== ==
2015-05-12 03:31:37 +03:00
--
--