Skip to content

Commit

Permalink
removed duplication and code clean up
Browse files Browse the repository at this point in the history
  • Loading branch information
TysonMN committed Sep 9, 2021
1 parent c5fd137 commit dd37509
Showing 1 changed file with 13 additions and 12 deletions.
25 changes: 13 additions & 12 deletions src/Hedgehog/Property.fs
Original file line number Diff line number Diff line change
Expand Up @@ -56,15 +56,18 @@ module Property =
failure

let counterexample (msg : unit -> string) : Property<unit> =
Gen.constant (Journal.singleton msg, Success ()) |> ofGen
(Journal.singleton msg, Success ()) |> Gen.constant |> ofGen

let private mapGen
(f : Gen<Journal * Outcome<'a>> -> Gen<Journal * Outcome<'b>>)
(x : Property<'a>) : Property<'b> =
toGen x |> f |> ofGen
(p : Property<'a>) : Property<'b> =
p |> toGen |> f |> ofGen

let map (f : 'a -> 'b) (x : Property<'a>) : Property<'b> =
(mapGen << GenTuple.mapSnd << Outcome.map) f x
f |> Outcome.map |> GenTuple.mapSnd |> mapGen <| x

let set (a: 'a) (property : Property<'b>) : Property<'a> =
property |> map (fun _ -> a)

let private bindGen
(k : 'a -> Gen<Journal * Outcome<'b>>)
Expand All @@ -78,11 +81,11 @@ module Property =
| Success x ->
GenTuple.mapFst (Journal.append journal) (k x))

let private handle (e : exn) =
Gen.constant (Journal.singletonMessage (string e), Failure) |> ofGen
let handle (e : exn) =
(Journal.singletonMessage (string e), Failure) |> Gen.constant

let bind (k : 'a -> Property<'b>) (m : Property<'a>) : Property<'b> =
bindGen (fun a -> (try k a with e -> handle e) |> toGen) (toGen m) |> ofGen
m |> toGen |> bindGen (fun a -> (try k a |> toGen with e -> handle e)) |> ofGen

let private printValue (value) : string =
// sprintf "%A" is not prepared for printing ResizeArray<_> (C# List<T>) so we prepare the value instead
Expand All @@ -101,13 +104,11 @@ module Property =

value |> prepareForPrinting |> sprintf "%A"

let private handle (e : exn) =
Gen.constant (Journal.singletonMessage (string e), Failure) |> ofGen

let forAll (k : 'a -> Property<'b>) (gen : Gen<'a>) : Property<'b> =
let prepend (x : 'a) =
counterexample (fun () -> printValue x)
|> bind (fun _ -> try k x with e -> handle e)
|> set x
|> bind k
|> toGen

gen |> Gen.bind prepend |> ofGen
Expand Down Expand Up @@ -211,7 +212,7 @@ module Property =
try
success (f a)
with e ->
handle e
handle e |> ofGen

let reportRecheckWith (size : Size) (seed : Seed) (config : PropertyConfig) (p : Property<unit>) : Report =
let args = {
Expand Down

0 comments on commit dd37509

Please sign in to comment.