Skip to content
This repository was archived by the owner on Nov 27, 2025. It is now read-only.

Commit 74335cc

Browse files
authored
Merge pull request #78 from AlexeyRaga/generic-generators
Generic generators
2 parents 10caf12 + 6f205dc commit 74335cc

File tree

10 files changed

+476
-9
lines changed

10 files changed

+476
-9
lines changed

global.json

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
{
2+
"sdk": {
3+
"version": "8.0.0",
4+
"rollForward": "latestFeature",
5+
"allowPrerelease": true
6+
}
7+
}
Lines changed: 139 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,139 @@
1+
using System.Linq;
2+
using System;
3+
using Xunit;
4+
using static Hedgehog.Linq.Property;
5+
6+
namespace Hedgehog.Linq.Tests;
7+
8+
public sealed record Uuid(Guid Value);
9+
10+
public sealed record Name(string Value);
11+
12+
public sealed record Id<T>(Guid Value);
13+
14+
public abstract record Either<TLeft, TRight>
15+
{
16+
public sealed record Left(TLeft Value) : Either<TLeft, TRight>;
17+
18+
public sealed record Right(TRight Value) : Either<TLeft, TRight>;
19+
}
20+
21+
public abstract record Maybe<T>
22+
{
23+
public sealed record Just(T Value) : Maybe<T>;
24+
25+
public sealed record Nothing : Maybe<T>;
26+
}
27+
28+
public sealed record OuterRecord(Maybe<Guid> Value);
29+
30+
public sealed class OuterClass
31+
{
32+
public OuterClass(Maybe<Guid> value) => Value = value;
33+
public Maybe<Guid> Value { get; set; }
34+
}
35+
36+
public sealed class GenericTestGenerators
37+
{
38+
public static Gen<Guid> Guid() =>
39+
Gen.Byte(Range.ConstantBoundedByte())
40+
.Array(Range.FromValue(12))
41+
.Select(bytes => new byte[4].Concat(bytes).ToArray())
42+
.Select(bytes => new Guid(bytes));
43+
44+
public static Gen<Id<T>> IdGen<T>(Gen<Guid> gen) =>
45+
gen.Select(value => new Id<T>(value));
46+
47+
public static Gen<Uuid> UuidGen() =>
48+
Guid().Select(value => new Uuid(value));
49+
50+
public static Gen<Name> NameGen(Gen<string> gen) =>
51+
gen.Select(value => new Name("Name: " + value));
52+
53+
public static Gen<Maybe<T>> AlwaysJust<T>(Gen<T> gen) =>
54+
gen.Select(Maybe<T> (value) => new Maybe<T>.Just(value));
55+
56+
public static Gen<Either<TLeft, TRight>> AlwaysLeft<TLeft, TRight>(Gen<TRight> genB, Gen<TLeft> genA) =>
57+
genA.Select(Either<TLeft, TRight> (value) => new Either<TLeft, TRight>.Left(value));
58+
}
59+
60+
public class GenericGenTests
61+
{
62+
private static bool IsCustomGuid(Guid guid) =>
63+
new Span<byte>(guid.ToByteArray(), 0, 4).ToArray().All(b => b == 0);
64+
65+
[Fact]
66+
public void ShouldGenerateValueWithPhantomGenericType_Id()
67+
{
68+
var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
69+
var prop = from x in ForAll(GenX.autoWith<Id<string>>(config))
70+
select IsCustomGuid(x.Value);
71+
72+
prop.Check();
73+
}
74+
75+
[Fact]
76+
public void ShouldGenerateGenericValueForUnionType_Either()
77+
{
78+
var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
79+
var prop = from x in ForAll(GenX.autoWith<Either<int, string>>(config))
80+
select x is Either<int, string>.Left;
81+
prop.Check();
82+
}
83+
84+
[Fact]
85+
public void ShouldGenerateGenericValueForUnionType_Maybe()
86+
{
87+
var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
88+
var prop = from x in ForAll(GenX.autoWith<Maybe<string>>(config))
89+
select x is Maybe<string>.Just;
90+
prop.Check();
91+
}
92+
93+
[Fact]
94+
public void ShouldGenerateValueUsingGeneratorWithoutParameters_Uuid()
95+
{
96+
var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
97+
var prop = from x in ForAll(GenX.autoWith<Uuid>(config))
98+
select IsCustomGuid(x.Value);
99+
prop.Check();
100+
}
101+
102+
[Fact]
103+
public void ShouldGenerateValueUsingGeneratorWithParameters_Name()
104+
{
105+
var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
106+
var prop = from x in ForAll(GenX.autoWith<Name>(config))
107+
select x.Value.StartsWith("Name: ");
108+
prop.Check();
109+
}
110+
111+
[Fact]
112+
public void ShouldGenerateOuterFSharpRecordWithGenericTypeInside()
113+
{
114+
var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
115+
var prop = from x in ForAll(GenX.autoWith<OuterRecord>(config))
116+
select x.Value switch
117+
{
118+
Maybe<Guid>.Just(var v) => IsCustomGuid(v),
119+
Maybe<Guid>.Nothing => false,
120+
_ => throw new InvalidOperationException("C# cannot do exhaustive matching")
121+
};
122+
123+
prop.Check();
124+
}
125+
126+
[Fact]
127+
public void ShouldGenerateOuterClassWithGenericTypeInside()
128+
{
129+
var config = GenX.defaults.WithGenerators<GenericTestGenerators>();
130+
var prop = from x in ForAll(GenX.autoWith<OuterClass>(config))
131+
select x.Value switch
132+
{
133+
Maybe<Guid>.Just(var v) => IsCustomGuid(v),
134+
Maybe<Guid>.Nothing => false,
135+
_ => throw new InvalidOperationException("C# cannot do exhaustive matching")
136+
};
137+
prop.Check();
138+
}
139+
}
Lines changed: 104 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,104 @@
1+
module Hedgehog.Experimental.Tests.GenericGenTests
2+
3+
open System
4+
open Xunit
5+
open Swensen.Unquote
6+
open Hedgehog
7+
8+
type Uuid = Uuid of Guid
9+
type Name = Name of string
10+
type Id<'a> = Id of Guid
11+
type Either<'a, 'b> = Left of 'a | Right of 'b
12+
type Maybe<'a> = Just of 'a | Nothing
13+
14+
type OuterRecord = { Value: Maybe<Guid> }
15+
16+
type OuterClass(value: Maybe<Guid>) =
17+
member val Value = value with get, set
18+
19+
20+
type GenericTestGenerators =
21+
22+
// Test that we can override the "default" generator for a type
23+
static member Guid() =
24+
Gen.byte (Range.constantBounded())
25+
|> Gen.array (Range.singleton 12)
26+
|> Gen.map (Array.append (Array.zeroCreate 4))
27+
|> Gen.map Guid
28+
29+
// A generator for Id<'a> to test phantom generic type
30+
static member Id<'a>(gen : Gen<Guid>) : Gen<Id<'a>> = gen |> Gen.map Id
31+
32+
// A generator for some simple value to test a generator without parameters
33+
static member UuidGen() : Gen<Uuid> = GenericTestGenerators.Guid() |> Gen.map Uuid
34+
35+
// A generator for some simple value to test a generator with parameters
36+
static member NameGen(gen: Gen<string>) : Gen<Name> =
37+
gen |> Gen.map (fun x -> Name ("Name: " + x))
38+
39+
// A generator for Maybe<'a> to test union type with one generic type constructor
40+
static member AlwaysJust<'a>(genA: Gen<'a>) : Gen<Maybe<'a>> = genA |> Gen.map Just
41+
42+
// A generator for Either<'a, 'b> to test union type with multiple type constructors
43+
static member AlwaysLeft<'a, 'b>(genB: Gen<'b>, genA: Gen<'a>) : Gen<Either<'a, 'b>> =
44+
genA |> Gen.map Left
45+
46+
let checkWith tests = PropertyConfig.defaultConfig |> PropertyConfig.withTests tests |> Property.checkWith
47+
48+
let isCustomGuid (guid: Guid) = guid.ToByteArray()[..3] |> Array.forall ((=) 0uy)
49+
50+
[<Fact>]
51+
let ``should generate value with phantom generic type - Id<'a>``() =
52+
let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
53+
checkWith 100<tests> <| property {
54+
let! x = GenX.autoWith<Id<string>> config
55+
test <@ x |> function Id a -> isCustomGuid a @>
56+
}
57+
58+
[<Fact>]
59+
let ``should generate generic value for union type - Either<'a, 'b>``() =
60+
let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
61+
checkWith 100<tests> <| property {
62+
let! x = GenX.autoWith<Either<int, string>> config
63+
test <@ x |> function Left _ -> true | _ -> false @>
64+
}
65+
66+
[<Fact>]
67+
let ``should generate generic value for union type - Maybe<'a>``() =
68+
let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
69+
checkWith 100<tests> <| property {
70+
let! x = GenX.autoWith<Maybe<string>> config
71+
test <@ x |> function Just _ -> true | _ -> false @>
72+
}
73+
74+
[<Fact>]
75+
let ``should generate value using a generator without parameters: Uuid``() =
76+
let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
77+
checkWith 100<tests> <| property {
78+
let! x = GenX.autoWith<Maybe<Uuid>> config
79+
test <@ x |> function Just (Uuid x) -> isCustomGuid x | _ -> failwith "todo"@>
80+
}
81+
82+
[<Fact>]
83+
let ``should generate value using a generator with parameters: Name``() =
84+
let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
85+
checkWith 100<tests> <| property {
86+
let! x = GenX.autoWith<Name> config
87+
test <@ x |> function Name x -> x.StartsWith("Name: ") @>
88+
}
89+
90+
[<Fact>]
91+
let ``should generate outer FSharp record with generic type inside``() =
92+
let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
93+
checkWith 100<tests> <| property {
94+
let! x = GenX.autoWith<OuterRecord> config
95+
test <@ x |> function { Value = Just x } -> isCustomGuid x | _ -> false @>
96+
}
97+
98+
[<Fact>]
99+
let ``should generate outer class with generic type inside``() =
100+
let config = GenX.defaults |> AutoGenConfig.addGenerators<GenericTestGenerators>
101+
checkWith 100<tests> <| property {
102+
let! x = GenX.autoWith<OuterClass> config
103+
test <@ x |> function cls -> match cls.Value with Just v -> isCustomGuid v | _ -> false @>
104+
}

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,9 @@
77
</PropertyGroup>
88

99
<ItemGroup>
10+
<Compile Include="TypeUtilsTests.fs" />
1011
<Compile Include="GenTests.fs" />
12+
<Compile Include="GenericGenTests.fs" />
1113
</ItemGroup>
1214

1315
<ItemGroup>
@@ -16,8 +18,10 @@
1618

1719
<ItemGroup>
1820
<PackageReference Include="Microsoft.NET.Test.Sdk" Version="16.8.3" />
21+
<PackageReference Include="TypeShape" Version="10.0.0" />
1922
<PackageReference Include="Unquote" Version="5.0.0" />
2023
<PackageReference Include="xunit.core" Version="2.4.1" />
24+
<PackageReference Include="xunit.assert" Version="2.4.1" />
2125
<PackageReference Include="xunit.runner.visualstudio" Version="2.4.3">
2226
<PrivateAssets>all</PrivateAssets>
2327
<IncludeAssets>runtime; build; native; contentfiles; analyzers; buildtransitive</IncludeAssets>
Lines changed: 75 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,75 @@
1+
module Hedgehog.Experimental.Tests.TypeUtilsTests
2+
3+
open System
4+
open System.Reflection
5+
open Xunit
6+
open Hedgehog
7+
8+
type Id<'a> = Id of Guid
9+
type Either<'a, 'b> = Left of 'a | Right of 'b
10+
type Rel<'a, 'b> = Rel of 'a * 'b
11+
12+
type GenericTestContainer =
13+
static member Id<'a>() : Id<'a> = Id (Guid.NewGuid())
14+
15+
static member Left<'a, 'b>(a: 'a) : Either<'a, 'b> = Left a
16+
17+
static member Right<'b>(b: 'b) : Either<string, 'b> = Right b
18+
19+
static member RelStr<'b>(a: string, b: 'b) : Rel<string, 'b> = Rel (a, b)
20+
21+
let genericTypes =
22+
typeof<GenericTestContainer>.GetMethods(BindingFlags.Static ||| BindingFlags.Public)
23+
|> Seq.filter _.ReturnType.IsGenericType
24+
|> Seq.map _.ReturnType
25+
|> Seq.sortBy (fun t ->
26+
if t.IsGenericType then
27+
t.GetGenericArguments()
28+
|> Seq.filter _.IsGenericParameter
29+
|> Seq.length
30+
else
31+
Int32.MaxValue
32+
)
33+
|> Seq.toArray
34+
35+
let fullTypeName (typ: Type) =
36+
if typ.IsGenericType then
37+
let genericDef = typ.GetGenericTypeDefinition()
38+
let genericArgs = typ.GetGenericArguments()
39+
let argsString =
40+
genericArgs
41+
|> Seq.map (fun t -> if t.IsGenericParameter then t.Name else t.FullName)
42+
|> String.concat ","
43+
sprintf "%s[%s]" genericDef.FullName argsString
44+
else typ.FullName
45+
46+
47+
[<Fact>]
48+
let ``Generic satisfies value type - Either<'a, 'b> to Either<int, string>`` () =
49+
let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Either<int, string>>)
50+
Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Either`2[a,b]", fullTypeName result)
51+
52+
[<Fact>]
53+
let ``Generic satisfies value type - Either<string, 'b> to Either<int, string>`` () =
54+
let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Either<string, string>>)
55+
Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Either`2[System.String,b]", fullTypeName result)
56+
57+
[<Fact>]
58+
let ``Generic satisfies value type - Id<'a> to Id<int>`` () =
59+
let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Id<int>>)
60+
Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Id`1[a]", fullTypeName result)
61+
62+
[<Fact>]
63+
let ``Generic satisfies value type - Id<'a> to Id<Guid>`` () =
64+
let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Id<Guid>>)
65+
Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Id`1[a]", fullTypeName result)
66+
67+
[<Fact>]
68+
let ``Generic satisfies value type - Rel<string, 'b> to Rel<string, Guid>`` () =
69+
let result = genericTypes |> Array.find (TypeUtils.satisfies typeof<Rel<string, Guid>>)
70+
Assert.Equal("Hedgehog.Experimental.Tests.TypeUtilsTests+Rel`2[System.String,b]", fullTypeName result)
71+
72+
[<Fact>]
73+
let ``Generic does not satisfy value type - Rel<string, 'b> to Rel<int, Guid>`` () =
74+
let result = genericTypes |> Array.tryFind (TypeUtils.satisfies typeof<Rel<int, Guid>>)
75+
Assert.Equal(None, result)

0 commit comments

Comments
 (0)