Skip to content

Commit

Permalink
Merge pull request #6056 from urbit/jm/tomb-recurse
Browse files Browse the repository at this point in the history 
hood: recursive `|tomb`
  • Loading branch information
@belisarius222
belisarius222 committed Mar 1, 2023
2 parents e4f5a92 + c4d3d44 commit ccc3527
Show file tree
Hide file tree
Showing 3 changed files with 182 additions and 47 deletions.
20 changes: 20 additions & 0 deletions pkg/arvo/gen/hood/tomb-lobe.hoon
View file
@@ -0,0 +1,20 @@
:: Perform minimal norm change to delete a file, use =dry & for dry run
::
:: TODO: recognize when it's going to fail because it's in the head of
:: a desk, and maybe offer to |rm
::
=, clay
:- %say
|= [[now=@da eny=@uvJ bec=beak] [target=path ~] dry=_|]
:- %helm-pans
=; cards
?. dry cards
%- (slog leaf+"card: {<cards>}" ~) ~
=| lubs=(list note-arvo)
|- ^- (list note-arvo)
=+ .^(=arch %cy target)
?^ fil.arch (snoc lubs [%c %tomb %lobe u.fil.arch])
%- zing
%+ turn ~(tap by dir.arch)
|= [kid=@ta ~]
^$(target (weld target /[kid]))
204 changes: 157 additions & 47 deletions pkg/arvo/gen/hood/tomb.hoon
View file
@@ -1,56 +1,142 @@
:: Perform minimal norm change to delete a file, use =dry & for dry run
:: perform minimal norm change to permanently delete files
::
:: TODO: recognize when it's going to fail because it's in the head of
:: a desk, and maybe offer to |rm
:: use =dry & for dry run
::
/+ *generators, *sole
=, space:userlib
=, clay
:- %say
:- %ask
|= [[now=@da eny=@uvJ bec=beak] [target=path ~] dry=_|]
:- %helm-pans
=+ .^(=arch %cy target)
?~ fil.arch
[%d %flog %text "tomb: not a file"]~ :: should recurse
=/ =lobe u.fil.arch
|^
=+ .^(=rang %cx /(scot %p p.bec)//(scot %da now)/rang)
=+ .^(=cone %cx /(scot %p p.bec)//(scot %da now)/domes)
=/ domes=(list [[=ship =desk] foam]) ~(tap by cone)
=/ norms
|^
|- ^- (set [ship desk tako norm path])
?~ domes
~
=/ n 1
=/ =aeon 1
%- ~(uni in $(domes t.domes))
|- ^- (set [ship desk tako norm path])
?: (lth let.i.domes aeon)
~
=/ =tako (~(got by hit.i.domes) aeon)
=/ paths (draw-tako ship.i.domes desk.i.domes +.i.domes tako)
(~(uni in paths) $(aeon +(aeon)))
=/ =beam (need (de-beam target)) :: beam of target
=/ dusk=desk q:beam :: desk to delete from
=+ .^(do=dome %cv target) :: dome of that desk
=/ domes=(list [[=ship =desk] foam]) :: all domes on ship
~(tap by cone)
=+ .^(=cass %cw (en-beam beam(r da+now))) :: latest aeon
=/ used=(list [desk path]) :: desks using the target
=- (murn lobes -) :: match over lobes
|= lob=lobe
^- (unit [desk path])
=/ doms=(list [[=ship =desk] foam]) domes
|-
=* dome-loop $
?~ doms ~
?: =(0 let.i.doms) dome-loop(doms t.doms) :: skip empty domes
?: =(dusk desk.i.doms) dome-loop(doms t.doms) :: skip target dome
=/ latest=yaki :: only consider latest
%- ~(got by hut.rang)
%- ~(got by hit.i.doms)
let.i.doms :: aeon of dome
=/ yakies=(list [=path =lobe]) ~(tap by q.latest) :: latest yakis in dome
|-
=* path-loop $
?~ yakies dome-loop(doms t.doms)
?: =(lob lobe.i.yakies) :: found a match
`[desk.i.doms path.i.yakies] :: return desk and path
path-loop(yakies t.yakies)
?: ?| =(let.do ud.cass) :: at dusk head
!=(0 (lent used)) :: at other desk head
==
=/ pax=path +>+:target
=/ hed=^beam beam(r da+now, q dusk, s pax)
=/ org=^beam beam(q dusk, s +>+:target)
=/ paths=(list path) :: paths blocking tomb
?~(used ~[target] (turn used tail))
=/ all=(set desk) :: desks blocking tomb
(silt ?~(used ~[dusk] (turn used head)))
=/ prat=(list tank) :: printout of paths
%+ turn used
|= [=desk =path]
[%leaf "{<desk>}: {<path>}"]
=/ prom=$-([tint tape] sole-prompt) :: styled |rm prompt
|= [=tint =tape]
[%& %prompt (snoc *styx [[~ `tint ~] tape])]
:: print out the paths blocking the tomb
%+ prints (snoc prat leaf+"tomb blocked by:")
:: prompt for deletion using |rm
%+ prompt (prom %r "|rm from head of each desk instead (DANGER)? (y/N)")
|= rm-all=tape
?. |(=("y" rm-all) =("Y" rm-all) =("yes" rm-all))
no-product
::
++ draw-tako
|= [=ship =desk foam =tako]
^- (set [^ship ^desk ^tako norm path])
~+
=/ =yaki (~(got by hut.rang) tako)
=/ takos
|- ^- (set [^ship ^desk ^tako norm path])
?~ p.yaki
~
(~(uni in $(p.yaki t.p.yaki)) ^$(tako i.p.yaki))
%+ prompt
(prom %r "confirm deletion of {<paths>} from {<~(tap in all)>}? (y/N)")
|= confirm=tape
?. |(=("y" confirm) =("Y" confirm) =("yes" confirm))
no-product
::
?: dry
(print (crip "dry run: would remove {<paths>} from {<~(tap in all)>}") no-product)
%+ produce %helm-pans
%+ turn used
|= [=desk =path]
%- rm
%- en-beam
beam(r da+now, q desk, s path)
:: no blocking paths, tombstone the target recursively
%- produce
:- %helm-pans
=- ?: dry -
%. [%c %tomb %pick ~]
(cury snoc -)
^- (list note-arvo)
%- zing
=- (turn - notes) :: produce cards
=- (turn lobes -) :: hashes
|= =lobe
|^
|- ^- (set [ship desk tako norm path])
?~ domes
~
=/ =aeon 1
%- ~(uni in $(domes t.domes))
|- ^- (set [ship desk tako norm path])
?: (lth let.i.domes aeon) :: only past aeons
~
=/ =tako (~(got by hit.i.domes) aeon)
=/ paths
(draw-tako ship.i.domes desk.i.domes +.i.domes tako)
(~(uni in paths) $(aeon +(aeon)))
::
++ draw-tako
|= [=ship =desk foam =tako]
^- (set [^ship ^desk ^tako norm path])
~+
=/ =yaki (~(got by hut.rang) tako)
=/ takos
|- ^- (set [^ship ^desk ^tako norm path])
?~ q.yaki
takos
%- ~(uni in $(q.yaki l.q.yaki))
%- ~(uni in $(q.yaki r.q.yaki))
^- (set [^ship ^desk ^tako norm path])
?. =(lobe q.n.q.yaki)
?~ p.yaki
~
[[ship desk tako (~(gut by tom) tako nor) p.n.q.yaki] ~ ~]
--
^- (list note-arvo)
%+ welp
(~(uni in $(p.yaki t.p.yaki)) ^$(tako i.p.yaki))
|- ^- (set [^ship ^desk ^tako norm path])
?~ q.yaki
takos
%- ~(uni in $(q.yaki l.q.yaki))
%- ~(uni in $(q.yaki r.q.yaki))
^- (set [^ship ^desk ^tako norm path])
?. =(lobe q.n.q.yaki)
~
[[ship desk tako (~(gut by tom) tako nor) p.n.q.yaki] ~ ~]
--
:: +lobes: recursively list hashes under target
::
++ lobes
=| lubs=(list lobe)
|- ^- (list lobe)
=+ b=.^(arch %cy target)
?: ?=(^ fil.b) (snoc lubs u.fil.b)
%- zing
%+ turn ~(tap by dir.b)
|= [kid=@ta ~]
^$(target (weld target /[kid]))
:: +notes: build cards for each path to tombstone
::
++ notes
|= norms=(set [ship desk tako norm path])
^- (list note-arvo)
%+ murn ~(tap in norms)
|= [=ship =desk =tako =norm =path]
?: ?=([~ %|] (~(fit of norm) path))
Expand All @@ -59,6 +145,30 @@
?: dry
~
`[%c %tomb %worn ship desk tako (~(put of norm) path %|)]
?: dry
~
[%c %tomb %pick ~]~
:: +info: toro into card
::
:: XX move to a shared library
++ info
|= tor=(unit toro)
^- note-arvo
~| [%tomb-error "tomb: failed to delete {<target>}"]
[%c [%info (need tor)]]
:: +rm: remove a path from a desk
::
:: XX move to a shared library
++ rm
|= a=path
=| c=(list (unit toro))
%- info
=- %+ roll -
|= [a=(unit toro) b=(unit toro)]
(clap a b furl)
|- ^- (list (unit toro))
=+ b=.^(arch %cy a)
?: ?=([^ ~] b) (snoc c `(fray a))
=? c ?=(^ fil.b) (snoc c `(fray a))
%- zing
%+ turn ~(tap by dir.b)
|= [kid=@ta ~]
^$(a (weld a /[kid]))
--
5 changes: 5 additions & 0 deletions pkg/arvo/lib/generators.hoon
View file
Expand Up @@ -4,6 +4,11 @@
++ produce :: construct result
|* pro=* ::
[p=*(list tank) q=[%& p=[~ u=pro]]] ::
::
++ prints :: add output tanks
|* [tan=(list tank) res=(sole-result)] ::
?@ res res ::
[p=`(list tank)`(welp tan p.res) q=q.res] ::
:: ::
++ print :: add output tank
|* [tan=tank res=(sole-result)] ::
Expand Down

0 comments on commit ccc3527

Please sign in to comment.