Generalized formatting of generated values

.devcontainer/devcontainer.json

@@ -7,7 +7,8 @@
 
   "extensions": [
     "editorconfig.editorconfig",
-    "[email protected]"
+    "[email protected]",
+    "[email protected]"
   ],
 
   "settings": {

src/Hedgehog/Gen.fs

@@ -4,16 +4,41 @@ open System
 
 /// A generator for values and shrink trees of type 'a.
 [<Struct>]
-type Gen<'a> =
-    | Gen of Random<Tree<'a>>
+type Gen<'a> = private {
+    Config : GenConfig<'a>
+    Random : Random<Tree<'a>>
+}
 
 module Gen =
+    module Config =
+        let get (gen : Gen<'a>) : GenConfig<'a> =
+            gen.Config
 
-    let ofRandom (r : Random<Tree<'a>>) : Gen<'a> =
-        Gen r
+        let map (f : GenConfig<'a> -> GenConfig<'a>) (gen : Gen<'a>) : Gen<'a> =
+            { gen with Config = f (get gen) }
 
-    let toRandom (Gen r : Gen<'a>) : Random<Tree<'a>> =
-        r
+        let set (config : GenConfig<'a>) (gen : Gen<'a>) : Gen<'a> =
+            map (always config) gen
+
+    let format (a : 'a) (gen : Gen<'a>) : string =
+        let formatter = gen |> Config.get |> GenConfig.getFormatter
+        formatter a
+
+    let withFormatter (formatter : 'a -> string) (gen : Gen<'a>) : Gen<'a> =
+        gen
+        |> Config.map (GenConfig.setFormatter formatter)
+
+    let withListFormatter (gen : Gen<_>) : Gen<_> =
+        gen
+        |> withFormatter (Seq.toList >> sprintf "%A")
+
+    let ofRandom (random : Random<Tree<'a>>) : Gen<'a> = {
+        Config = GenConfig.defaultConfig
+        Random = random
+    }
+
+    let toRandom (gen : Gen<'a>) : Random<Tree<'a>> =
+        gen.Random
 
     let delay (f : unit -> Gen<'a>) : Gen<'a> =
         Random.delay (toRandom << f) |> ofRandom
@@ -343,6 +368,12 @@ module Gen =
         Random.sized sizedList
         |> ofRandom
 
+    /// Generates a `System.Collections.Generic.List<T>` using a 'Range' to determine the length.
+    let resizeArray (range : Range<int>) (g : Gen<'a>) : Gen<ResizeArray<'a>> =
+        list range g
+        |> map ResizeArray
+        |> withListFormatter
+
     /// Generates an array using a 'Range' to determine the length.
     let array (range : Range<int>) (g : Gen<'a>) : Gen<array<'a>> =
         list range g |> map Array.ofList

src/Hedgehog/GenConfig.fs

@@ -0,0 +1,17 @@
+namespace Hedgehog
+
+type GenConfig<'a> = private {
+    Formatter : 'a -> string
+}
+
+module GenConfig =
+
+    let defaultConfig<'a> =
+        let formatter: 'a -> string = sprintf "%A"
+        { Formatter = formatter }
+
+    let getFormatter (config : GenConfig<'a>) : ('a -> string) =
+        config.Formatter
+
+    let setFormatter (formatter : 'a -> string) (config : GenConfig<'a>) : GenConfig<'a> =
+        { config with Formatter = formatter }

src/Hedgehog/Hedgehog.fsproj

@@ -37,6 +37,7 @@ https://github.com/hedgehogqa/fsharp-hedgehog/blob/master/doc/index.md
     <Compile Include="Range.fs" />
     <Compile Include="Random.fs" />
     <Compile Include="Shrink.fs" />
+    <Compile Include="GenConfig.fs" />
     <Compile Include="Gen.fs" />
     <Compile Include="ListGen.fs" />
     <Compile Include="Journal.fs" />

src/Hedgehog/Linq/Gen.fs

@@ -162,8 +162,7 @@ type GenExtensions private () =
 
     [<Extension>]
     static member List (gen : Gen<'T>, range : Range<int>) : Gen<ResizeArray<'T>> =
-        Gen.list range gen
-        |> Gen.map ResizeArray
+        Gen.resizeArray range gen
 
     [<Extension>]
     static member NoShrink (gen : Gen<'T>) : Gen<'T> =
@@ -292,6 +291,14 @@ type GenExtensions private () =
     static member Where (gen : Gen<'T>, predicate : Func<'T, bool>) : Gen<'T> =
         Gen.filter predicate.Invoke gen
 
+    [<Extension>]
+    static member WithFormatter (gen : Gen<'T>, formatter : Func<'T, string>) =
+        Gen.withFormatter formatter.Invoke gen
+
+    [<Extension>]
+    static member WithListFormatter (gen : Gen<ResizeArray<'T>>) =
+        Gen.withListFormatter gen
+
     [<Extension>]
     static member Zip (genA : Gen<'T>, genB : Gen<'U>) : Gen<'T * 'U> =
         Gen.zip genA genB

src/Hedgehog/Property.fs

@@ -98,26 +98,9 @@ module Property =
         |> bindGen kTry
         |> ofGen
 
-    let private printValue (value) : string =
-        // sprintf "%A" is not prepared for printing ResizeArray<_> (C# List<T>) so we prepare the value instead
-        let prepareForPrinting (value: obj) : obj =
-        #if FABLE_COMPILER
-            value
-        #else
-            let t = value.GetType()
-            // have to use TypeInfo due to targeting netstandard 1.6
-            let t = System.Reflection.IntrospectionExtensions.GetTypeInfo(t)
-            let isList = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<ResizeArray<_>>
-            if isList
-            then value :?> System.Collections.IEnumerable |> Seq.cast<obj> |> List.ofSeq :> obj
-            else value
-        #endif
-
-        value |> prepareForPrinting |> sprintf "%A"
-
     let forAll (k : 'a -> Property<'b>) (gen : Gen<'a>) : Property<'b> =
         let prepend (x : 'a) =
-            counterexample (fun () -> printValue x)
+            counterexample (fun () -> gen |> Gen.format x)
             |> set x
             |> bind k
             |> toGen

tests/Hedgehog.Tests/PropertyTests.fs

@@ -8,7 +8,18 @@ let propertyTests = testList "Property tests" [
     fableIgnore "generated C# list of five elements is not abbreviated in the failure report" <| fun _ ->
         let report =
             property {
-                let! xs = Range.singleton 0 |> Gen.int32 |> Gen.list (Range.singleton 5) |> Gen.map ResizeArray
+                let gen = Gen.int32 (Range.singleton 0)
+                let! xs = Gen.resizeArray (Range.singleton 5) gen
+                return false
+            }
+            |> Property.renderWith (PropertyConfig.withShrinks 0<shrinks> PropertyConfig.defaultConfig)
+        Expect.isNotMatch report "\.\.\." "Abbreviation (...) found"
+
+    fableIgnore "generated seq of five elements converted to C# list is not abbreviated in the failure report" <| fun _ ->
+        let report =
+            property {
+                let gen = Gen.int32 (Range.singleton 0)
+                let! xs = Gen.seq (Range.singleton 5) gen |> Gen.map ResizeArray |> Gen.withListFormatter
                 return false
             }
             |> Property.renderWith (PropertyConfig.withShrinks 0<shrinks> PropertyConfig.defaultConfig)