Resolve elm-explorations#172

src/Fuzz.elm

@@ -498,22 +498,31 @@ function to, if no acceptable input can be found, create one from an
 unacceptable one. Also takes a condition to determine if the input is
 acceptable or not, and finally the fuzzer itself.
 
-A good number of max retires is ten. A large number of retries might
+A good number of max retries is ten. A large number of retries might
 blow the stack.
 
 -}
 conditional : { retries : Int, fallback : a -> a, condition : a -> Bool } -> Fuzzer a -> Fuzzer a
-conditional { retries, fallback, condition } fuzzer =
-    if retries <= 0 then
-        map fallback fuzzer
+conditional opts fuzzer =
+    Result.map (conditionalHelper opts) fuzzer
+
+
+conditionalHelper : { retries : Int, fallback : a -> a, condition : a -> Bool } -> ValidFuzzer a -> ValidFuzzer a
+conditionalHelper opts validFuzzer =
+    if opts.retries <= 0 then
+        Random.map
+            (RoseTree.map opts.fallback >> RoseTree.filterBranches opts.condition)
+            validFuzzer
     else
-        fuzzer
-            |> Internal.andThenNoHistory
-                (\val ->
-                    if condition val then
-                        constant val
-                    else
-                        conditional { retries = retries - 1, fallback = fallback, condition = condition } fuzzer
+        validFuzzer
+            |> Random.andThen
+                (\tree ->
+                    case RoseTree.filter opts.condition tree of
+                        Just tree ->
+                            Random.constant tree
+
+                        Nothing ->
+                            conditionalHelper { opts | retries = opts.retries - 1 } validFuzzer
                 )
 
 

src/Fuzz/Internal.elm

@@ -1,4 +1,4 @@
-module Fuzz.Internal exposing (Fuzzer, Valid, ValidFuzzer, andThen, andThenNoHistory, combineValid, invalidReason, map)
+module Fuzz.Internal exposing (Fuzzer, Valid, ValidFuzzer, andThen, combineValid, invalidReason, map)
 
 import Lazy
 import Lazy.List exposing ((:::), LazyList)
@@ -49,21 +49,6 @@ andThen fn fuzzer =
     Result.map (Random.andThen (helper fn)) fuzzer
 
 
-andThenNoHistory : (a -> Fuzzer b) -> Fuzzer a -> Fuzzer b
-andThenNoHistory fn fuzzer =
-    let
-        helper : (a -> Fuzzer b) -> RoseTree a -> ValidFuzzer b
-        helper fn (Rose root _) =
-            case fn root of
-                Ok validFuzzer ->
-                    validFuzzer
-
-                Err _ ->
-                    Debug.crash "Returning an invalid fuzzer from `andThen` is currently unsupported"
-    in
-    Result.map (Random.andThen (helper fn)) fuzzer
-
-
 removeInvalid : RoseTree (Valid a) -> RoseTree a
 removeInvalid tree =
     case RoseTree.filterMap getValid tree of

src/RoseTree.elm

@@ -53,6 +53,18 @@ map f (Rose a c) =
     Rose (f a) (LazyList.map (map f) c)
 
 
+filter : (a -> Bool) -> RoseTree a -> Maybe (RoseTree a)
+filter predicate tree =
+    let
+        maybeKeep x =
+            if predicate x then
+                Just x
+            else
+                Nothing
+    in
+    filterMap maybeKeep tree
+
+
 {-| filterMap a function over a rosetree
 -}
 filterMap : (a -> Maybe b) -> RoseTree a -> Maybe (RoseTree b)
@@ -65,6 +77,13 @@ filterMap f (Rose a c) =
             Nothing
 
 
+filterBranches : (a -> Bool) -> RoseTree a -> RoseTree a
+filterBranches predicate (Rose root branches) =
+    Rose
+        root
+        (LazyList.filterMap (filter predicate) branches)
+
+
 {-| Flatten a rosetree of rosetrees.
 -}
 flatten : RoseTree (RoseTree a) -> RoseTree a