1
0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-22 06:11:31 +03:00
urbit/lib/kiln.hoon

616 lines
20 KiB
Plaintext
Raw Normal View History

2015-12-09 19:48:57 +03:00
:: :: ::
2015-12-09 04:54:26 +03:00
:::: /hoon/kiln/lib :: ::
2015-05-12 03:31:37 +03:00
:: :: ::
/? 310 :: version
:: :: ::
:::: :: ::
:: :: ::
|% :: ::
2015-12-09 04:54:26 +03:00
++ kiln-part {$kiln $0 kiln-pith} :: kiln state
++ kiln-pith ::
2015-12-20 23:50:45 +03:00
$: rem/(map desk kiln-desk) ::
syn/(map kiln-sync {let/@ud ust/bone}) ::
autoload/? ::
cur-hoon/@uvI ::
cur-zuse/@uvI ::
cur-vanes/(map @tas @uvI) ::
2015-05-26 04:20:45 +03:00
== ::
2015-05-12 03:31:37 +03:00
++ kiln-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
== ::
:: :: ::
:::: :: ::
:: :: ::
++ 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
== ::
-- ::
:: :: ::
:::: :: ::
!: :: ::
2015-12-09 04:54:26 +03:00
|= {bowl kiln-part} :: main kiln work
2015-09-02 01:20:17 +03:00
?> =(src our)
2015-12-09 04:54:26 +03:00
=> |% :: arvo structures
++ card ::
2015-12-14 10:58:14 +03:00
$% {$exec wire @p $~ {beak silk}} ::
2015-12-09 04:54:26 +03:00
{$drop wire @p @tas} ::
{$info wire @p @tas nori} ::
{$mont wire @tas @p @tas path} ::
2015-12-14 10:58:14 +03:00
{$ogre wire $@(@tas beam)} ::
2015-12-09 04:54:26 +03:00
{$merg wire @p @tas @p @tas case germ} ::
{$poke wire dock pear} ::
{$wipe wire @p $~} ::
2015-12-09 04:54:26 +03:00
{$wait wire @da} ::
{$warp wire sock riff} ::
== ::
++ pear :: poke fruit
2015-12-14 10:58:14 +03:00
$% {$talk-command command:talk} ::
2015-12-09 04:54:26 +03:00
{$kiln-merge kiln-merge} ::
{$helm-reload (list term)} ::
{$helm-reset $~} ::
== ::
++ move (pair bone card) :: user-level move
2015-09-02 01:20:17 +03:00
--
2015-12-20 23:50:45 +03:00
|_ moz/(list move)
2015-12-09 04:54:26 +03:00
++ abet :: resolve
2015-09-02 01:20:17 +03:00
[(flop moz) `kiln-part`+>+>->]
::
2015-12-09 04:54:26 +03:00
++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card
++ emil :: return cards
2015-09-02 01:20:17 +03:00
|= (list card)
^+ +>
?~(+< +> $(+< 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
::
++ poke-mount
|= kiln-mount
=+ bem=(tome pax)
?~ bem
=+ "can't mount bad path: {<pax>}"
2015-12-21 00:16:39 +03:00
abet:(spam leaf+- ~)
2015-09-02 01:20:17 +03:00
abet:(emit %mont /mount pot p.u.bem q.u.bem (flop s.u.bem))
::
++ poke-unmount
2015-12-20 23:50:45 +03:00
|= mon/kiln-unmount
2015-09-02 01:20:17 +03:00
?^ mon
=+ bem=(tome 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+- ~)
2015-09-02 01:20:17 +03:00
abet:(emit %ogre /unmount-beam [[p q %ud 0] s]:u.bem)
abet:(emit %ogre /unmount-point mon)
::
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 syncing" [sud her syd]:hos) ~)
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) ~)
2016-02-26 02:19:44 +03:00
abet:abet:(start-sync:(auto hos) |)
::
++ poke-syncs ::
|= $~
=< abet %- spam
=+ a=(~(tap by syn))
?: =(0 (lent a))
[%leaf "no syncs configured"]~
%- flop %+ turn a
|= a/(pair kiln-sync *)
(render "sync configured" [sud her syd]:p.a)
::
2016-02-26 02:19:44 +03:00
++ poke-init-sync
|= hos/kiln-sync
?: (~(has by syn) hos)
abet:(spam (render "already syncing" [sud her syd]:hos) ~)
abet:abet:(start-sync:(auto hos) &)
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
2015-12-20 23:50:45 +03:00
|= syd/desk
2015-09-16 03:24:44 +03:00
abet:(emit %drop /cancel our syd)
::
2016-05-07 02:21:29 +03:00
++ poke-info
|= {mez/tape tor/(unit toro)}
?~ tor
abet:(spam leaf+mez ~)
abet:(emit:(spam leaf+mez ~) %info /kiln our 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
::
2015-09-17 01:39:11 +03:00
++ poke-autoload
2015-12-20 23:50:45 +03:00
|= lod/(unit ?)
2015-09-17 02:40:53 +03:00
?^ lod
abet(autoload u.lod)
=< abet(autoload !autoload)
2015-12-21 00:16:39 +03:00
(spam leaf+"turning autoload o{?:(autoload "ff" "n")}" ~)
2015-09-17 02:40:53 +03:00
::
++ poke-start-autoload
2015-12-09 04:54:26 +03:00
|= $~
=. cur-hoon .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/hoon/hoon)
=. cur-zuse .^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/zuse/hoon)
2016-01-11 23:00:38 +03:00
=. cur-vanes
%- malt
%+ turn `(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall]
2016-02-01 09:16:26 +03:00
|= syd/@tas
2016-01-11 23:00:38 +03:00
:- syd
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon)
2015-09-17 01:39:11 +03:00
=< abet
2016-01-11 23:00:38 +03:00
%- emit
2015-09-17 01:39:11 +03:00
^- card
2016-01-11 23:00:38 +03:00
:* %warp /kiln/autoload [our our] %home ~
%next %z da+now /arvo
2015-09-17 01:39:11 +03:00
==
::
2015-09-26 03:23:06 +03:00
++ poke-overload
|= tym/@dr
abet:(emit %wait /kiln/overload/(scot %dr tym) (add ~s10 now))
2015-09-26 03:23:06 +03:00
::
2015-12-20 23:50:45 +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)
::
++ take-made ::
2015-12-20 23:50:45 +03:00
|= {way/wire dep/@uvH reg/gage}
2015-09-02 01:20:17 +03:00
abet:abet:(made:(take way) dep reg)
::
++ 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)
::
++ 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)
2015-12-20 23:50:45 +03:00
=+ ^- 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)
==
2016-02-26 02:19:44 +03:00
abet:abet:(mere:(auto hos) .?(t.t.t.way) mes)
2015-09-02 01:20:17 +03:00
::
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)
2015-12-20 23:50:45 +03:00
=+ ^- 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)
==
2016-02-26 02:19:44 +03:00
abet:abet:(writ:(auto hos) .?(t.t.t.way) 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}
?> ?=($~ way)
2015-09-17 01:39:11 +03:00
?> ?=(^ rot)
=+ vanes=`(list @tas)`~[%ames %behn %clay %dill %eyre %ford %gall]
2015-09-17 01:39:11 +03:00
=. +>.$
2015-09-17 02:40:53 +03:00
?. autoload
+>.$
2016-01-11 23:00:38 +03:00
=+ ^= new-hoon
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/hoon/hoon)
2016-01-11 23:00:38 +03:00
?: !=(new-hoon cur-hoon)
=. cur-hoon new-hoon
=. cur-vanes
%- malt
%+ turn `(list @tas)`(turn (~(tap by cur-vanes)) head)
|= syd/@tas
2016-01-11 23:00:38 +03:00
:- syd
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon)
2016-01-11 23:00:38 +03:00
(emit %poke /kiln/reload/hoon [our %hood] %helm-reset ~)
:: XX updates cur-vanes?
=+ ^= new-zuse
2016-02-01 09:16:26 +03:00
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/zuse/hoon)
2016-01-11 23:00:38 +03:00
?: !=(new-zuse cur-zuse)
=. cur-zuse new-zuse
=. cur-vanes
%- malt
%+ turn `(list @tas)`(turn (~(tap by cur-vanes)) head)
|= syd/@tas
2016-01-11 23:00:38 +03:00
:- syd
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon)
2016-01-11 23:00:38 +03:00
(emit %poke /kiln/reload/zuse [our %hood] %helm-reload [%zuse vanes])
:: XX updates cur-vanes?
=- =. ^cur-vanes cur-vanes
(emil cards)
%+ roll `(list @tas)`vanes
2016-01-11 23:00:38 +03:00
=< %_(. cur-vanes ^cur-vanes)
2016-02-04 10:12:23 +03:00
::^- $-([@tas _+>.^$] _+>.^$)
|= {syd/@tas cur-vanes/(map @tas @uvI) cards/(list card)}
2016-01-11 23:00:38 +03:00
=+ ^= new-vane
.^(@uvI %cz /(scot %p our)/home/(scot %da now)/arvo/[syd]/hoon)
2016-01-11 23:00:38 +03:00
?: =(`new-vane (~(get by cur-vanes) syd))
[cur-vanes cards]
:- (~(put by cur-vanes) syd new-vane)
[[%poke /kiln/reload/[syd] [our %hood] %helm-reload ~[syd]] cards]
2015-09-17 01:39:11 +03:00
=. +>.$
%- emit :*
2016-01-11 23:00:38 +03:00
%warp /kiln/autoload [our our] %home ~
%next %z da+now /arvo
2015-09-17 01:39:11 +03:00
==
abet
::
2015-09-26 03:23:06 +03:00
++ take-wake-overload
2015-12-20 23:50:45 +03:00
|= {way/wire $~}
2015-12-09 04:54:26 +03:00
?> ?=({@ $~} way)
=+ tym=(slav %dr i.way)
2015-09-26 03:23:06 +03:00
=. +>.$
(emit %wipe /kiln/overload/[i.way] our ~)
2015-09-26 03:23:06 +03:00
=. +>.$
(emit %wait /kiln/overload/[i.way] (add tym now))
2015-09-26 03:23:06 +03:00
abet
::
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)
:: %- emit :: XX not displayed/immediately
:: [%poke /kiln/spam [our %talk] (said our %kiln now eny mes)]
::
++ auto
|= kiln-sync
=+ (fall (~(get by syn) syd her sud) [let=*@ud ust=ost])
|%
++ abet
..auto(syn (~(put by syn) [syd her sud] let ust))
2015-06-18 02:44:00 +03:00
::
2015-09-02 01:20:17 +03:00
++ blab
2015-12-20 23:50:45 +03:00
|= new/(list move)
2015-09-02 01:20:17 +03:00
^+ +>
+>.$(moz (welp new moz))
2015-05-12 03:31:37 +03:00
::
2015-09-02 01:20:17 +03:00
++ spam |*(* %_(+> ..auto (^spam +<)))
++ stop
=> (spam (render "ended autosync" sud her syd) ~)
%- blab :_ ~
:* ust %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
[our her] sud ~
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
%- blab
:~ :* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
2016-02-01 09:16:26 +03:00
[our her] sud ~ %sing %y ud+let /
2016-01-07 01:08:46 +03:00
== ==
::
++ start-sync
2016-02-26 02:19:44 +03:00
|= reset/?
=. +>.$ (spam (render "activated sync" sud her syd) ~)
2015-09-02 01:20:17 +03:00
%- blab
2016-01-07 01:08:46 +03:00
:~ :* ost %warp
2016-02-26 02:19:44 +03:00
[%kiln %sync syd (scot %p her) sud ?:(reset /reset /)]
2015-09-02 01:20:17 +03:00
[our her] sud ~ %sing %w [%da now] /
== ==
2015-05-12 03:31:37 +03:00
::
2015-09-02 01:20:17 +03:00
++ writ
2016-02-26 02:19:44 +03:00
|= {reset/? rot/riot}
2015-09-02 01:20:17 +03:00
?~ rot
%^ spam
2015-12-21 00:16:39 +03:00
leaf+"bad %writ response"
2015-09-02 01:20:17 +03:00
(render "on sync" sud her syd)
~
2015-12-09 04:54:26 +03:00
=. let ?. ?=($w p.p.u.rot) let ((hard @ud) q.q.r.u.rot)
2016-01-07 10:08:09 +03:00
%- blab ^- (list move) :_ ~
2015-09-02 01:20:17 +03:00
:* ost %merg
2016-02-26 02:19:44 +03:00
[%kiln %sync syd (scot %p her) sud ?:(reset /reset /)]
2015-12-21 00:16:39 +03:00
our syd her sud ud+let
2016-01-26 03:47:58 +03:00
?: =(0 .^(* %cw /(scot %p our)/[syd]/(scot %da now)))
2015-09-02 01:20:17 +03:00
%init
%mate
==
2015-06-04 00:18:13 +03:00
::
2015-09-02 01:20:17 +03:00
++ mere
2016-02-26 02:19:44 +03:00
|= {reset/? mes/(each (set path) (pair term tang))}
2015-09-02 01:20:17 +03:00
=. let +(let)
=. +>.$
%- spam
2015-12-09 04:54:26 +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
==
::
2015-12-09 04:54:26 +03:00
$no-ali-desk
2015-09-02 01:20:17 +03:00
:~ (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
==
==
2016-02-26 02:19:44 +03:00
=. +>.$
?. reset +>.$
(blab [ost %poke /init-reset [our %hood] %helm-reset ~]~)
2015-09-02 01:20:17 +03:00
%- blab :_ ~
:* ost %warp
/kiln/sync/[syd]/(scot %p her)/[sud]
2016-02-01 09:16:26 +03:00
[our 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
2015-09-02 01:20:17 +03:00
=+ ^- kiln-desk
%+ fall (~(get by rem) syd)
=+ *kiln-desk
%_(- 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
2015-12-20 23:50:45 +03:00
|= new/(list move)
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)
2015-12-09 04:54:26 +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
::
2015-09-02 01:20:17 +03:00
++ gage-to-cages
2015-12-20 23:50:45 +03:00
|= gag/gage ^- (list (pair cage cage))
2015-09-02 01:20:17 +03:00
(unwrap-tang (gage-to-tage gag))
2015-05-12 03:31:37 +03:00
::
2015-09-02 01:20:17 +03:00
++ gage-to-tage
2015-12-20 23:50:45 +03:00
|= gag/gage
2015-09-02 01:20:17 +03:00
^- (each (list (pair cage cage)) tang)
2015-12-09 04:54:26 +03:00
?. ?=($tabl -.gag)
2015-12-10 12:17:19 +03:00
(mule |.(`$~`(ford-fail >%strange-gage< ~)))
=< ?+(. [%& .] {@ *} .)
|- ^- ?((list {cage cage}) (each $~ tang))
2015-09-02 01:20:17 +03:00
?~ p.gag ~
?- -.p.i.p.gag
$tabl (mule |.(`$~`(ford-fail >%strange-gage< ~)))
$| (mule |.(`$~`(ford-fail p.p.i.p.gag)))
$&
?- -.q.i.p.gag
2015-12-10 12:17:19 +03:00
$tabl (mule |.(`$~`(ford-fail >%strange-gage< ~)))
$| (mule |.(`$~`(ford-fail p.q.i.p.gag)))
$& =+ $(p.gag t.p.gag)
?+(- [[p.p p.q]:i.p.gag -] {@ *} -)
==
2015-12-09 04:54:26 +03:00
==
2015-05-12 03:31:37 +03:00
::
2015-09-02 01:20:17 +03:00
++ perform ::
^+ .
2015-09-08 23:15:40 +03:00
(blab [ost %merg /kiln/[syd] our 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
^+ +>
%- blab :_ ~
2016-01-07 01:08:46 +03:00
[ost %poke /kiln/fancy/[^syd] [our %hood] %kiln-merge [syd her sud cas gem]]
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 .^(@ %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
2015-12-20 23:50:45 +03:00
|= 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 :_ ~
2015-09-08 23:15:40 +03:00
[ost %merg /kiln/[syd] our (cat 3 syd '-scratch') her sud cas gem]
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
2015-12-20 23:50:45 +03:00
|= are/(each (set path) (pair term tang))
2015-09-02 01:20:17 +03:00
^+ +>
?: =(%meld gem)
2015-12-09 04:54:26 +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 :_ ~
2015-09-02 01:20:17 +03:00
:* ost %exec /kiln/[syd]
our ~ [our tic %da now] %tabl
^- (list (pair silk silk))
2015-12-21 00:16:39 +03:00
:: ~& > kiln-mashing+[p.are syd=syd +<.abet]
2015-09-02 01:20:17 +03:00
%+ turn (~(tap in p.are))
2015-12-20 23:50:45 +03:00
|= pax/path
2015-09-02 01:20:17 +03:00
^- (pair silk silk)
:- [%$ %path -:!>(*path) pax]
=+ base=[%file [our tic %da now] (flop pax)]
=+ alis=[%file [her sud cas] (flop pax)]
=+ bobs=[%file [our syd %da now] (flop pax)]
=+ dali=[%diff base alis]
=+ dbob=[%diff base bobs]
2015-12-20 23:50:45 +03:00
=+ ^- for/mark
2015-09-02 01:20:17 +03:00
=+ (slag (dec (lent pax)) pax)
?~(- %$ i.-)
[%mash for [her sud dali] [our syd dbob]]
==
=+ "failed to merge with strategy meld"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- >p.p.are< q.p.are)
2015-12-09 04:54:26 +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
2015-12-20 23:50:45 +03:00
|= {dep/@uvH reg/gage}
2015-09-02 01:20:17 +03:00
^+ +>
2015-12-09 04:54:26 +03:00
?: ?=($| -.reg)
2015-09-02 01:20:17 +03:00
=+ "failed to mash"
2015-12-21 00:16:39 +03:00
lose:(spam leaf+- p.reg)
2015-12-20 23:50:45 +03:00
=+ ^- can/(list (pair path (unit miso)))
2015-09-02 01:20:17 +03:00
%+ turn (gage-to-cages reg)
2015-12-20 23:50:45 +03:00
|= {pax/cage dif/cage}
2015-09-02 01:20:17 +03:00
^- (pair path (unit miso))
2015-12-09 04:54:26 +03:00
?. ?=($path p.pax)
2015-09-02 01:20:17 +03:00
~| "strange path mark: {<p.pax>}"
!!
2015-12-09 04:54:26 +03:00
[((hard 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')
2015-12-20 23:50:45 +03:00
=+ ^- 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)
:_ ~
2015-09-06 04:14:00 +03:00
:* ost %info /kiln/[syd] our
(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])
==
2015-05-12 03:31:37 +03:00
--
--