:: :: :: :::: /hook/core/kiln/lib :: :: :: :: :: /? 310 :: version /- *talk :: structures /+ talk :: libraries :: :: :: :::: :: :: :: :: :: |% :: :: ++ kiln-part :: kiln state $: %kiln :: doubletag %0 :: state version rem=(map desk kiln-desk) :: == :: ++ kiln-desk :: per-desk state $: auto=? :: escalate on failure gem=germ :: strategy her=@p :: from ship sud=@tas :: from desk cas=case :: at case == :: :: :: :: :::: :: :: :: :: :: ++ hood-unix :: $: syd=desk :: syn=(unit bean) :: == :: ++ hood-sync :: $: syd=desk :: her=ship :: sud=desk :: == :: ++ hood-merge :: $: syd=desk :: ali=ship :: sud=desk :: gim=?(%auto germ) :: == :: -- :: :: :: :: :::: :: :: !: :: :: |% :: kiln library ++ kiln-work :: work in kiln |= [[hide from] kiln-part] ?> =(src our) => |% :: arvo structures ++ card :: $% [%exec wire @p beak (unit silk)] :: [%font wire @p @tas @p @tas] :: [%info wire @p @tas nori] :: [%lynx wire @p @tas (unit ,?)] :: [%merg wire @p @tas @p @tas germ] :: [%plug wire @p @tas @p @tas] :: [%poke wire dock pear] :: == :: ++ pear :: poke fruit $% [%talk-command command:talk] :: [%hood-merge hood-merge] :: == :: ++ suss ,[term @tas @da] :: config report ++ milk (trel ship desk silk) :: ++ silk :: $& [p=silk q=silk] :: cons $% [%diff p=silk q=silk] :: diff [%done p=(set beam) q=gage] :: literal [%file p=beam] :: from clay [%mash p=mark q=milk r=milk] :: merge [%tabl p=(list (pair silk silk))] :: list == :: ++ tage :: %tabl gage ,[[%tabl p=(list (pair marc marc))] q=vase] :: ++ move (pair bone card) :: user-level move -- |_ moz=(list move) ++ abet :: resolve [(flop moz) `kiln-part`+>+>->] :: ++ emit |=(card %_(+> moz [[ost +<] moz])) :: return card ++ emil :: return cards |= (list card) ^+ +> ?~(+< +> $(+< t.+<, +> (emit i.+<))) :: ++ poke-unix :: |= hood-unix abet:(emit %lynx /kiln our syd syn) :: ++ poke-sync :: |= hood-sync abet:(emit %font /kiln our syd her sud) :: ++ poke-merge :: |= hood-merge abet:abet:(merge:(work syd) ali sud gim) :: ++ take |=(way=wire ?>(?=([@ ~] way) (work i.way))) :: general handler ++ take-mere :: |= [way=wire are=(each (set path) (pair term tang))] abet:abet:(mere:(take way) are) :: ++ take-made :: |= [way=wire dep=@uvH reg=(each gage tang)] abet:abet:(made:(take way) dep reg) :: ++ take-coup-fancy :: |= [way=wire saw=(unit tang)] abet:abet:(coup-fancy:(take way) saw) :: ++ work :: state machine |= syd=desk =+ ^- kiln-desk %+ fall (~(get by rem) syd) =+ *kiln-desk %_(- cas [%da lat]) |% ++ abet :: resolve ..work(rem (~(put by rem) syd auto gem her sud cas)) :: ++ blab :: emit, XX remove |= new=(list move) ^+ +> +>.$(moz (welp new moz)) :: ++ win . :: successful poke ++ lose ^+ . ~| %kiln-work-failed !! :: ++ gage-to-tage :: |= res=gage ^- tage ?@ p.res ~|(%bad-marc !!) res :: ++ tage-to-cages :: |= tab=tage ^- (list (pair cage cage)) ?~ p.tab ~ :_ $(p.tab t.p.tab, q.tab (slot 3 q.tab)) ~| %strange-gage :- [?^(p.i.p.tab !! p.i.p.tab) (slot 4 q.tab)] [?^(q.i.p.tab !! q.i.p.tab) (slot 5 q.tab)] :: ++ perform :: ^+ . (blab [ost %merg /kiln/[syd] our syd her sud gem] ~) :: ++ fancy-merge :: send to self |= [syd=desk her=@p sud=desk gem=?(%auto germ)] ^+ +> %- blab :_ ~ [ost %poke /kiln/fancy/[^syd] [our %kiln] %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]] ~ ~] [lat *bouquet:talk [%app (crip ~(ram re tan))]] == :: ++ merge |= [her=@p sud=@tas gim=?(%auto germ)] ^+ +> =. cas [%da lat] ?. ?=(%auto gim) perform(auto |, gem gim, her her, sud sud) ?: =(0 .^(%cw /(scot %p our)/[syd]/(scot %da lat))) => $(gim %init) .(auto &) => $(gim %fine) .(auto &) :: ++ coup-fancy |= saw=(unit tang) ?~ saw => (spam leaf/"%melding %{(trip sud)} into scratch space" ~) %- blab :_ ~ [ost %merg /kiln/[syd] our (cat 3 syd '-scratch') her sud gem] =+ :- "failed to set up conflict resolution scratch space" "I'm out of ideas" lose:(spam leaf/-< leaf/-> ~) :: ++ mere |= are=(each (set path) (pair term tang)) ^+ +> ?: =(%meld gem) ?: ?=(%& -.are) ?. auto =+ "successfully merged with strategy {}" win:(spam leaf/- ?~(p.are ~ [>`(set path)`p.are< ~])) =+ "mashing conflicts" => .(+>.$ (spam leaf/- ~)) =+ tic=(cat 3 syd '-scratch') %- blab :_ ~ :* ost %exec /kiln/[syd] our [our tic %da lat] ~ %tabl ^- (list (pair silk silk)) %+ turn (~(tap in p.are)) |= pax=path ^- (pair silk silk) :- [%done ~ %path -:!>(*path) pax] =+ base=[%file [our tic %da lat] (flop pax)] =+ alis=[%file [her sud cas] (flop pax)] =+ bobs=[%file [our syd %da lat] (flop pax)] =+ dali=[%diff base alis] =+ dbob=[%diff base bobs] =+ ^- for=mark =+ (slag (dec (lent pax)) pax) ?~(- %$ i.-) [%mash for [her sud dali] [our syd dbob]] == =+ "failed to merge with strategy {}" lose:(spam leaf/- q.p.are) ?: ?=(%& -.are) =+ "successfully merged with strategy {}" win:(spam leaf/- ?~(p.are ~ [>`(set path)`p.are< ~])) ?. auto =+ "failed to merge with strategy {}" lose:(spam leaf/- q.p.are) ?+ gem (spam leaf/"strange auto" >gem< ~) :: %init =+ :- "auto merge failed on strategy %init" "I'm out of ideas" lose:(spam leaf/-< leaf/-> [>p.p.are< q.p.are]) :: %fine ?. ?=(%bad-fine-merge p.p.are) =+ "auto merge failed on strategy %fine" lose:(spam leaf/- >p.p.are< q.p.are) => (spam leaf/"%fine merge failed, trying %meet" ~) perform(gem %meet) :: %meet ?. ?=(%meet-conflict p.p.are) =+ "auto merge failed on strategy %meet" lose:(spam leaf/- >p.p.are< q.p.are) => (spam leaf/"%meet merge failed, trying %mate" ~) perform(gem %mate) :: %mate ?. ?=(%mate-conflict p.p.are) =+ "auto merge failed on strategy %mate" lose:(spam leaf/- >p.p.are< q.p.are) => .(gem %meld) =+ tic=(cat 3 syd '-scratch') => =+ :- "%mate merge failed with conflicts," "setting up scratch space at %{(trip tic)}" [tic=tic (spam leaf/-< leaf/-> ~)] (fancy-merge tic our syd %auto) == :: ++ made |= [dep=@uvH reg=(each gage tang)] ^+ +> ?: ?=(%| -.reg) =+ "failed to mash" lose:(spam leaf/- p.reg) =+ ^- can=(list (pair path (unit miso))) %+ turn (tage-to-cages (gage-to-tage p.reg)) |= [pax=cage dif=cage] ^- (pair path (unit miso)) ?. ?=(%path p.pax) ~| "strange path mark: {}" !! [((hard path) q.q.pax) ?:(?=(%null p.dif) ~ `[%dif dif])] =+ notated=(skid can |=([path a=(unit miso)] ?=(^ a))) =+ annotated=(turn `(list (pair path ,*))`-.notated head) =+ unnotated=(turn `(list (pair path ,*))`+.notated head) =+ (trip (cat 3 syd '-scratch')) =+ ^- tan=(list tank) %- zing ^- (list (list tank)) :~ :~ leaf/"" leaf/"done setting up scratch space in %{-}" leaf/"please resolve the following conflicts and run" leaf/":+merge %{(trip syd)} {} %{-}" == ?~ annotated ~ :~ leaf/"" leaf/"annotated conflicts in:" >`(list path)`annotated< == ?~ unnotated ~ :~ leaf/"" leaf/"some conflicts could not be annotated." leaf/"for these, the scratch space contains" leaf/"the most recent common ancestor of the" leaf/"conflicting content." leaf/"" leaf/"unannotated conflicts in:" >`(list path)`unnotated< == == =< win %- blab:(spam tan) :_ ~ :* ost %info /kiln/[syd]/dash our (cat 3 syd '-scratch') %& *cart %+ murn can |= [p=path q=(unit miso)] `(unit (pair path miso))`?~(q ~ `[p u.q]) == -- -- --