urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-20 01:01:37 +03:00
Code Issues Packages Projects Releases Wiki Activity

ddiff: c/r

Browse Source
This commit is contained in:
raghu 2021-03-05 17:09:24 -05:00
parent c98e1df819
commit a7165e0f85
1 changed files with 94 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

167
pkg/arvo/ted/ddiff.hoon
View File

@ -7,15 +7,20 @@
=/ m (strand ,vase) =/ m (strand ,vase)
^- form:m ^- form:m
|^ |^
=+ !<([~ =a=path =b=path shallow=flag] arg) :: workaround to make the shallow flag optional. if it's specified we
:: do require a non-empty path - however this shouldn't be called with
:: empty paths to begin with.
=+ !<([~ =a=path b=$~([/hi &] $^([(lest @ta) flag] path))] arg)
=/ [b-path=path shallow=flag] ?:(?=([^ *] b) b [`path`b |])
=/ a-beam (need (de-beam a-path)) =/ a-beam (need (de-beam a-path))
=/ b-beam (need (de-beam b-path)) =/ b-beam (need (de-beam b-path))
;< a-dome=dome bind:m (get-from-clay a-beam dome %v) ;< a-dome=dome bind:m (get-from-clay a-beam dome %v)
;< b-dome=dome bind:m (get-from-clay b-beam dome %v) ;< b-dome=dome bind:m (get-from-clay b-beam dome %v)
;< diff=vase bind:m (diff-beams a-beam ank.a-dome b-beam ank.b-dome) ;< diffs=(list diff-type) bind:m (diff-beams a-beam b-beam)
=/ diffs=(list diff-type) !<((list diff-type) diff)
%- pure:m %- pure:m
!> ^- tang !> ^- tang
:: our tang is built in reverse order
%- flop
?: shallow ?: shallow
(format-shallow diffs q.a-beam q.b-beam) (format-shallow diffs q.a-beam q.b-beam)
(format-deep diffs q.a-beam q.b-beam) (format-deep diffs q.a-beam q.b-beam)
@ -26,8 +31,9 @@
:: 3. %other is for files that don't use txt-diff - we just take :: 3. %other is for files that don't use txt-diff - we just take
:: the mug of the files :: the mug of the files
+$ diff-type +$ diff-type
:: path of the diffed beams :: paths of the diffed beams
$: pax=path $: a=path
b=path
$% [%txt-diff diff=(urge cord)] $% [%txt-diff diff=(urge cord)]
[%directory-diff p=(list path) q=(list path)] [%directory-diff p=(list path) q=(list path)]
[%other p=@ q=@] [%other p=@ q=@]
@ -38,14 +44,14 @@
++ diff-is-empty ++ diff-is-empty
|= d=diff-type |= d=diff-type
^- flag ^- flag
?: ?=([%txt-diff *] +.d) ?: ?=([%txt-diff *] +.+.d)
:: levy produces & on empty lists :: levy produces & on empty lists
%+ levy %+ levy
diff.d diff.d
|= u=(unce cord) |= u=(unce cord)
^- flag ^- flag
-:u -:u
?: ?=([%directory-diff *] +.d) ?: ?=([%directory-diff *] +.+.d)
=(p.d q.d) =(p.d q.d)
=(p.d q.d) =(p.d q.d)
:: +get-file: retrieve a cage of a file from clay :: +get-file: retrieve a cage of a file from clay
@ -75,26 +81,26 @@
:: ::
++ diff-beams ++ diff-beams
=< =<
|= [a=beam a-ankh=ankh b=beam b-ankh=ankh] |= [a=beam b=beam]
=/ m (strand ,vase) =/ m (strand ,(list diff-type))
^- form:m ^- form:m
?> =(s.a s.b)
;< hash-a=@ bind:m (get-from-clay a @ %z) ;< hash-a=@ bind:m (get-from-clay a @ %z)
;< hash-b=@ bind:m (get-from-clay b @ %z) ;< hash-b=@ bind:m (get-from-clay b @ %z)
:: if the recursive hashes for each beam are the same we bail early :: if the recursive hashes for each beam are the same we bail early
?: =(hash-a hash-b) ?: =(hash-a hash-b)
(pure:m !>(*(list diff-type))) (pure:m *(list diff-type))
:: vase of a (unit diff-type) ;< a-arch=arch bind:m (get-from-clay a arch %y)
;< file-diff=vase bind:m (diff-file-contents a a-ankh b b-ankh) ;< b-arch=arch bind:m (get-from-clay b arch %y)
;< file-diff=(unit diff-type) bind:m (diff-file-contents a a-arch b b-arch)
:: get distinct files along with shared files :: get distinct files along with shared files
=/ a-keys=(set @t) ~(key by dir.a-ankh) =/ a-keys=(set @t) ~(key by dir.a-arch)
=/ b-keys=(set @t) ~(key by dir.b-ankh) =/ b-keys=(set @t) ~(key by dir.b-arch)
:: unique children :: unique children
=/ a-unique-children=(set @t) (~(dif in a-keys) b-keys) =/ a-unique-children=(set @t) (~(dif in a-keys) b-keys)
=/ b-unique-children=(set @t) (~(dif in b-keys) a-keys) =/ b-unique-children=(set @t) (~(dif in b-keys) a-keys)
=/ a-unique=(list path) (format-unique-children a a-ankh a-unique-children) ;< a-unique=(list path) bind:m (format-unique-children a a-arch a-unique-children)
=/ b-unique=(list path) (format-unique-children b b-ankh b-unique-children) ;< b-unique=(list path) bind:m (format-unique-children b b-arch b-unique-children)
=/ unique-diff=diff-type [s.a %directory-diff a-unique b-unique] =/ unique-diff=diff-type [s.a s.b %directory-diff a-unique b-unique]
:: shared children :: shared children
=/ find-common-diffs =/ find-common-diffs
|. |.
@ -105,25 +111,25 @@
=* loop $ =* loop $
^- form:m ^- form:m
?~ common-children ?~ common-children
(pure:m !>(acc)) (pure:m acc)
=/ child=@t i.common-children =/ child=@t i.common-children
=/ new-a=beam a(s (snoc s.a child)) =/ new-a=beam a(s (snoc s.a child))
=/ new-b=beam b(s (snoc s.b child)) =/ new-b=beam b(s (snoc s.b child))
;< res=vase bind:m ;< diffs=(list diff-type) bind:m
(diff-beams new-a (~(got by dir.a-ankh) child) new-b (~(got by dir.b-ankh) child)) (diff-beams new-a new-b)
:: ;< introduces another $ so we use "loop" instead. :: ;< introduces another $ so we use "loop" instead.
%= loop %= loop
acc (weld !<((list diff-type) res) acc) acc (weld diffs acc)
common-children t.common-children common-children t.common-children
== ==
;< common-diffs=vase bind:m (find-common-diffs) ;< common-diffs=(list diff-type) bind:m (find-common-diffs)
%- pure:m %- pure:m
!> ^- (list diff-type) ^- (list diff-type)
%+ skip %+ skip
;: weld ;: weld
(drop !<((unit diff-type) file-diff)) (drop file-diff)
[unique-diff ~] [unique-diff ~]
!<((list diff-type) common-diffs) common-diffs
== ==
diff-is-empty diff-is-empty
|% |%
@ -131,66 +137,62 @@
:: files that are unique within a directory. :: files that are unique within a directory.
:: ::
++ format-unique-children ++ format-unique-children
=< |= [bem=beam ark=arch children=(set @t)]
|= [bem=beam ank=ankh children=(set @t)] =/ m (strand ,(list path))
^- (list path) ^- form:m
%- ~(rep by dir.ank) =/ children=(list @t) ~(tap in children)
|= [[key=@t node=ankh] acc=(list path)] =| acc=(list path)
^- (list path) |-
?. (~(has in children) key) =* loop $
acc ^- form:m
(weld (get-all-paths node (snoc s.bem key)) acc) ?~ children
|% (pure:m acc)
++ get-all-paths :: the %t care gives all paths with the specified prefix
|= [ank=ankh cur-path=path] ;< res=(list path) bind:m (get-from-clay bem(s (snoc s.bem i.children)) (list path) %t)
^- (list path) %= loop
:: check for terminal node acc (weld res acc)
?: =(~(wyt by dir.ank) 0) children t.children
~[cur-path] ==
%- ~(rep by dir.ank)
|= [[key=@t node=ankh] acc=(list path)]
^- (list path)
=/ new-path=path (snoc cur-path key)
=/ child-paths=(list path) (get-all-paths node new-path)
(weld child-paths acc)
--
:: +diff-file-contents: diff two files at specified beams, :: +diff-file-contents: diff two files at specified beams,
:: producing a vase of (unit diff-type) :: producing a vase of (unit diff-type)
++ diff-file-contents ++ diff-file-contents
=< =<
|= [a=beam a-ankh=ankh b=beam b-ankh=ankh] |= [a=beam a-arch=arch b=beam b-arch=arch]
=/ m (strand ,vase) =/ m (strand ,(unit diff-type))
^- form:m ^- form:m
:: the files must be at the same path ?: =(fil.a-arch fil.b-arch)
?> =(s.a s.b) (pure:m *(unit diff-type))
?: =(fil.a-ankh fil.b-ankh) ?~ fil.a-arch
(pure:m !>(*(unit diff-type)))
?~ fil.a-ankh
:: only b has contents :: only b has contents
%- pure:m %- pure:m
!> ^- (unit diff-type) ^- (unit diff-type)
%- some %- some
:+ s.a :^ s.a
s.b
%txt-diff %txt-diff
:_ ~ :_ ~
^- (unce cord) ^- (unce cord)
:+ %| :+ %|
~ ~
~[(format-file-content-missing s.b q.b)] ~[(format-file-content-missing s.b q.b)]
?~ fil.b-ankh ?~ fil.b-arch
:: only a has contents :: only a has contents
%- pure:m %- pure:m
!> ^- (unit diff-type) ^- (unit diff-type)
%- some %- some
:+ s.a :^ s.a
s.b
%txt-diff %txt-diff
:_ ~ :_ ~
^- (unce cord) ^- (unce cord)
:+ %| :+ %|
~[(format-file-content-missing s.a q.a)] ~[(format-file-content-missing s.a q.a)]
~ ~
:: have two file contents - diff them :: have two file contents - check that they have
:: the same mark.
=/ mar=mark -:(flop s.a) =/ mar=mark -:(flop s.a)
?: !=(mar -:(flop s.b))
(strand-fail:strandio %files-not-same-type >s.a< >s.b< ~)
;< =a=cage bind:m (get-file a) ;< =a=cage bind:m (get-file a)
;< =b=cage bind:m (get-file b) ;< =b=cage bind:m (get-file b)
;< =dais:clay bind:m (build-mark:strandio -.a mar) ;< =dais:clay bind:m (build-mark:strandio -.a mar)
@ -198,14 +200,16 @@
:: for all other marks we just take the mug) :: for all other marks we just take the mug)
%- pure:m %- pure:m
?: =(form:dais %txt-diff) ?: =(form:dais %txt-diff)
!> ^- (unit diff-type) ^- (unit diff-type)
%- some %- some
:+ s.a :^ s.a
s.b
%txt-diff %txt-diff
!<((urge cord) (~(diff dais q.a-cage) q.b-cage)) !<((urge cord) (~(diff dais q.a-cage) q.b-cage))
!> ^- (unit diff-type) ^- (unit diff-type)
%- some %- some
:+ s.a :^ s.a
s.b
%other %other
:: For some reason, vases for identical files on different desks :: For some reason, vases for identical files on different desks
:: can sometimes have different types. for this reason, we only :: can sometimes have different types. for this reason, we only
@ -225,6 +229,12 @@
== ==
-- --
-- --
:: +format-paths: helper to combine two paths into a tape
::
++ format-paths
|= [a=path b=path]
^- tape
;:(weld <a> " " <b>)
:: +format-directory-diff: helper for producing a tank based on :: +format-directory-diff: helper for producing a tank based on
:: a %directory-diff :: a %directory-diff
:: ::
@ -244,11 +254,11 @@
diffs diffs
|= [d=diff-type acc=tang] |= [d=diff-type acc=tang]
^- tang ^- tang
?: ?=([%txt-diff *] +.d) ?: ?=([%txt-diff *] +.+.d)
[`tank`>pax.d< acc] [leaf+(format-paths a.d b.d) acc]
?: ?=([%other *] +.d) ?: ?=([%other *] +.+.d)
[`tank`>pax.d< acc] [leaf+(format-paths a.d b.d) acc]
?: ?=([%directory-diff *] +.d) ?: ?=([%directory-diff *] +.+.d)
;: weld ;: weld
(format-directory-diff p.d a) (format-directory-diff p.d a)
(format-directory-diff q.d b) (format-directory-diff q.d b)
@ -265,25 +275,22 @@
diffs diffs
|= [d=diff-type acc=tang] |= [d=diff-type acc=tang]
^- tang ^- tang
?: ?=([%txt-diff *] +.d) ?: ?=([%txt-diff *] +.+.d)
:: TODO come up with some more readable formatting :+ leaf+(format-paths a.d b.d)
:: super ugly when printed. >diff.d<
:- >pax.d<
%+ weld
(turn diff.d |=(u=(unce cord) >u<))
acc acc
?: ?=([%directory-diff *] +.d) ?: ?=([%directory-diff *] +.+.d)
;: weld ;: weld
(format-directory-diff p.d a) (format-directory-diff p.d a)
(format-directory-diff q.d b) (format-directory-diff q.d b)
acc acc
== ==
?: ?=([%other *] +.d) ?: ?=([%other *] +.+.d)
:_ acc :_ acc
:- %leaf :- %leaf
;: weld ;: weld
"file " "file "
<pax.d> <a.d>
" has mug " " has mug "
<p.d> <p.d>
" on desk " " on desk "