Generic generators

global.json

@@ -0,0 +1,7 @@
+{
+  "sdk": {
+    "version": "8.0.0",
+    "rollForward": "latestFeature",
+    "allowPrerelease": true
+  }
+}

src/Hedgehog.Experimental.CSharp.Tests/GenericGenTests.cs

@@ -0,0 +1,139 @@
+using System.Linq;
+using System;
+using Xunit;
+using static Hedgehog.Linq.Property;
+
+namespace Hedgehog.Linq.Tests;
+
+public sealed record Uuid(Guid Value);
+
+public sealed record Name(string Value);
+
+public sealed record Id<T>(Guid Value);
+
+public abstract record Either<TLeft, TRight>
+{
+  public sealed record Left(TLeft Value) : Either<TLeft, TRight>;
+
+  public sealed record Right(TRight Value) : Either<TLeft, TRight>;
+}
+
+public abstract record Maybe<T>
+{
+  public sealed record Just(T Value) : Maybe<T>;
+
+  public sealed record Nothing : Maybe<T>;
+}
+
+public sealed record OuterRecord(Maybe<Guid> Value);
+
+public sealed class OuterClass
+{
+  public OuterClass(Maybe<Guid> value) => Value = value;
+  public Maybe<Guid> Value { get; set; }
+}
+
+public sealed class GenericTestGenerators
+{
+  public static Gen<Guid> Guid() =>
+    Gen.Byte(Range.ConstantBoundedByte())
+      .Array(Range.FromValue(12))
+      .Select(bytes => new byte[4].Concat(bytes).ToArray())
+      .Select(bytes => new Guid(bytes));
+
+  public static Gen<Id<T>> IdGen<T>(Gen<Guid> gen) =>
+    gen.Select(value => new Id<T>(value));
+
+  public static Gen<Uuid> UuidGen() =>
+    Guid().Select(value => new Uuid(value));
+
+  public static Gen<Name> NameGen(Gen<string> gen) =>
+    gen.Select(value => new Name("Name: " + value));
+
+  public static Gen<Maybe<T>> AlwaysJust<T>(Gen<T> gen) =>
+    gen.Select(Maybe<T> (value) => new Maybe<T>.Just(value));
+
+  public static Gen<Either<TLeft, TRight>> AlwaysLeft<TLeft, TRight>(Gen<TRight> genB, Gen<TLeft> genA) =>
+    genA.Select(Either<TLeft, TRight> (value) => new Either<TLeft, TRight>.Left(value));
+}
+
+public class GenericGenTests
+{
+  private static bool IsCustomGuid(Guid guid) =>
+    new Span<byte>(guid.ToByteArray(), 0, 4).ToArray().All(b => b == 0);
+
+  [Fact]
+  public void ShouldGenerateValueWithPhantomGenericType_Id()
+  {
+    var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
+    var prop = from x in ForAll(GenX.autoWith<Id<string>>(config))
+               select IsCustomGuid(x.Value);
+
+    prop.Check();
+  }
+
+  [Fact]
+  public void ShouldGenerateGenericValueForUnionType_Either()
+  {
+    var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
+    var prop = from x in ForAll(GenX.autoWith<Either<int, string>>(config))
+               select x is Either<int, string>.Left;
+    prop.Check();
+  }
+
+  [Fact]
+  public void ShouldGenerateGenericValueForUnionType_Maybe()
+  {
+    var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
+    var prop = from x in ForAll(GenX.autoWith<Maybe<string>>(config))
+               select x is Maybe<string>.Just;
+    prop.Check();
+  }
+
+  [Fact]
+  public void ShouldGenerateValueUsingGeneratorWithoutParameters_Uuid()
+  {
+    var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
+    var prop = from x in ForAll(GenX.autoWith<Uuid>(config))
+               select IsCustomGuid(x.Value);
+    prop.Check();
+  }
+
+  [Fact]
+  public void ShouldGenerateValueUsingGeneratorWithParameters_Name()
+  {
+    var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
+    var prop = from x in ForAll(GenX.autoWith<Name>(config))
+               select x.Value.StartsWith("Name: ");
+    prop.Check();
+  }
+
+  [Fact]
+  public void ShouldGenerateOuterFSharpRecordWithGenericTypeInside()
+  {
+    var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
+    var prop = from x in ForAll(GenX.autoWith<OuterRecord>(config))
+      select x.Value switch
+      {
+        Maybe<Guid>.Just(var v) => IsCustomGuid(v),
+        Maybe<Guid>.Nothing => false,
+        _ => throw new InvalidOperationException("C# cannot do exhaustive matching")
+      };
+
+    prop.Check();
+  }
+
+  [Fact]
+  public void ShouldGenerateOuterClassWithGenericTypeInside()
+  {
+    var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
+    var prop = from x in ForAll(GenX.autoWith<OuterClass>(config))
+      select x.Value switch
+      {
+        Maybe<Guid>.Just(var v) => IsCustomGuid(v),
+        Maybe<Guid>.Nothing => false,
+        _ => throw new InvalidOperationException("C# cannot do exhaustive matching")
+      };
+    prop.Check();
+  }
+}

src/Hedgehog.Experimental.Tests/GenericGenTests.fs

@@ -0,0 +1,104 @@
+module Hedgehog.Experimental.Tests.GenericGenTests
+
+open System
+open Xunit
+open Swensen.Unquote
+open Hedgehog
+
+type Uuid = Uuid of Guid
+type Name = Name of string
+type Id<'a> = Id of Guid
+type Either<'a, 'b> = Left of 'a | Right of 'b
+type Maybe<'a> = Just of 'a | Nothing
+
+type OuterRecord = { Value: Maybe<Guid> }
+
+type OuterClass(value: Maybe<Guid>) =
+    member val Value = value with get, set
+
+
+type GenericTestGenerators =
+
+  // Test that we can override the "default" generator for a type
+  static member Guid() =
+    Gen.byte (Range.constantBounded())
+    |> Gen.array (Range.singleton 12)
+    |> Gen.map (Array.append (Array.zeroCreate 4))
+    |> Gen.map Guid
+
+  // A generator for Id<'a> to test phantom generic type
+  static member Id<'a>(gen : Gen<Guid>) : Gen<Id<'a>> = gen |> Gen.map Id
+
+  // A generator for some simple value to test a generator without parameters
+  static member UuidGen() : Gen<Uuid> = GenericTestGenerators.Guid() |> Gen.map Uuid
+
+  // A generator for some simple value to test a generator with parameters
+  static member NameGen(gen: Gen<string>) : Gen<Name> =
+    gen |> Gen.map (fun x -> Name ("Name: " + x))
+
+  // A generator for Maybe<'a> to test union type with one generic type constructor
+  static member AlwaysJust<'a>(genA: Gen<'a>) : Gen<Maybe<'a>> = genA |> Gen.map Just
+
+  // A generator for Either<'a, 'b> to test union type with multiple type constructors
+  static member AlwaysLeft<'a, 'b>(genB: Gen<'b>, genA: Gen<'a>) : Gen<Either<'a, 'b>> =
+        genA |> Gen.map Left
+
+let checkWith tests = PropertyConfig.defaultConfig |> PropertyConfig.withTests tests |> Property.checkWith
+
+let isCustomGuid (guid: Guid) = guid.ToByteArray()[..3] |> Array.forall ((=) 0uy)
+
+[<Fact>]
+let ``should generate value with phantom generic type - Id<'a>``() =
+   let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
+   checkWith 100<tests> <| property {
+        let! x = GenX.autoWith<Id<string>> config
+        test <@ x |> function Id a -> isCustomGuid a @>
+    }
+
+[<Fact>]
+let ``should generate generic value for union type - Either<'a, 'b>``() =
+   let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
+   checkWith 100<tests> <| property {
+        let! x = GenX.autoWith<Either<int, string>> config
+        test <@ x |> function Left _ -> true | _ -> false @>
+    }
+
+[<Fact>]
+let ``should generate generic value for union type - Maybe<'a>``() =
+   let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
+   checkWith 100<tests> <| property {
+        let! x = GenX.autoWith<Maybe<string>> config
+        test <@ x |> function Just _ -> true  | _ -> false @>
+    }
+
+[<Fact>]
+let ``should generate value using a generator without parameters: Uuid``() =
+   let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
+   checkWith 100<tests> <| property {
+        let! x = GenX.autoWith<Maybe<Uuid>> config
+        test <@ x |> function Just (Uuid x) -> isCustomGuid x  | _ -> failwith "todo"@>
+    }
+
+[<Fact>]
+let ``should generate value using a generator with parameters: Name``() =
+   let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
+   checkWith 100<tests> <| property {
+        let! x = GenX.autoWith<Name> config
+        test <@ x |> function Name x -> x.StartsWith("Name: ") @>
+    }
+
+[<Fact>]
+let ``should generate outer FSharp record with generic type inside``() =
+   let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
+   checkWith 100<tests> <| property {
+        let! x = GenX.autoWith<OuterRecord> config
+        test <@ x |> function { Value = Just x } -> isCustomGuid x | _ -> false @>
+    }
+
+[<Fact>]
+let ``should generate outer class with generic type inside``() =
+   let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
+   checkWith 100<tests> <| property {
+        let! x = GenX.autoWith<OuterClass> config
+        test <@ x |> function cls -> match cls.Value with Just v -> isCustomGuid v | _ -> false @>
+    }

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

@@ -7,7 +7,9 @@
   </PropertyGroup>
 
   <ItemGroup>
+    <Compile Include="TypeUtilsTests.fs" />
     <Compile Include="GenTests.fs" />
+    <Compile Include="GenericGenTests.fs" />
   </ItemGroup>
 
   <ItemGroup>
@@ -16,8 +18,10 @@
 
   <ItemGroup>
     <PackageReference Include="Microsoft.NET.Test.Sdk" Version="16.8.3" />
+    <PackageReference Include="TypeShape" Version="10.0.0" />
     <PackageReference Include="Unquote" Version="5.0.0" />
     <PackageReference Include="xunit.core" Version="2.4.1" />
+    <PackageReference Include="xunit.assert" Version="2.4.1" />
     <PackageReference Include="xunit.runner.visualstudio" Version="2.4.3">
       <PrivateAssets>all</PrivateAssets>
       <IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>

src/Hedgehog.Experimental.Tests/TypeUtilsTests.fs

@@ -0,0 +1,75 @@
+module Hedgehog.Experimental.Tests.TypeUtilsTests
+
+open System
+open System.Reflection
+open Xunit
+open Hedgehog
+
+type Id<'a> = Id of Guid
+type Either<'a, 'b> = Left of 'a | Right of 'b
+type Rel<'a, 'b> = Rel of 'a * 'b
+
+type GenericTestContainer =
+  static member Id<'a>() : Id<'a> = Id (Guid.NewGuid())
+
+  static member Left<'a, 'b>(a: 'a) : Either<'a, 'b> = Left a
+
+  static member Right<'b>(b: 'b) : Either<string, 'b> = Right b
+
+  static member RelStr<'b>(a: string, b: 'b) : Rel<string, 'b> = Rel (a, b)
+
+let genericTypes =
+    typeof<GenericTestContainer>.GetMethods(BindingFlags.Static ||| BindingFlags.Public)
+    |> Seq.filter _.ReturnType.IsGenericType
+    |> Seq.map _.ReturnType
+    |> Seq.sortBy (fun t ->
+        if t.IsGenericType then
+            t.GetGenericArguments()
+            |> Seq.filter _.IsGenericParameter
+            |> Seq.length
+        else
+            Int32.MaxValue
+    )
+    |> Seq.toArray
+
+let fullTypeName (typ: Type) =
+  if typ.IsGenericType then
+    let genericDef = typ.GetGenericTypeDefinition()
+    let genericArgs = typ.GetGenericArguments()
+    let argsString =
+      genericArgs
+      |> Seq.map (fun t -> if t.IsGenericParameter then t.Name else t.FullName)
+      |> String.concat ","
+    sprintf "%s[%s]" genericDef.FullName argsString
+  else typ.FullName
+
+
+[<Fact>]
+let ``Generic satisfies value type - Either<'a, 'b> to Either<int, string>`` () =
+    let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Either<int, string>>)
+    Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Either`2[a,b]", fullTypeName result)
+
+[<Fact>]
+let ``Generic satisfies value type - Either<string, 'b> to Either<int, string>`` () =
+    let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Either<string, string>>)
+    Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Either`2[System.String,b]", fullTypeName result)
+
+[<Fact>]
+let ``Generic satisfies value type - Id<'a> to Id<int>`` () =
+    let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Id<int>>)
+    Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Id`1[a]", fullTypeName result)
+
+[<Fact>]
+let ``Generic satisfies value type - Id<'a> to Id<Guid>`` () =
+    let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Id<Guid>>)
+    Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Id`1[a]", fullTypeName result)
+
+[<Fact>]
+let ``Generic satisfies value type - Rel<string, 'b> to Rel<string, Guid>`` () =
+    let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Rel<string, Guid>>)
+    Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Rel`2[System.String,b]", fullTypeName result)
+
+[<Fact>]
+let ``Generic does not satisfy value type - Rel<string, 'b> to Rel<int, Guid>`` () =
+    let result = genericTypes |> Array.tryFind (TypeUtils.satisfies typeof<Rel<int, Guid>>)
+    Assert.Equal(None, result)