From d5de8bcacd63e069c882c1c9dc6db5f7323722c8 Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Sat, 11 Sep 2021 22:31:17 +0000 Subject: [PATCH 1/5] Initial commit, need to keep config better still. --- .devcontainer/devcontainer.json | 3 ++- src/Hedgehog/Gen.fs | 30 ++++++++++++++++++++++++------ src/Hedgehog/Linq/Gen.fs | 1 + src/Hedgehog/Property.fs | 19 +------------------ 4 files changed, 28 insertions(+), 25 deletions(-) diff --git a/.devcontainer/devcontainer.json b/.devcontainer/devcontainer.json index 2b3f31cd..ad6bdc0c 100644 --- a/.devcontainer/devcontainer.json +++ b/.devcontainer/devcontainer.json @@ -7,7 +7,8 @@ "extensions": [ "editorconfig.editorconfig", - "ionide.ionide-fsharp@4.17.0" + "ionide.ionide-fsharp@4.17.0", + "ms-dotnettools.csharp@1.23.12" ], "settings": { diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index f4106050..05f2122f 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -2,18 +2,36 @@ namespace Hedgehog open System +type GenConfig<'a> = private { + Formatter : 'a -> string +} + /// A generator for values and shrink trees of type 'a. [] -type Gen<'a> = - | Gen of Random> +type Gen<'a> = private { + Random : Random> + Config : GenConfig<'a> +} module Gen = - let ofRandom (r : Random>) : Gen<'a> = - Gen r + let format (a : 'a) (gen : Gen<'a>) : string = + gen.Config.Formatter a + + let withFormatter (formatter : 'a -> string) (gen : Gen<'a>) : Gen<'a> = + { + gen with Config = { gen.Config with Formatter = formatter } + } + + let ofRandom (r : Random>) : Gen<'a> = { + Random = r + Config = { + Formatter = sprintf "%A" + } + } - let toRandom (Gen r : Gen<'a>) : Random> = - r + let toRandom (gen : Gen<'a>) : Random> = + gen.Random let delay (f : unit -> Gen<'a>) : Gen<'a> = Random.delay (toRandom << f) |> ofRandom diff --git a/src/Hedgehog/Linq/Gen.fs b/src/Hedgehog/Linq/Gen.fs index 02222f30..767daedb 100644 --- a/src/Hedgehog/Linq/Gen.fs +++ b/src/Hedgehog/Linq/Gen.fs @@ -164,6 +164,7 @@ type GenExtensions private () = static member List (gen : Gen<'T>, range : Range) : Gen> = Gen.list range gen |> Gen.map ResizeArray + |> Gen.withFormatter (seq >> sprintf "%A") [] static member NoShrink (gen : Gen<'T>) : Gen<'T> = diff --git a/src/Hedgehog/Property.fs b/src/Hedgehog/Property.fs index 7d493e37..9529ec5f 100644 --- a/src/Hedgehog/Property.fs +++ b/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) 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> - if isList - then value :?> System.Collections.IEnumerable |> Seq.cast |> 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 From 21661ffcdbe19ab47a72cbe37138da401107c852 Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Sat, 11 Sep 2021 22:43:34 +0000 Subject: [PATCH 2/5] Add `resizeArray` generator to fix test. --- src/Hedgehog/Gen.fs | 6 ++++++ src/Hedgehog/Linq/Gen.fs | 4 +--- tests/Hedgehog.Tests/PropertyTests.fs | 2 +- 3 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index 05f2122f..98556f44 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -361,6 +361,12 @@ module Gen = Random.sized sizedList |> ofRandom + /// Generates a `System.Collections.Generic.List` using a 'Range' to determine the length. + let resizeArray (range : Range) (g : Gen<'a>) : Gen> = + list range g + |> map ResizeArray + |> withFormatter (List.ofSeq >> sprintf "%A") + /// Generates an array using a 'Range' to determine the length. let array (range : Range) (g : Gen<'a>) : Gen> = list range g |> map Array.ofList diff --git a/src/Hedgehog/Linq/Gen.fs b/src/Hedgehog/Linq/Gen.fs index 767daedb..b1b5d3ff 100644 --- a/src/Hedgehog/Linq/Gen.fs +++ b/src/Hedgehog/Linq/Gen.fs @@ -162,9 +162,7 @@ type GenExtensions private () = [] static member List (gen : Gen<'T>, range : Range) : Gen> = - Gen.list range gen - |> Gen.map ResizeArray - |> Gen.withFormatter (seq >> sprintf "%A") + Gen.resizeArray range gen [] static member NoShrink (gen : Gen<'T>) : Gen<'T> = diff --git a/tests/Hedgehog.Tests/PropertyTests.fs b/tests/Hedgehog.Tests/PropertyTests.fs index 66041a5a..dd14f315 100644 --- a/tests/Hedgehog.Tests/PropertyTests.fs +++ b/tests/Hedgehog.Tests/PropertyTests.fs @@ -8,7 +8,7 @@ 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! xs = Range.singleton 0 |> Gen.int32 |> Gen.resizeArray (Range.singleton 5) return false } |> Property.renderWith (PropertyConfig.withShrinks 0 PropertyConfig.defaultConfig) From 1d467c5caa362f2d990e40f497625f5825edbbb8 Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Sun, 12 Sep 2021 01:20:08 +0000 Subject: [PATCH 3/5] Better separation --- src/Hedgehog/Gen.fs | 31 +++++++++++++++++-------------- src/Hedgehog/GenConfig.fs | 16 ++++++++++++++++ src/Hedgehog/Hedgehog.fsproj | 1 + 3 files changed, 34 insertions(+), 14 deletions(-) create mode 100644 src/Hedgehog/GenConfig.fs diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index 98556f44..8de7fac9 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -2,32 +2,35 @@ namespace Hedgehog open System -type GenConfig<'a> = private { - Formatter : 'a -> string -} - /// A generator for values and shrink trees of type 'a. [] type Gen<'a> = private { - Random : Random> Config : GenConfig<'a> + Random : Random> } module Gen = + module Config = + let get (gen : Gen<'a>) : GenConfig<'a> = + gen.Config + + let map (f : GenConfig<'a> -> GenConfig<'a>) (gen : Gen<'a>) : Gen<'a> = + { gen with Config = f (get gen) } + + let set (config : GenConfig<'a>) (gen : Gen<'a>) : Gen<'a> = + map (always config) gen let format (a : 'a) (gen : Gen<'a>) : string = - gen.Config.Formatter a + let formatter = gen |> Config.get |> GenConfig.getFormatter + formatter a let withFormatter (formatter : 'a -> string) (gen : Gen<'a>) : Gen<'a> = - { - gen with Config = { gen.Config with Formatter = formatter } - } + gen + |> Config.map (GenConfig.setFormatter formatter) - let ofRandom (r : Random>) : Gen<'a> = { - Random = r - Config = { - Formatter = sprintf "%A" - } + let ofRandom (random : Random>) : Gen<'a> = { + Config = GenConfig.defaultConfig () + Random = random } let toRandom (gen : Gen<'a>) : Random> = diff --git a/src/Hedgehog/GenConfig.fs b/src/Hedgehog/GenConfig.fs new file mode 100644 index 00000000..cfb16ce8 --- /dev/null +++ b/src/Hedgehog/GenConfig.fs @@ -0,0 +1,16 @@ +namespace Hedgehog + +type GenConfig<'a> = private { + Formatter : 'a -> string +} + +module GenConfig = + + let defaultConfig () = + { Formatter = sprintf "%A" } + + let getFormatter (config : GenConfig<'a>) : ('a -> string) = + config.Formatter + + let setFormatter (formatter : 'a -> string) (config : GenConfig<'a>) : GenConfig<'a> = + { config with Formatter = formatter } diff --git a/src/Hedgehog/Hedgehog.fsproj b/src/Hedgehog/Hedgehog.fsproj index 0e2e614e..fddf501f 100644 --- a/src/Hedgehog/Hedgehog.fsproj +++ b/src/Hedgehog/Hedgehog.fsproj @@ -37,6 +37,7 @@ https://github.com/hedgehogqa/fsharp-hedgehog/blob/master/doc/index.md + From 709cdca98a017440326fd705ab4055da6a58e0a0 Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Sun, 12 Sep 2021 01:53:07 +0000 Subject: [PATCH 4/5] Add test --- src/Hedgehog/Gen.fs | 6 +++++- src/Hedgehog/Linq/Gen.fs | 8 ++++++++ tests/Hedgehog.Tests/PropertyTests.fs | 13 ++++++++++++- 3 files changed, 25 insertions(+), 2 deletions(-) diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index 8de7fac9..f88a7269 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -28,6 +28,10 @@ module Gen = gen |> Config.map (GenConfig.setFormatter formatter) + let withListFormatter (gen : Gen<_>) : Gen<_> = + gen + |> withFormatter (Seq.toList >> sprintf "%A") + let ofRandom (random : Random>) : Gen<'a> = { Config = GenConfig.defaultConfig () Random = random @@ -368,7 +372,7 @@ module Gen = let resizeArray (range : Range) (g : Gen<'a>) : Gen> = list range g |> map ResizeArray - |> withFormatter (List.ofSeq >> sprintf "%A") + |> withListFormatter /// Generates an array using a 'Range' to determine the length. let array (range : Range) (g : Gen<'a>) : Gen> = diff --git a/src/Hedgehog/Linq/Gen.fs b/src/Hedgehog/Linq/Gen.fs index b1b5d3ff..b4ac4dfe 100644 --- a/src/Hedgehog/Linq/Gen.fs +++ b/src/Hedgehog/Linq/Gen.fs @@ -291,6 +291,14 @@ type GenExtensions private () = static member Where (gen : Gen<'T>, predicate : Func<'T, bool>) : Gen<'T> = Gen.filter predicate.Invoke gen + [] + static member WithFormatter (gen : Gen<'T>, formatter : Func<'T, string>) = + Gen.withFormatter formatter.Invoke gen + + [] + static member WithListFormatter (gen : Gen>) = + Gen.withListFormatter gen + [] static member Zip (genA : Gen<'T>, genB : Gen<'U>) : Gen<'T * 'U> = Gen.zip genA genB diff --git a/tests/Hedgehog.Tests/PropertyTests.fs b/tests/Hedgehog.Tests/PropertyTests.fs index dd14f315..c606d8c1 100644 --- a/tests/Hedgehog.Tests/PropertyTests.fs +++ b/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.resizeArray (Range.singleton 5) + let gen = Gen.int32 (Range.singleton 0) + let! xs = Gen.resizeArray (Range.singleton 5) gen + return false + } + |> Property.renderWith (PropertyConfig.withShrinks 0 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 PropertyConfig.defaultConfig) From bd7761121e4ed4d8c61c962a719738b6b336fab0 Mon Sep 17 00:00:00 2001 From: Adam Becker Date: Fri, 24 Sep 2021 17:43:20 +0000 Subject: [PATCH 5/5] Apply dharmaturtle's suggestion. --- src/Hedgehog/Gen.fs | 2 +- src/Hedgehog/GenConfig.fs | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs index f88a7269..6ea9cfef 100644 --- a/src/Hedgehog/Gen.fs +++ b/src/Hedgehog/Gen.fs @@ -33,7 +33,7 @@ module Gen = |> withFormatter (Seq.toList >> sprintf "%A") let ofRandom (random : Random>) : Gen<'a> = { - Config = GenConfig.defaultConfig () + Config = GenConfig.defaultConfig Random = random } diff --git a/src/Hedgehog/GenConfig.fs b/src/Hedgehog/GenConfig.fs index cfb16ce8..f7122bc9 100644 --- a/src/Hedgehog/GenConfig.fs +++ b/src/Hedgehog/GenConfig.fs @@ -6,8 +6,9 @@ type GenConfig<'a> = private { module GenConfig = - let defaultConfig () = - { Formatter = sprintf "%A" } + let defaultConfig<'a> = + let formatter: 'a -> string = sprintf "%A" + { Formatter = formatter } let getFormatter (config : GenConfig<'a>) : ('a -> string) = config.Formatter