optimize rechecking

src/Hedgehog/Linq/Property.fs

@@ -134,6 +134,11 @@ type PropertyExtensions private () =
     static member ReportRecheck (property : Property<bool>, size : Size, seed : Seed, config : Hedgehog.PropertyConfig) : Report =
         Property.reportRecheckBoolWith size seed config property
 
+    [<Extension>]
+    static member ReportRecheck (property : Property, size : Size, seed : Seed, shrinkPath : ShrinkOutcome list, config : Hedgehog.PropertyConfig) : Report =
+        let (Property property) = property
+        Property.reportOptimizedRecheckWith size seed shrinkPath config property
+
     [<Extension>]
     static member Render (property : Property) : string =
         let (Property property) = property

src/Hedgehog/Property.fs

@@ -130,24 +130,42 @@ module Property =
             (shrinkLimit : int<shrinks> Option) =
         let rec loop
                 (nshrinks : int<shrinks>)
+                (shrinkPath : ShrinkOutcome list)
                 (Node (root, xs) : Tree<Lazy<Journal * Outcome<'a>>>) =
             let journal = root.Value |> fst
             let failed =
                 Failed {
                     Size = args.Size
                     Seed = args.Seed
                     Shrinks = nshrinks
+                    ShrinkPath = shrinkPath
                     Journal = journal
                     RecheckType = args.RecheckType
                 }
-            match shrinkLimit, Seq.tryFind (Tree.outcome >> Lazy.value >> snd >> Outcome.isFailure) xs with
+            match shrinkLimit, xs |> Seq.indexed |> Seq.tryFind (snd >> Tree.outcome >> Lazy.value >> snd >> Outcome.isFailure) with
             | Some shrinkLimit', _ when nshrinks >= shrinkLimit' -> failed
             | _, None -> failed
-            | _, Some tree -> loop (nshrinks + 1<shrinks>) tree
-        loop 0<shrinks>
+            | _, Some (idx, tree) ->
+                let nextShrinkPath = shrinkPath @ List.replicate idx ShrinkOutcome.Pass @ [ShrinkOutcome.Fail]
+                loop (nshrinks + 1<shrinks>) nextShrinkPath tree
+        loop 0<shrinks> []
+
+    let private followShrinkPath
+            (args : PropertyArgs)
+            (shrinkLimit : int<shrinks> Option) =
+        let rec skipFailure
+                (Node (root, children) : Tree<Lazy<Journal * Outcome<'a>>>) =
+            let rec trySkipNext children shrinkPath =
+                match children, shrinkPath with
+                | _, [] -> shrinkInput args shrinkLimit (Node (root, []))
+                | [], _ -> failwith "The shrink path lead to a dead end. This should never happen. Please report this bug."
+                | _ :: childrenTail, ShrinkOutcome.Pass :: shrinkPathTail -> trySkipNext childrenTail shrinkPathTail
+                | childrenHead :: _, ShrinkOutcome.Fail :: shrinkPathTail -> skipFailure childrenHead shrinkPathTail
+            trySkipNext (Seq.toList children)
+        skipFailure
 
     let private reportWith' (args : PropertyArgs) (config : PropertyConfig) (p : Property<unit>) : Report =
-        let random = toGen p |> Gen.toRandom
+        let random = p |> toGen |> Gen.toRandom
 
         let nextSize size =
             if size >= 100 then
@@ -212,6 +230,31 @@ module Property =
     let checkBoolWith (config : PropertyConfig) (g : Property<bool>) : unit =
         g |> bind ofBool |> checkWith config
 
+    let reportOptimizedRecheckWith (size : Size) (seed : Seed) (shrinkPath : ShrinkOutcome list) (config : PropertyConfig) (p : Property<unit>) : Report =
+        let args = {
+            PropertyArgs.init with
+                RecheckType = RecheckType.None
+                Seed = seed
+                Size = size
+        }
+        //reportWith' args config p
+        let random = p |> toGen |> Gen.toRandom
+        let nextSize size =
+            if size >= 100 then
+                1
+            else
+                size + 1
+        let seed1, seed2 = Seed.split args.Seed
+        let result = Random.run seed1 args.Size random
+        let nextArgs = {
+            args with
+                Seed = seed2
+                Size = nextSize args.Size
+        }
+        { Tests = 1<tests>
+          Discards = 0<discards>
+          Status = followShrinkPath nextArgs config.ShrinkLimit result shrinkPath }
+
     let reportRecheckWith (size : Size) (seed : Seed) (config : PropertyConfig) (p : Property<unit>) : Report =
         let args = {
             PropertyArgs.init with

src/Hedgehog/Report.fs

@@ -4,6 +4,11 @@ namespace Hedgehog
 [<Measure>] type discards
 [<Measure>] type shrinks
 
+[<RequireQualifiedAccess>]
+type ShrinkOutcome =
+    | Pass
+    | Fail
+
 [<RequireQualifiedAccess>]
 type RecheckType =
     | None
@@ -14,6 +19,7 @@ type FailureData = {
     Size : Size
     Seed : Seed
     Shrinks : int<shrinks>
+    ShrinkPath : ShrinkOutcome list
     Journal : Journal
     RecheckType : RecheckType
 }
@@ -86,23 +92,31 @@ module Report =
 
         Seq.iter (appendLine sb) (Journal.eval failure.Journal)
 
+        let serilizeShrinkPath path =
+            let serilzeShrinkStep = function
+                | ShrinkOutcome.Pass -> '1'
+                | ShrinkOutcome.Fail -> '0'
+            path |> Seq.map serilzeShrinkStep |> Seq.toArray |> String
+
         match failure.RecheckType with
         | RecheckType.None ->
             ()
 
         | RecheckType.FSharp ->
             appendLinef sb "This failure can be reproduced by running:"
-            appendLinef sb "> Property.recheck %d ({ Value = %A; Gamma = %A }) <property>"
+            appendLinef sb "> Property.recheck %d ({ Value = %A; Gamma = %A }) \"%s\" <property>"
                 failure.Size
                 failure.Seed.Value
                 failure.Seed.Gamma
+                (failure.ShrinkPath |> serilizeShrinkPath)
 
         | RecheckType.CSharp ->
             appendLinef sb "This failure can be reproduced by running:"
-            appendLinef sb "> property.Recheck(%d, new Seed { Value = %A; Gamma = %A })"
+            appendLinef sb "> Property.recheck %d ({ Value = %A; Gamma = %A }) \"%s\" <property>"
                 failure.Size
                 failure.Seed.Value
                 failure.Seed.Gamma
+                (failure.ShrinkPath |> serilizeShrinkPath)
 
         sb.ToString().Trim() // Exclude extra newline.
 

tests/Hedgehog.Linq.Tests/LinqTests.cs

@@ -55,6 +55,7 @@ from i in ForAll(gen)
                     prop.ReportRecheck(
                         failure1.Item.Size,
                         failure1.Item.Seed,
+                        failure1.Item.ShrinkPath,
                         PropertyConfig.Default);
                 if (report2.Status is Status.Failed)
                 {

tests/Hedgehog.Tests/PropertyTests.fs

@@ -83,7 +83,13 @@ let propertyTests = testList "Property tests" [
         | GaveUp -> failwith "Initial report should be Failed, not GaveUp"
         | Failed failure1 ->
             count <- 0
-            let report2 = Property.reportRecheck failure1.Size failure1.Seed prop
+            let report2 =
+                Property.reportOptimizedRecheckWith
+                    failure1.Size
+                    failure1.Seed
+                    failure1.ShrinkPath
+                    PropertyConfig.defaultConfig
+                    prop
             match report2.Status with
             | OK -> failwith "Recheck report should be Failed, not OK"
             | GaveUp -> failwith "Recheck report should be Failed, not GaveUp"