Merge pull request #4528 from taalhavras/desk-diff

ddiff: add thread for diffing desks

pkg/arvo/app/dojo.hoon

@@ -1077,7 +1077,12 @@
       ::
           %thread-done
         ?>  ?=(^ poy)
-        (~(dy-hand dy u.poy(pux ~)) %noun q.cage.sign)
+        ::  print the vase as a tang if it nests in tang
+        =/  =mark
+            ?:  (~(nest ut -:!>(*tang)) | p.q.cage.sign)
+              %tang
+            %noun
+        (~(dy-hand dy u.poy(pux ~)) mark q.cage.sign)
       ==
     ::
         %kick  +>.$

pkg/arvo/ted/diff.hoon

@@ -1,30 +1,299 @@
 /-  spider
 /+  strandio
 =,  strand=strand:spider
+=,  clay
 ^-  thread:spider
 |=  arg=vase
 =/  m  (strand ,vase)
 ^-  form:m
 |^
-=+  !<([~ =a=path =b=path] arg)
-=/  a-mark=mark  -:(flop a-path)
-=/  b-mark=mark  -:(flop b-path)
-?.  =(a-mark b-mark)
-  (strand-fail:strandio %files-not-same-type ~)
+::  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=cage     bind:m  (get-file a-path)
-;<  =b=cage     bind:m  (get-file b-path)
-;<  =dais:clay  bind:m  (build-mark:strandio -.a-beam a-mark)
-(pure:m (~(diff dais q.a-cage) q.b-cage))
+=/  b-beam  (need (de-beam b-path))
+;<  a-dome=dome  bind:m  (get-from-clay a-beam dome %v)
+;<  b-dome=dome  bind:m  (get-from-clay b-beam dome %v)
+;<  diffs=(list diff-type)  bind:m  (diff-beams a-beam b-beam)
+%-  pure:m
+!>  ^-  tang
+::  our tang is built in reverse order
+%-  flop
+?:  shallow
+  (format-shallow diffs a-beam b-beam)
+(format-deep diffs a-beam b-beam)
+::
+::  $diff-type: type for diffs produced.
+::    1. %txt-diff is a standard diff (i.e. for hoon and txt files)
+::    2. %directory-diff shows unique files between two directories
+::    3. %other is for files that don't use txt-diff - we just take
+::       the mug of the files
++$  diff-type
+  :: paths of the diffed beams
+  $:  a=path
+      b=path
+      $%  [%txt-diff diff=(urge cord)]
+          [%directory-diff p=(list path) q=(list path)]
+          [%other p=@ q=@]
+      ==
+  ==
+::  +diff-is-empty: check if a diff is empty (for two identical files)
+::
+++  diff-is-empty
+  |=  d=diff-type
+  ^-  flag
+  ?:  ?=([%txt-diff *] +.+.d)
+    :: levy produces & on empty lists
+    %+  levy
+      diff.d
+    |=  u=(unce cord)
+    ^-  flag
+    -:u
+  ?:  ?=([%directory-diff *] +.+.d)
+    =(p.d q.d)
+  =(p.d q.d)
+::  +get-file: retrieve a cage of a file from clay
 ::
 ++  get-file
-  |=  =path
+  |=  =beam
   =/  m  (strand ,cage)
   ^-  form:m
-  =/  beam  (need (de-beam path))
   ;<  =riot:clay  bind:m
     (warp:strandio p.beam q.beam ~ %sing %x r.beam s.beam)
   ?~  riot
-    (strand-fail:strandio %file-not-found >path< ~)
+    (strand-fail:strandio %file-not-found >s.beam< ~)
   (pure:m r.u.riot)
+::  +get-from-clay: retrieve other data from clay based on care
+::
+++  get-from-clay
+  |*  [=beam mol=mold =care]
+  =/  m  (strand ,mol)
+  ^-  form:m
+  ;<  =riot:clay  bind:m
+    (warp:strandio p.beam q.beam ~ %sing care r.beam s.beam)
+  ?~  riot
+    (strand-fail:strandio %file-not-found >s.beam< ~)
+  (pure:m !<(mol q.r.u.riot))
+::  +diff-beams: recursively diff two beams. produces a vase
+::  of (list diff-type)
+::
+++  diff-beams
+  =<
+  |=  [a=beam b=beam]
+  =/  m  (strand ,(list diff-type))
+  ^-  form:m
+  ;<  hash-a=@  bind:m  (get-from-clay a @ %z)
+  ;<  hash-b=@  bind:m  (get-from-clay b @ %z)
+  ::  if the recursive hashes for each beam are the same we bail early
+  ?:  =(hash-a hash-b)
+    (pure:m *(list diff-type))
+  ;<  a-arch=arch  bind:m  (get-from-clay a arch %y)
+  ;<  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
+  =/  a-keys=(set @t)  ~(key by dir.a-arch)
+  =/  b-keys=(set @t)  ~(key by dir.b-arch)
+  ::  unique children
+  =/  a-unique-children=(set @t)  (~(dif in a-keys) b-keys)
+  =/  b-unique-children=(set @t)  (~(dif in b-keys) a-keys)
+  ;<  a-unique=(list path)  bind:m  (format-unique-children a a-arch a-unique-children)
+  ;<  b-unique=(list path)  bind:m  (format-unique-children b b-arch b-unique-children)
+  =/  unique-diff=diff-type  [s.a s.b %directory-diff a-unique b-unique]
+  ::  shared children
+  =/  find-common-diffs
+    |.
+    ^-  form:m
+    =|  acc=(list diff-type)
+    =/  common-children=(list @t)  ~(tap in (~(int in a-keys) b-keys))
+    |-
+    =*  loop  $
+    ^-  form:m
+    ?~  common-children
+      (pure:m acc)
+    =/  child=@t  i.common-children
+    =/  new-a=beam  a(s (snoc s.a child))
+    =/  new-b=beam  b(s (snoc s.b child))
+    ;<  diffs=(list diff-type)  bind:m
+      (diff-beams new-a new-b)
+    ::  ;< introduces another $ so we use "loop" instead.
+    %=  loop
+      acc  (weld diffs acc)
+      common-children  t.common-children
+    ==
+  ;<  common-diffs=(list diff-type)  bind:m  (find-common-diffs)
+  %-  pure:m
+  ^-  (list diff-type)
+  %+  skip
+    ;:  weld
+      (drop file-diff)
+      [unique-diff ~]
+      common-diffs
+    ==
+  diff-is-empty
+  |%
+  ::  +format-unique-children: produce list of paths representing
+  ::  files that are unique within a directory.
+  ::
+  ++  format-unique-children
+    |=  [bem=beam ark=arch children=(set @t)]
+    =/  m  (strand ,(list path))
+    ^-  form:m
+    =/  children=(list @t)  ~(tap in children)
+    =|  acc=(list path)
+    |-
+    =*  loop  $
+    ^-  form:m
+    ?~  children
+      (pure:m acc)
+    ::  the %t care gives all paths with the specified prefix
+    ;<  res=(list path)  bind:m  (get-from-clay bem(s (snoc s.bem i.children)) (list path) %t)
+    %=  loop
+      acc  (weld res acc)
+      children  t.children
+    ==
+  ::  +diff-file-contents: diff two files at specified beams,
+  ::  producing a vase of (unit diff-type)
+  ++  diff-file-contents
+    =<
+    |=  [a=beam a-arch=arch b=beam b-arch=arch]
+    =/  m  (strand ,(unit diff-type))
+    ^-  form:m
+    ?:  =(fil.a-arch fil.b-arch)
+      (pure:m *(unit diff-type))
+    ?~  fil.a-arch
+      :: only b has contents
+      %-  pure:m
+      ^-  (unit diff-type)
+      %-  some
+      :^    s.a
+          s.b
+        %txt-diff
+      :_  ~
+      ^-  (unce cord)
+      :+  %|
+        ~
+      ~[(format-file-content-missing s.b q.b)]
+    ?~  fil.b-arch
+      :: only a has contents
+      %-  pure:m
+      ^-  (unit diff-type)
+      %-  some
+      :^    s.a
+          s.b
+        %txt-diff
+      :_  ~
+      ^-  (unce cord)
+      :+  %|
+        ~[(format-file-content-missing s.a q.a)]
+      ~
+    ::  have two file contents - check that they have
+    ::  the same mark.
+    =/  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)
+    ;<  =b=cage     bind:m  (get-file b)
+    ;<  =dais:clay  bind:m  (build-mark:strandio -.a mar)
+    ::  for txt-diff we produce an actual diff with type (urge cord).
+    ::  for all other marks we just take the mug)
+    %-  pure:m
+    ?:  =(form:dais %txt-diff)
+      ^-  (unit diff-type)
+      %-  some
+      :^    s.a
+          s.b
+        %txt-diff
+      !<((urge cord) (~(diff dais q.a-cage) q.b-cage))
+    ^-  (unit diff-type)
+    %-  some
+    :^    s.a
+        s.b
+      %other
+    ::  For some reason, vases for identical files on different desks
+    ::  can sometimes have different types. for this reason, we only
+    ::  take the mug of the data.
+    [(mug q.q.a-cage) (mug q.q.b-cage)]
+    |%
+    ++  format-file-content-missing
+      |=  [p=path d=desk]
+      ^-  cord
+      %-  crip
+      ;:  weld
+        "only "
+        <p>
+        " in desk "
+        <d>
+        " has file contents"
+      ==
+    --
+  --
+::  +format-beams: helper to combine two beams into a tank
+::
+++  format-beams
+  |=  [a=beam b=beam]
+  ^-  tank
+  [%rose [" " ~ ~] ~[(smyt (en-beam a)) (smyt (en-beam b))]]
+::  +format-directory-diff: helper for producing a tank based on
+::  a %directory-diff
+::
+++  format-directory-diff
+  |=  [paths=(list path) =beam]
+  ^-  tang
+  =/  prefix=tape  (weld "only in " <(en-beam beam)>)
+  %+  turn
+    paths
+  |=  p=path
+  ^-  tank
+  [%rose [": " ~ ~] [leaf+prefix (smyt p) ~]]
+::  +format-shallow: converts a list of diff-type generated
+::  between desks a and b into a tang in a shallow manner (just
+::  listing files that differ).
+::
+++  format-shallow
+|=  [diffs=(list diff-type) a=beam b=beam]
+  ^-  tang
+  %+  reel
+    diffs
+  |=  [d=diff-type acc=tang]
+  ^-  tang
+  ?:  ?=([%txt-diff *] +.+.d)
+    [(format-beams a(s a.d) b(s b.d)) acc]
+  ?:  ?=([%other *] +.+.d)
+    [(format-beams a(s a.d) b(s b.d)) acc]
+  ?:  ?=([%directory-diff *] +.+.d)
+    ;:  weld
+      (format-directory-diff p.d a)
+      (format-directory-diff q.d b)
+      acc
+    ==
+  !!
+::  +format-deep: converts a list of diff-type generated
+::  between desks a and b into a tang in a deep manner (preserving
+::  diff information for files)
+++  format-deep
+|=  [diffs=(list diff-type) a=beam b=beam]
+  ^-  tang
+  %+  reel
+    diffs
+  |=  [d=diff-type acc=tang]
+  ^-  tang
+  ?:  ?=([%txt-diff *] +.+.d)
+    :+  (format-beams a(s a.d) b(s b.d))
+      >diff.d<
+    acc
+  ?:  ?=([%directory-diff *] +.+.d)
+    ;:  weld
+      (format-directory-diff p.d a)
+      (format-directory-diff q.d b)
+      acc
+    ==
+  ?:  ?=([%other *] +.+.d)
+    =/  a-tank=tank  (smyt (en-beam a(s a.d)))
+    =/  b-tank=tank  (smyt (en-beam b(s b.d)))
+    :+  [%rose [" " "files " ~] ~[a-tank b-tank]]
+      [%rose [" and " "have mugs: " ~] ~[leaf+<p.d> leaf+<q.d>]]
+    acc
+  !!
 --