%mute schematic

gen/ford-turbo.hoon

@@ -100,6 +100,7 @@
   test-volt
   test-vale
   test-vale-error
+  test-mute
 ==
 ++  test-tear
   :-  `tank`leaf+"test-tear"
@@ -5084,6 +5085,61 @@
     (expect-ford-empty ford ~nul)
   ==
 ::
+++  test-mute
+  :-  `tank`leaf+"test-mute"
+  ::
+  =/  ford  *ford-gate
+  ::
+  =/  atom-type=type  [%atom %$ ~]
+  ::
+  =^  results1  ford
+    %-  test-ford-call-with-comparator  :*
+      ford
+      now=~1234.5.6
+      scry=scry-is-forbidden
+      ::
+      ^=  call-args
+        :*  duct=~[/path]  type=~  %make  ~nul
+            %pin  ~1234.5.6
+            %mute  subject=[%$ %foo !>([a=42 b=[43 c=44]])]
+            ^=  mutations  ^-  (list [wing schematic:ford])
+            :~
+              [~[%a] [%$ %noun atom-type 2]]
+              [~[%c %b] [%$ %noun atom-type 4]]
+        ==  ==
+      ::
+      ^=  comparator
+        |=  moves=(list move:ford-gate)
+        ::
+        ?>  =(1 (lent moves))
+        ?>  ?=(^ moves)
+        ?>  ?=([* %give %made @da %complete %success %pin *] i.moves)
+        =/  result  result.p.card.i.moves
+        =/  pin-result  build-result.result
+        ?>  ?=([%success %mute *] build-result.pin-result)
+        ::
+        =/  mark=term  p.cage.build-result.pin-result
+        =/  =vase      q.cage.build-result.pin-result
+        ::
+        ;:  welp
+          %-  expect-eq  !>
+          :-  %foo
+          mark
+        ::
+          %-  expect-eq  !>
+          :-  [2 43 4]
+          q.vase
+        ::
+          %-  expect-eq  !>
+          :-  &
+          (~(nest ut p.vase) | -:!>([2 43 4]))
+    ==  ==
+  ::
+  ;:  weld
+    results1
+    (expect-ford-empty ford ~nul)
+  ==
+::
 ::
 ::  |utilities: helper arms
 ::

lib/ford-turbo.hoon

@@ -2699,7 +2699,7 @@
             %hood  (make-hood source-path)
             %join  !!
             %mash  !!
-            %mute  !!
+            %mute  (make-mute subject mutations)
             %pact  !!
             %path  (make-path disc prefix raw-path)
             %plan  (make-plan path-to-render query-string scaffold)
@@ -2941,6 +2941,139 @@
       ::
       [build [%build-result %success %hood p.u.q.parsed] accessed-builds]
     ::
+    ++  make-mute
+      |=  [subject=schematic mutations=(list [=wing =schematic])]
+      ^-  build-receipt
+      ::  run the subject build to produce the noun to be mutated
+      ::
+      =/  subject-build=^build  [date.build subject]
+      =^  subject-result  accessed-builds  (depend-on subject-build)
+      ?~  subject-result
+        [build [%blocks [subject-build]~ ~] accessed-builds]
+      ::
+      ?.  ?=([~ %success *] subject-result)
+        (wrap-error subject-result)
+      ::
+      =/  subject-cage=cage  (result-to-cage u.subject-result)
+      ::
+      =/  subject-vase=vase  q.subject-cage
+      ::  run the mutants as sub-builds
+      ::
+      =^  results-raw  accessed-builds
+        %+  roll  mutations
+        |=  $:  [=wing =schematic]
+                $=  accumulator
+                $:  results=(list [wing ^build (unit build-result)])
+                    accessed-builds=_accessed-builds
+            ==  ==
+        ^+  accumulator
+        ::
+        =.  accessed-builds  accessed-builds.accumulator
+        ::
+        =/  sub-build=^build  [date.build schematic]
+        ::
+        =^  result  accessed-builds.accumulator  (depend-on sub-build)
+        =.  results.accumulator  [[wing sub-build result] results.accumulator]
+        ::
+        accumulator
+      ::  help out the type system
+      ::
+      =/  results=(list [wing ^build (unit build-result)])  results-raw
+      ::  check for errors
+      ::
+      =/  error=tang
+        %-  zing  ^-  (list tang)
+        %+  murn  results
+        |=  [* * result=(unit build-result)]
+        ^-  (unit tang)
+        ?.  ?=([~ %error *] result)
+          ~
+        `message.u.result
+      ::  only produce the first error, as is tradition
+      ::
+      ?^  error
+        =.  error  [leaf+"ford: %mute failed: " error]
+        [build [%build-result %error error] accessed-builds]
+      ::  if any sub-builds blocked, produce all blocked sub-builds
+      ::
+      =/  blocks=(list ^build)
+        %+  murn  `(list [wing ^build (unit build-result)])`results
+        |=  [* sub=^build result=(unit build-result)]
+        ^-  (unit ^build)
+        ?^  result
+          ~
+        `sub
+      ::
+      ?^  blocks
+        [build [%blocks blocks ~] accessed-builds]
+      ::  all builds succeeded; retrieve vases from results
+      ::
+      =/  successes=(list [=wing =vase])
+        %+  turn  results
+        |=  [=wing * result=(unit build-result)]
+        ^-  [^wing vase]
+        ::
+        ?>  ?=([~ %success *] result)
+        ::
+        [wing q:(result-to-cage u.result)]
+      ::  create and run a +build to apply all mutations in order
+      ::
+      =/  ride-build=^build
+        :-  date.build
+        :+  %ride
+          ::  formula: a `%_` +hoon that applies a list of mutations
+          ::
+          ::    The hoon ends up looking like:
+          ::    ```
+          ::    %_  +2
+          ::      wing-1  +6
+          ::      wing-2  +14
+          ::      ...
+          ::    ==
+          ::    ```
+          ::
+          ^=  formula
+          ^-  hoon
+          :+  %cncb  [%& 2]~
+          =/  axis  3
+          ::
+          |-  ^-  (list [wing hoon])
+          ?~  successes  ~
+          ::
+          :-  [wing.i.successes [%$ (peg axis 2)]]
+          $(successes t.successes, axis (peg axis 3))
+        ::  subject: list of :subject-vase and mutations, as literal schematic
+        ::
+        ::    The subject ends up as a vase of something like this:
+        ::    ```
+        ::    :~  original-subject
+        ::        mutant-1
+        ::        mutant-2
+        ::        ...
+        ::    ==
+        ::    ```
+        ::
+        ^=  subject  ^-  schematic
+        :+  %$  %noun
+        ^-  vase
+        %+  slop  subject-vase
+        |-  ^-  vase
+        ?~  successes  [[%atom %n ~] ~]
+        ::
+        (slop vase.i.successes $(successes t.successes))
+      ::
+      =^  ride-result  accessed-builds  (depend-on ride-build)
+      ?~  ride-result
+        [build [%blocks [ride-build]~ ~] accessed-builds]
+      ::
+      ?.  ?=([~ %success %ride *] ride-result)
+        (wrap-error ride-result)
+      ::
+      =/  =build-result
+        [%success %mute p.subject-cage vase.u.ride-result]
+      ::
+      [build [%build-result build-result] accessed-builds]
+    ::
     ++  make-path
       |=  [disc=^disc prefix=@tas raw-path=@tas]
       ^-  build-receipt