auto-generated diffing using Hoon types

differ.hoon

|%
::  +make-diff: create a noun representing the diff from :a to :b
::
++  make-diff
  |=  [a-vase=vase b-vase=vase]
  ^-  vase
  ::
  ?>  (~(nest ut p.a-vase) | p.b-vase)
  ?>  (~(nest ut p.b-vase) | p.a-vase)
  ::
  =/  typ=type  p.a-vase
  =/  a  q.a-vase
  =/  b  q.b-vase
  ::
  =/  diffed=type  (diff-type typ)
  ::
  :-  diffed
  ::
  |-  ^-  *
  ::
  ?-    typ
      %noun
    (diff-nouns a b)
  ::
      %void
    !!  ::  should never happen
  ::
      [%atom *]
    ?:  =(a b)
      ~
    `b
  ::
      [%cell *]
    =/  head  $(typ p.typ, a -.a, b -.b)
    =/  tail  $(typ q.typ, a +.a, b +.b)
    ?:  &(?=(~ head) ?=(~ tail))
      ~
    `[head tail]
  ::
      [%core *]
    !!  ::  should never happen
  ::
      [%face *]
    $(typ q.typ)  ::  unwrap the face in the type
  ::
      [%fork *]
    =/  a-typ=type  -:(spec [typ a])
    =/  b-typ=type  -:(spec [typ b])
    ::
    ?:  (~(nest ut a-typ) | b-typ)
      ::
      =/  recursed  $(typ a-typ)
      ?~  recursed
        ~
      `[%replace recursed]
    ::
    `[%switch b]
  ::
      [%help *]
    $(typ q.typ)
  ::
      [%hold *]
    $(typ (~(play ut p.typ) q.typ))  ::  maybe this should be +repo:ut
  ==
::  +diff-nouns: produce a list of [axis new-value] to diff untyped nouns
::
++  diff-nouns
  =|  swaps=(list [axis=@ud value=*])
  |=  [a=* b=*]
  ^+  swaps
  ::
  ?@  a
    ?:  =(a b)
      ~
    [1 b]~
  ?@  b
    [1 b]~
  ::
  =/  left=_swaps   $(a -.a, b -.b)
  =/  right=_swaps  $(a +.a, b +.b)
  ::
  ?:  &(?=([[%1 *] ~] left) ?=([[%1 *] ~] right))
    [1 value.i.left value.i.right]~
  ::
  =/  left-lifted
    %+  turn  left
    |=  [axis=@ud value=*]
    [(peg 2 axis) value]
  ::
  =/  right-lifted
    %+  turn  right
    |=  [axis=@ud value=*]
    [(peg 3 axis) value]
  ::
  (welp left-lifted right-lifted)
::  +diff-type: generate a type representing a diff of two values of :type
::
++  diff-type
  |=  =type
  ^+  type
  ::  wrap the whole type in a unit in case the two nouns are identical
  ::
  %-  unit-type
  ::
  ?@  type
    ?-  type
      %noun  -:!>(*(list [axis=@ud new-value=*]))
      %void  ~|  %void-type  !!
    ==
  ?-    -.type
      %atom
    :: constants have no diffs; other atoms are replaced wholesale
    ::
    ?~  constant=q.type
      type
    [%atom %n `~]
  ::
      %cell
    ::
    :+  %cell
      [%face [~ %head] $(type p.type)]
    [%face [~ %tail] $(type q.type)]
  ::
      %core
    ~|  %core-type  !!
  ::
      %face
    ::
    ?>  ?=(~ p.p.type)
    ?>  ?=(term q.p.type)
    ::
    [%face [~ q.p.type] $(type q.type)]
  ::
      %fork
    ::
    :-  %fork
    %-  ~(run in p.type)
    |=  tine=^type
    ^+  type
    ::
    :-  %fork
    %-  ~(gas in *(set ^type))
    :~  [%cell [%atom %tas `%replace] ^$(type tine)]
        [%cell [%atom %tas `%switch] type(p (~(del in p.type) tine))]
    ==
  ::
      %help
    $(type q.type)  ::  TODO preserve doc
  ::
      %hold
    ::
    :+  %hold
      :+  %cell
        [%face [~ %diff-type-core] -:!>(..diff-type)]
      [%face [~ %played-type] (~(play ut p.type) q.type)]
    ^-  hoon
    [%cnhp [%wing ~[%diff-type %diff-type-core]] [%wing ~[%played-type]]~]
  ==
::  construct a +type for a +unit whose non-nil value is of type :some-type
::
++  unit-type
  |=  some-type=type
  ^-  type
  ::
  :-  %fork
  %-  ~(gas in *(set type))
  ~[nil-type [%cell nil-type [%face [~ %u] some-type]]]
::  convenience arm for a type representing a constant nil
::
++  nil-type  `type`[%atom %n `~]
--