Merge branch 'nextbreach' into test

Conflicts:
	urb/zod/base/ape/hood/core.hook
	urb/zod/base/lib/kiln/core.hook
This commit is contained in:
Philip C Monk 2015-05-31 23:36:30 -04:00
commit 56c47a8125
4 changed files with 123 additions and 30 deletions

View File

@ -95,6 +95,10 @@
++ poke-kiln-mv (wrap poke-mv):from-kiln
++ poke-will (wrap poke-will):from-helm
++ mere-kiln (wrap take-mere):from-kiln
++ mere-kiln-sync (wrap take-mere-sync):from-kiln
::++ mere-kiln-sync
:: |= [then (each (set path) (pair term tang))]
:: (ably (take-mere-sync:(kiln-work [hid ost src] (able %kiln)) way +<+))
++ made-kiln (wrap take-made):from-kiln
++ init-helm |=([way=wire *] [~ +>])
++ note-helm (wrap take-note):from-helm
@ -103,4 +107,8 @@
++ peer-drum (wrap peer):from-drum
++ quit-drum (wrap quit):from-drum
++ went-helm (wrap take-went):from-helm
++ writ-kiln-sync (wrap take-writ):from-kiln
::++ writ-kiln-sync
:: |= [then riot]
:: (ably (take-writ:(kiln-work [hid ost src] (able %kiln)) way +<+))
--

View File

@ -1050,9 +1050,9 @@
=+ vid=(read-at-aeon:ze u.nao p.q.i.xiq)
:: ~& %red-at-aeon
?~ vid
?~ u.nao
?: =(0 u.nao)
~& [%oh-poor `path`[syd '0' r.p.q.i.xiq]]
$(xiq t.xiq)
$(xiq t.xiq)
~& [%oh-well desk=syd mood=p.q.i.xiq aeon=u.nao]
$(xiq t.xiq, xaq [i.xiq xaq])
$(xiq t.xiq, ..wake (balk p.i.xiq u.vid p.q.i.xiq))

View File

@ -1030,6 +1030,7 @@
%plug `%c
%them `%e
%want `%a
%warp `%c
==
--
--

View File

@ -9,7 +9,8 @@
++ kiln-part ,[%kiln %0 kiln-pith] :: kiln state
++ kiln-pith ::
$: rem=(map desk kiln-desk) ::
==
syn=(map hood-sync ,[let=@ud ust=bone]) ::
== ::
++ kiln-desk :: per-desk state
$: auto=? :: escalate on failure
gem=germ :: strategy
@ -54,6 +55,7 @@
[%merg wire @p @tas @p @tas germ] ::
[%plug wire @p @tas @p @tas] ::
[%poke wire dock pear] ::
[%warp wire sock riff] ::
== ::
++ pear :: poke fruit
$% [%talk-command command:talk] ::
@ -76,8 +78,11 @@
abet:(emit %lynx /kiln our syd syn)
::
++ poke-sync ::
|= hood-sync
abet:(emit %font /kiln our syd her sud)
|= hos=hood-sync
?: (~(has by syn) hos)
=+ "already syncing from {<sud.hos>} on {<her.hos>} to {<syd.hos>}"
abet:(spam leaf/- ~)
abet:abet:start:(auto hos)
::
++ poke-merge ::
|= hood-merge
@ -115,6 +120,106 @@
|= [way=wire saw=(unit tang)]
abet:abet:(coup-fancy:(take way) saw)
::
++ take-mere-sync ::
|= [way=wire mes=(each (set path) (pair term tang))]
?> ?=([@ @ @ ~] way)
=+ ^- hos=hood-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(mere:(auto hos) mes)
::
++ take-writ ::
|= [way=wire rot=riot]
?> ?=([@ @ @ ~] way)
=+ ^- hos=hood-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(writ:(auto hos) rot)
::
++ spam
|= mes=(list tank)
%- emit
:* %poke /kiln/spam
[our %talk] %talk-command
^- command:talk
:- %publish
%- flop
=< acc
%+ roll mes
=< .(eny ^eny)
|= [tan=tank acc=(list thought:talk) eny=@uvI]
^- [acc=(list thought:talk) eny=@uvI]
=+ (sham eny mes)
:_ -
:_ acc
^- thought:talk
:+ -
[[[%& our (main our)] [*envelope:talk %pending]] ~ ~]
[now *bouquet:talk [%app (crip ~(ram re tan))]]
==
::
++ auto
|= hood-sync
=+ (fall (~(get by syn) syd her sud) [let=*@ud ust=ost])
|%
++ abet
..auto(syn (~(put by syn) [syd her sud] let ust))
::
++ blab
|= new=(list move)
^+ +>
+>.$(moz (welp new moz))
::
++ spam |*(* %_(+> ..auto (^spam +<)))
++ start
%- blab :_ ~
:* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~ %sing %w [%da now] /
==
::
++ writ
|= rot=riot
?~ rot
%^ spam
leaf/"bad %writ response on autosync"
leaf/"from {<sud>} on {<her>} to {<syd>}"
~
=. let ?. ?=(%w p.p.u.rot) let ((hard ,@ud) q.q.r.u.rot)
%- blab :_ ~
:* ost %merg
/kiln/sync/[syd]/(scot %p her)/[sud]
our syd her sud
?: =(0 .^(%cw /(scot %p our)/[syd]/(scot %da now)))
%init
%mate
==
::
++ mere
|= mes=(each (set path) (pair term tang))
=. let +(let)
=. +>.$
%- spam
?: ?=(%& -.mes)
[leaf/"autosync succeeded from {<sud>} on {<her>} to {<syd>}" ~]
:* leaf/"autosync failed from {<sud>} on {<her>} to {<syd>}"
leaf/"please manually merge the desks with"
leaf/":+merge %{(trip syd)} {(scow %p her)} %{(trip sud)}"
leaf/""
leaf/"error code: {<p.p.mes>}"
q.p.mes
==
%- blab :_ ~
:* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~ %sing %y [%ud let] /
==
--
::
++ work :: state machine
|= syd=desk
=+ ^- kiln-desk
@ -125,7 +230,7 @@
++ abet :: resolve
..work(rem (~(put by rem) syd auto gem her sud cas))
::
++ blab :: emit, XX remove
++ blab
|= new=(list move)
^+ +>
+>.$(moz (welp new moz))
@ -134,7 +239,7 @@
++ lose
^+ .
~| %kiln-work-fail
!!
.
::
++ ford-fail
|=(tan=tang ~|(%ford-fail (mean tan)))
@ -179,28 +284,7 @@
%- blab :_ ~
[ost %poke /kiln/fancy/[^syd] [our %hood] %hood-merge [syd her sud gem]]
::
++ spam
|= mes=(list tank)
%- blab :_ ~
:* ost %poke /kiln/spam/[syd]
[our %talk] %talk-command
^- command:talk
:- %publish
%- flop
=< acc
%+ roll mes
=< .(eny eny)
|= [tan=tank acc=(list thought:talk) eny=@uvI]
^- [acc=(list thought:talk) eny=@uvI]
=+ (sham eny mes)
:_ -
:_ acc
^- thought:talk
:+ -
[[[%& our (main our)] [*envelope:talk %pending]] ~ ~]
[now *bouquet:talk [%app (crip ~(ram re tan))]]
==
::
++ spam |*(* +>(..work (^spam +<)))
++ merge
|= [her=@p sud=@tas gim=?(%auto germ)]
^+ +>
@ -341,7 +425,7 @@
=< win
%- blab:(spam tan)
:_ ~
:* ost %info /kiln/[syd]/dash
:* ost %info /kiln/[syd]
our (cat 3 syd '-scratch')
%& *cart
%+ murn can