From dbc9f07170ef98c908fafc38129a0c014c728302 Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Mon, 9 Dec 2024 22:46:22 +0100
Subject: [PATCH] Make 'genInfinite' generate truly infinite streams

This makes the `prop_regression_shrinkAllNullErrors` property succeed, and not
loop forever during shrinking.
---
 fs-sim/src/System/FS/Sim/Stream.hs      |  2 +-
 fs-sim/test/Test/System/FS/Sim/Error.hs | 11 +++++++++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/fs-sim/src/System/FS/Sim/Stream.hs b/fs-sim/src/System/FS/Sim/Stream.hs
index bf7ab9c..2c599c8 100644
--- a/fs-sim/src/System/FS/Sim/Stream.hs
+++ b/fs-sim/src/System/FS/Sim/Stream.hs
@@ -165,4 +165,4 @@ genFinite n gen = Stream Finite <$> replicateM n gen
 genInfinite ::
      Gen (Maybe a)  -- ^ Tip: use 'genMaybe'.
   -> Gen (Stream a)
-genInfinite gen = Stream Infinite <$> QC.listOf gen
+genInfinite gen = Stream Infinite <$> QC.infiniteListOf gen
diff --git a/fs-sim/test/Test/System/FS/Sim/Error.hs b/fs-sim/test/Test/System/FS/Sim/Error.hs
index 0669f07..3d2edab 100644
--- a/fs-sim/test/Test/System/FS/Sim/Error.hs
+++ b/fs-sim/test/Test/System/FS/Sim/Error.hs
@@ -258,6 +258,13 @@ prop_regression_shrinkNotAllNullErrors :: Errors -> Property
 prop_regression_shrinkNotAllNullErrors errs = expectFailure $
     not (allNull errs) ==> property False
 
-prop_regression_shrinkAllNullErrors :: Errors -> Property
-prop_regression_shrinkAllNullErrors errs = expectFailure $
+newtype AllNullErrors = AllNullErrors Errors
+  deriving Show
+
+instance Arbitrary AllNullErrors where
+  arbitrary = AllNullErrors <$> oneof [ pure emptyErrors ]
+  shrink (AllNullErrors errs) = AllNullErrors <$> shrink errs
+
+prop_regression_shrinkAllNullErrors :: AllNullErrors -> Property
+prop_regression_shrinkAllNullErrors (AllNullErrors errs) = expectFailure $
     allNull errs ==> property False