Merge pull request #81 from hedgehogqa/merge-autogen-config

Merge autogen config

Author: AlexeyRaga

README.md

@@ -43,7 +43,7 @@ let! shuffled = GenX.shuffle lst // e.g. [2; 1; 5; 3; 4]
 
 **Shuffle/permute the case of a string:**
 
-```f#	
+```f#
 let str = "abcde"
 let! shuffled = GenX.shuffleCase str // e.g. "aBCdE"
 ```
@@ -170,11 +170,11 @@ let! chars, f = charListGen |> GenX.withDistinctMapTo intGen
 type Union =
   | Husband of int
   | Wife of string
-  
+
 type Record =
   {Sport: string
    Time: TimeSpan}
-   
+
 // Explicit type parameter may not be necessary if it can be inferred.
 let! union = GenX.auto<Union>
 let! record = GenX.auto<Record>
@@ -194,9 +194,9 @@ let! recursive = GenX.auto<Recursive>
 
 ```f#
 let! myVal =
-  {GenX.defaults with 
-     SeqRange = Range.exponential 1 10
-     RecursionDepth = 2}
+  GenX.defaults
+  |> AutoGenConfig.setSeqRange (Range.exponential 1 10)
+  |> AutoGenConfig.setRecursionDepth 2
   // Will use this generator for all ints
   |> AutoGenConfig.addGenerator (Gen.int (Range.linear 0 10))
   // Will use this generator when generating its return type

src/Hedgehog.Experimental.Tests/AutoGenConfigTests.fs

@@ -0,0 +1,47 @@
+module Hedgehog.Experimental.Tests.AutoGenConfigTests
+
+open Xunit
+open Swensen.Unquote
+open Hedgehog
+
+[<Fact>]
+let ``merging AutoGenConfig preserves set values``() =
+  let expectedRange = Range.exponential 2 6
+  let expectedDepth = 2
+  let config1 =
+    AutoGenConfig.defaults
+    |> AutoGenConfig.setSeqRange expectedRange
+    |> AutoGenConfig.setRecursionDepth expectedDepth
+    |> AutoGenConfig.addGenerator (Gen.int32 (Range.exponentialBounded()))
+  let config2 = AutoGenConfig.defaults |> AutoGenConfig.addGenerator Gen.bool
+  let merged = AutoGenConfig.merge config1 config2
+  test <@ AutoGenConfig.recursionDepth merged = expectedDepth @>
+
+  let property = property {
+    let! array = merged |> GenX.autoWith<(int * bool)[]>
+    test <@ Array.length array >= 2 && Array.length array <= 6 @>
+  }
+
+  Property.check property
+
+[<Fact>]
+let ``merging AutoGenConfig overrides values``() =
+  let previousRange = Range.exponential 10 15
+  let expectedRange = Range.exponential 2 6
+  let expectedDepth = 2
+  let config1 = AutoGenConfig.defaults |> AutoGenConfig.setSeqRange previousRange |> AutoGenConfig.setRecursionDepth 1
+  let config2 =
+    AutoGenConfig.defaults
+    |> AutoGenConfig.setSeqRange expectedRange
+    |> AutoGenConfig.setRecursionDepth expectedDepth
+    |> AutoGenConfig.addGenerator (Gen.int32 (Range.exponentialBounded()))
+
+  let merged = AutoGenConfig.merge config1 config2
+  test <@ AutoGenConfig.recursionDepth merged = expectedDepth @>
+
+  let property = property {
+    let! array = merged |> GenX.autoWith<int[]>
+    test <@ Array.length array >= 2 && Array.length array <= 6 @>
+  }
+
+  Property.check property

src/Hedgehog.Experimental.Tests/GenTests.fs

@@ -323,15 +323,15 @@ let ``auto with recursive option members does not cause stack overflow using def
 let ``auto with recursive option members respects max recursion depth`` () =
     Property.check <| property {
         let! depth = Gen.int32 <| Range.exponential 0 5
-        let! x = GenX.autoWith<RecOption> {GenX.defaults with RecursionDepth = depth}
+        let! x = GenX.autoWith<RecOption> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth)
         x.Depth <=! depth
     }
 
 [<Fact>]
 let ``auto with recursive option members generates some values with max recursion depth`` () =
     checkWith 10<tests> <| property {
         let! depth = Gen.int32 <| Range.linear 1 5
-        let! xs = GenX.autoWith<RecOption> {GenX.defaults with RecursionDepth = depth}
+        let! xs = GenX.autoWith<RecOption> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth)
                   |> (Gen.list (Range.singleton 100))
         test <@ xs |> List.exists (fun x -> x.Depth = depth) @>
     }
@@ -355,15 +355,15 @@ let ``auto with recursive array members does not cause stack overflow using defa
 let ``auto with recursive array members respects max recursion depth`` () =
     Property.check <| property {
         let! depth = Gen.int32 <| Range.exponential 0 5
-        let! x = GenX.autoWith<RecArray> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 0 5}
+        let! x = GenX.autoWith<RecArray> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 0 5))
         x.Depth <=! depth
     }
 
 [<Fact>]
 let ``auto with recursive array members generates some values with max recursion depth`` () =
     checkWith 10<tests> <| property {
         let! depth = Gen.int32 <| Range.linear 1 5
-        let! xs = GenX.autoWith<RecArray> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 1 5}
+        let! xs = GenX.autoWith<RecArray> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 1 5))
                   |> (Gen.list (Range.singleton 100))
         test <@ xs |> List.exists (fun x -> x.Depth = depth) @>
     }
@@ -387,15 +387,15 @@ let ``auto with recursive list members does not cause stack overflow using defau
 let ``auto with recursive list members respects max recursion depth`` () =
     Property.check <| property {
         let! depth = Gen.int32 <| Range.exponential 0 5
-        let! x = GenX.autoWith<RecList> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 0 5}
+        let! x = GenX.autoWith<RecList> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 0 5))
         x.Depth <=! depth
     }
 
 [<Fact>]
 let ``auto with recursive list members generates some values with max recursion depth`` () =
     checkWith 10<tests> <| property {
         let! depth = Gen.int32 <| Range.linear 1 5
-        let! xs = GenX.autoWith<RecList> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 1 5}
+        let! xs = GenX.autoWith<RecList> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 1 5))
                   |> (Gen.list (Range.singleton 100))
         test <@ xs |> List.exists (fun x -> x.Depth = depth) @>
     }
@@ -419,15 +419,15 @@ let ``auto with recursive ResizeArray members does not cause stack overflow usin
 let ``auto with recursive ResizeArray members respects max recursion depth`` () =
     Property.check <| property {
         let! depth = Gen.int32 <| Range.exponential 0 5
-        let! x = GenX.autoWith<RecResizeArray> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 0 5}
+        let! x = GenX.autoWith<RecResizeArray> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 0 5))
         x.Depth <=! depth
     }
 
 [<Fact>]
 let ``auto with recursive ResizeArray members generates some values with max recursion depth`` () =
     checkWith 10<tests> <| property {
         let! depth = Gen.int32 <| Range.linear 1 5
-        let! xs = GenX.autoWith<RecResizeArray> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 1 5}
+        let! xs = GenX.autoWith<RecResizeArray> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 1 5))
                   |> (Gen.list (Range.singleton 100))
         test <@ xs |> List.exists (fun x -> x.Depth = depth) @>
     }
@@ -451,15 +451,15 @@ let ``auto with recursive Dictionary members does not cause stack overflow using
 let ``auto with recursive Dictionary members respects max recursion depth`` () =
     Property.check <| property {
         let! depth = Gen.int32 <| Range.exponential 0 5
-        let! x = GenX.autoWith<RecDictionary> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 0 5}
+        let! x = GenX.autoWith<RecDictionary> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 0 5))
         x.Depth <=! depth
     }
 
 [<Fact>]
 let ``auto with recursive Dictionary members generates some values with max recursion depth`` () =
     checkWith 10<tests> <| property {
         let! depth = Gen.int32 <| Range.linear 1 5
-        let! xs = GenX.autoWith<RecDictionary> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 1 5}
+        let! xs = GenX.autoWith<RecDictionary> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 1 5))
                   |> (Gen.list (Range.singleton 100))
         test <@ xs |> List.exists (fun x -> x.Depth = depth) @>
     }
@@ -483,15 +483,15 @@ let ``auto with recursive set members does not cause stack overflow using defaul
 let ``auto with recursive set members respects max recursion depth`` () =
     Property.check <| property {
         let! depth = Gen.int32 <| Range.exponential 0 5
-        let! x = GenX.autoWith<RecSet> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 0 5}
+        let! x = GenX.autoWith<RecSet> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 0 5))
         x.Depth <=! depth
     }
 
 [<Fact>]
 let ``auto with recursive set members generates some values with max recursion depth`` () =
     checkWith 10<tests> <| property {
         let! depth = Gen.int32 <| Range.linear 1 5
-        let! xs = GenX.autoWith<RecSet> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 1 5}
+        let! xs = GenX.autoWith<RecSet> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 1 5))
                   |> (Gen.list (Range.singleton 100))
         test <@ xs |> List.exists (fun x -> x.Depth = depth) @>
     }
@@ -515,15 +515,15 @@ let ``auto with recursive map members does not cause stack overflow using defaul
 let ``auto with recursive map members respects max recursion depth`` () =
     Property.check <| property {
         let! depth = Gen.int32 <| Range.exponential 0 5
-        let! x = GenX.autoWith<RecMap> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 0 5}
+        let! x = GenX.autoWith<RecMap> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 0 5))
         x.Depth <=! depth
     }
 
 [<Fact>]
 let ``auto with recursive map members generates some values with max recursion depth`` () =
     checkWith 10<tests> <| property {
         let! depth = Gen.int32 <| Range.linear 1 5
-        let! xs = GenX.autoWith<RecMap> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 1 5}
+        let! xs = GenX.autoWith<RecMap> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 1 5))
                   |> (Gen.list (Range.singleton 100))
         test <@ xs |> List.exists (fun x -> x.Depth = depth) @>
     }
@@ -563,8 +563,8 @@ let ``auto with mutually recursive types does not cause stack overflow using def
 let ``auto with mutually recursive types respects max recursion depth`` () =
     Property.check <| property {
         let! depth = Gen.int32 <| Range.exponential 0 5
-        let! x1 = GenX.autoWith<MutuallyRecursive1> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 0 5}
-        let! x2 = GenX.autoWith<MutuallyRecursive2> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 0 5}
+        let! x1 = GenX.autoWith<MutuallyRecursive1> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 0 5))
+        let! x2 = GenX.autoWith<MutuallyRecursive2> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 0 5))
         x1.Depth <=! depth
         x2.Depth <=! depth
     }
@@ -573,9 +573,9 @@ let ``auto with mutually recursive types respects max recursion depth`` () =
 let ``auto with mutually recursive types generates some values with max recursion depth`` () =
     checkWith 10<tests> <| property {
         let! depth = Gen.int32 <| Range.linear 1 5
-        let! xs1 = GenX.autoWith<MutuallyRecursive1> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 1 5}
+        let! xs1 = GenX.autoWith<MutuallyRecursive1> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 1 5))
                   |> (Gen.list (Range.singleton 100))
-        let! xs2 = GenX.autoWith<MutuallyRecursive2> {GenX.defaults with RecursionDepth = depth; SeqRange = Range.exponential 1 5}
+        let! xs2 = GenX.autoWith<MutuallyRecursive2> (GenX.defaults |> AutoGenConfig.setRecursionDepth depth |> AutoGenConfig.setSeqRange (Range.exponential 1 5))
                   |> (Gen.list (Range.singleton 100))
         test <@ xs1 |> List.exists (fun x -> x.Depth = depth) @>
         test <@ xs2 |> List.exists (fun x -> x.Depth = depth) @>
@@ -877,7 +877,8 @@ module ShrinkTests =
   let ``one-dimentional array shrinks correctly when empty disallowed`` () =
     let property = property {
       let! array =
-        { GenX.defaults with SeqRange = Range.constant 2 5 }
+        GenX.defaults
+        |> AutoGenConfig.setSeqRange (Range.constant 2 5)
         |> GenX.autoWith<int []>
       test <@ 1 <> array.[0] @>
     }
@@ -897,7 +898,8 @@ module ShrinkTests =
   let ``two-dimentional array shrinks correctly when empty disallowed`` () =
     let property = property {
       let! array =
-        { GenX.defaults with SeqRange = Range.constant 1 5 }
+        GenX.defaults
+        |> AutoGenConfig.setSeqRange (Range.constant 1 5)
         |> GenX.autoWith<int [,]>
       test <@ 1 <> array.[0,0] @>
     }
@@ -910,7 +912,8 @@ module ShrinkTests =
   let ``auto of ResizeArray shrinks correctly`` () =
     let property = property {
       let! resizeArray =
-        { GenX.defaults with SeqRange = Range.constant 4 4 }
+        GenX.defaults
+        |> AutoGenConfig.setSeqRange (Range.constant 4 4)
         |> GenX.autoWith<ResizeArray<int>>
       test <@ 1 <> resizeArray.[0] @>
     }
@@ -988,7 +991,8 @@ let ``auto can generate record with Nullable fields`` () =
 let ``auto can generate Nullable bool without recursion`` () =
   Property.check <| property {
     let! _ =
-      { GenX.defaults with RecursionDepth = 0 }
+      GenX.defaults
+      |> AutoGenConfig.setRecursionDepth 0
       |> GenX.autoWith<Nullable<bool>>
     ()
   }
@@ -998,7 +1002,8 @@ let ``auto can generate seq`` () =
   Property.checkBool <| property {
     let! expectedLen = Gen.int32 (Range.linear 0 105)
     let! xs =
-      { GenX.defaults with SeqRange = Range.singleton expectedLen }
+      GenX.defaults
+      |> AutoGenConfig.setSeqRange (Range.singleton expectedLen)
       |> GenX.autoWith<seq<int>>
 
     return Seq.length xs = expectedLen
@@ -1030,15 +1035,15 @@ type Poodle() =
 
 [<Fact>]
 let ``Type Dog is Shape_CliMutable`` () =
-  let isDogCliMutable = 
+  let isDogCliMutable =
     match TypeShape.Create<Dog> () with
     | Shape.CliMutable _ -> true
     | _ -> false
   test <@ isDogCliMutable @>
 
 [<Fact>]
 let ``Type Poodle is Shape_CliMutable`` () =
-  let isPoodleCliMutable = 
+  let isPoodleCliMutable =
     match TypeShape.Create<Poodle> () with
     | Shape.CliMutable _ -> true
     | _ -> false

src/Hedgehog.Experimental.Tests/Hedgehog.Experimental.Tests.fsproj

@@ -10,6 +10,7 @@
     <Compile Include="TypeUtilsTests.fs" />
     <Compile Include="GenTests.fs" />
     <Compile Include="GenericGenTests.fs" />
+    <Compile Include="AutoGenConfigTests.fs" />
   </ItemGroup>
 
   <ItemGroup>

src/Hedgehog.Experimental/AutoGenConfig.fs

@@ -0,0 +1,77 @@
+namespace Hedgehog
+
+open System
+open System.Reflection
+
+type AutoGenConfig = internal {
+  seqRange: Range<int> option
+  recursionDepth: int option
+  generators: GeneratorCollection
+}
+
+module AutoGenConfig =
+
+  let private defaultSeqRange = Range.exponential 0 50
+  let private defaultRecursionDepth = 1
+
+  let defaults = {
+    seqRange = None
+    recursionDepth = None
+    generators = GeneratorCollection.empty
+  }
+
+  let private mapGenerators f (config: AutoGenConfig) =
+    { config with generators = f config.generators }
+
+  let seqRange (config: AutoGenConfig) = config.seqRange |> Option.defaultValue defaultSeqRange
+  let setSeqRange (range: Range<int>) (config: AutoGenConfig) =
+    { config with seqRange = Some range }
+
+  let recursionDepth (config: AutoGenConfig) = config.recursionDepth |> Option.defaultValue defaultRecursionDepth
+  let setRecursionDepth (depth: int) (config: AutoGenConfig) =
+    { config with recursionDepth = Some depth }
+
+  /// Merge two configurations.
+  /// Values from the second configuration take precedence when they are set.
+  let merge (baseConfig: AutoGenConfig) (extraConfig: AutoGenConfig) =
+    {
+       seqRange = extraConfig.seqRange |> Option.orElse baseConfig.seqRange
+       recursionDepth = extraConfig.recursionDepth |> Option.orElse baseConfig.recursionDepth
+       generators = GeneratorCollection.merge baseConfig.generators extraConfig.generators
+    }
+
+  /// Add a generator to the configuration.
+  let addGenerator (gen: Gen<'a>) =
+    mapGenerators (GeneratorCollection.map _.SetItem(typeof<'a>, ([||], fun _ _ -> gen)))
+
+  /// Add generators from a given type.
+  /// The type is expected to have static methods that return Gen<_>.
+  /// These methods can have parameters which are required to be of type Gen<_>.
+  let addGenerators<'a> (config: AutoGenConfig) =
+      let isGen (t: Type) =
+          t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<Gen<_>>
+
+      let tryUnwrapGenParameters (methodInfo: MethodInfo) : Option<Type[]> =
+          methodInfo.GetParameters()
+          |> Array.fold (fun acc param ->
+              match acc, isGen param.ParameterType with
+              | Some types, true ->
+                  Some (Array.append types [| param.ParameterType.GetGenericArguments().[0] |])
+              | _ -> None
+          ) (Some [||])
+
+      typeof<'a>.GetMethods(BindingFlags.Static ||| BindingFlags.Public)
+      |> Seq.choose (fun methodInfo ->
+          match isGen methodInfo.ReturnType, tryUnwrapGenParameters methodInfo with
+          | true, Some typeArray ->
+              let targetType = methodInfo.ReturnType.GetGenericArguments().[0]
+              let factory: Type[] -> obj[] -> obj = fun types gens ->
+                  let methodToCall =
+                      if Array.isEmpty types then methodInfo
+                      else methodInfo.MakeGenericMethod(types)
+                  methodToCall.Invoke(null, gens)
+              Some (targetType, typeArray, factory)
+          | _ -> None)
+      |> Seq.fold (fun cfg (targetType, typeArray, factory) ->
+          cfg |> mapGenerators (GeneratorCollection.addGenerator targetType typeArray factory))
+          config