Change Gen.apply from monadic to applicative

hedgehogqa · Dec 29, 2021 · 5f1ab55 · 5f1ab55
1 parent 3703ef2
commit 5f1ab55
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 3 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,6 +1,6 @@
 ## Version ?.?.?
 
-- Add `Tree.apply` ([#398][398], [@TysonMN][TysonMN])
+- Add `Tree.apply`. Change `Gen.apply` from monadic to applicative. ([#398][398], [@TysonMN][TysonMN])
 
 ## Version 0.12.0 (2021-12-12)
 

diff --git a/src/Hedgehog/Gen.fs b/src/Hedgehog/Gen.fs
@@ -52,9 +52,12 @@ module Gen =
     let bind (k : 'a -> Gen<'b>) (m : Gen<'a>) : Gen<'b> =
         toRandom m |> bindRandom (toRandom << k) |> ofRandom
 
+    let private applyRandom (rta : Random<Tree<'a>>) (rtf : Random<Tree<'a -> 'b>>) : Random<Tree<'b>> =
+        rtf |> Random.bind (fun tf ->
+        rta |> Random.map  (fun ta -> Tree.apply ta tf))
+
     let apply (ga : Gen<'a>) (gf : Gen<'a -> 'b>) : Gen<'b> =
-        gf |> bind (fun f ->
-        ga |> map f)
+        applyRandom (toRandom ga) (toRandom gf) |> ofRandom
 
     let map2 (f : 'a -> 'b -> 'c) (ga : Gen<'a>) (gb : Gen<'b>) : Gen<'c> =
         constant f