From 89ad2de883fa88f61a049009c213046822baa37a Mon Sep 17 00:00:00 2001
From: Maximilian Algehed <m.algehed@gmail.com>
Date: Thu, 6 Nov 2025 15:31:53 +0100
Subject: [PATCH 1/5] try to do this quickly

---
 src/Constrained/GenT.hs | 94 ++++++++++++++++++++++++++---------------
 1 file changed, 61 insertions(+), 33 deletions(-)

diff --git a/src/Constrained/GenT.hs b/src/Constrained/GenT.hs
index aabc608..679197e 100644
--- a/src/Constrained/GenT.hs
+++ b/src/Constrained/GenT.hs
@@ -69,6 +69,9 @@ import GHC.Stack
 import System.Random
 import Test.QuickCheck hiding (Args, Fun)
 import Test.QuickCheck.Gen
+import Test.QuickCheck.Random
+import Control.Arrow (second)
+import Control.Monad.Trans
 
 -- ==============================================================
 -- The GE Monad
@@ -90,6 +93,39 @@ instance Monad GE where
   GenError es >>= _ = GenError es
   Result a >>= k = k a
 
+------------------------------------------------------------------------
+-- Strict gen monad
+------------------------------------------------------------------------
+
+liftGenToStrict :: Gen a -> StrictGenT m a
+liftGenToStrict g = StrictGen $ \seed size -> do
+  let (seed', seed'') = split seed
+  pure (seed'', unGen g seed' size)
+
+runStrictGen :: StrictGenT m a -> Gen (m a)
+runStrictGen g = MkGen $ \seed size -> do
+  snd <$> unStrictGen g seed size
+
+strictGetSize :: StrictGenT m Int
+strictGetSize = StrictGen $ \ seed size -> pure (seed, size)
+
+newtype StrictGenT m a = StrictGen { unStrictGen :: QCGen -> Int -> m (QCGen, a) }
+
+instance Functor (StrictGenT m) where
+  fmap f (StrictGen g) = StrictGen $ \ seed size -> second f <$> g seed size
+
+instance Applicative (StrictGenT m) where
+  pure a = StrictGen $ \ seed _ -> pure (seed, a)
+  (<*>) = ap
+
+instance Monad (StrictGenT m) where
+  StrictGen g >>= k = StrictGen $ \ seed size -> do
+    (seed', a) <- g seed size
+    unStrictGen (k a) seed' size
+
+instance MonadTrans StrictGenT where
+  lift m = StrictGen $ \ seed _ -> (seed,) <$> m
+
 ------------------------------------------------------------------------
 -- The GenT monad
 -- An environment monad on top of GE
@@ -108,19 +144,17 @@ data GenMode
 
 -- | A `Gen` monad wrapper that allows different generation modes and different
 -- failure types.
-newtype GenT m a = GenT {runGenT :: GenMode -> [NonEmpty String] -> Gen (m a)}
+newtype GenT m a = GenT {runGenT :: GenMode -> [NonEmpty String] -> StrictGenT m a}
   deriving (Functor)
 
 instance Monad m => Applicative (GenT m) where
-  pure a = GenT (\_ _ -> pure @Gen (pure @m a))
+  pure a = GenT (\_ _ -> pure a)
   (<*>) = ap
 
--- I think this might be an inlined use of the Gen monad transformer?
 instance Monad m => Monad (GenT m) where
-  GenT m >>= k = GenT $ \mode -> \msgs -> MkGen $ \r n -> do
-    let (r1, r2) = split r
-    a <- unGen (m mode msgs) r1 n
-    unGen (runGenT (k a) mode msgs) r2 n
+  GenT m >>= k = GenT $ \mode msgs -> do
+    a <- m mode msgs
+    runGenT (k a) mode msgs
 
 instance MonadGenError m => MonadFail (GenT m) where
   fail s = genError s
@@ -168,15 +202,15 @@ instance MonadGenError GE where
 
 -- | calls to genError and fatalError, add the stacked messages in the monad.
 instance MonadGenError m => MonadGenError (GenT m) where
-  genErrorNE e = GenT $ \_ xs -> pure $ genErrors (add e xs)
-  genErrors es = GenT $ \_ xs -> pure $ genErrors (cat es xs)
+  genErrorNE e = GenT $ \_ xs -> lift $ genErrors (add e xs)
+  genErrors es = GenT $ \_ xs -> lift $ genErrors (cat es xs)
 
   -- Perhaps we want to turn genError into fatalError, if mode_ is Strict?
-  fatalErrorNE e = GenT $ \_ xs -> pure $ fatalErrors (add e xs)
-  fatalErrors es = GenT $ \_ xs -> pure $ fatalErrors (cat es xs)
+  fatalErrorNE e = GenT $ \_ xs -> lift $ fatalErrors (add e xs)
+  fatalErrors es = GenT $ \_ xs -> lift $ fatalErrors (cat es xs)
 
   -- Perhaps we want to turn fatalError into genError, if mode_ is Loose?
-  explainNE e (GenT f) = GenT $ \mode es -> fmap (explainNE e) (f mode es)
+  explainNE e (GenT f) = GenT $ \mode es -> explainNE e $ f mode es
 
 -- ====================================================
 -- useful operations on NonEmpty
@@ -271,28 +305,24 @@ listFromGE = fromGE (const []) . explain "listFromGE"
 
 -- | Run a t`GenT` generator in `Strict` mode
 strictGen :: GenT m a -> Gen (m a)
-strictGen genT = runGenT genT Strict []
+strictGen genT = runStrictGen $ runGenT genT Strict []
 
 -- | Run a t`GenT` generator in `Loose` mode
 looseGen :: GenT m a -> Gen (m a)
-looseGen genT = runGenT genT Loose []
+looseGen genT = runStrictGen $ runGenT genT Loose []
 
 -- | Turn a t`GenT` generator into a `Gen` generator in `Strict` mode
 genFromGenT :: GenT GE a -> Gen a
 genFromGenT genT = errorGE <$> strictGen genT
 
--- | Locally change the generation size
-resizeT :: (Int -> Int) -> GenT m a -> GenT m a
-resizeT f (GenT gm) = GenT $ \mode msgs -> sized $ \sz -> resize (f sz) (gm mode msgs)
-
 -- | Turn a `Gen` generator into a t`GenT` generator that never fails.
 pureGen :: Applicative m => Gen a -> GenT m a
-pureGen gen = GenT $ \_ _ -> pure <$> gen
+pureGen gen = GenT $ \_ _ -> liftGenToStrict gen
 
 -- | Lift `listOf` to t`GenT`
 listOfT :: MonadGenError m => GenT GE a -> GenT m [a]
 listOfT gen = do
-  lst <- pureGen . listOf $ runGenT gen Loose []
+  lst <- pureGen . listOf $ runStrictGen $ runGenT gen Loose []
   catGEs lst
 
 -- | Generate a list of elements of length at most @goalLen@, but accepting
@@ -310,18 +340,18 @@ listOfUntilLenT gen goalLen validLen =
   genList `suchThatT` validLen . length
   where
     genList = do
-      res <- pureGen . vectorOf goalLen $ runGenT gen Loose []
+      res <- pureGen . vectorOf goalLen $ runStrictGen $ runGenT gen Loose []
       catGEs res
 
 -- | Lift `vectorOf` to t`GenT`
 vectorOfT :: MonadGenError m => Int -> GenT GE a -> GenT m [a]
 vectorOfT i gen = GenT $ \mode _ -> do
-  res <- fmap sequence . vectorOf i $ runGenT gen Strict []
+  res <- _ -- pureGen $ fmap sequence . vectorOf i $ runStrictGen $ runGenT gen Strict []
   case mode of
-    Strict -> pure $ runGE res
+    Strict -> lift $ runGE res
     Loose -> case res of
-      FatalError es -> pure $ genErrors es
-      _ -> pure $ runGE res
+      FatalError es -> lift $ genErrors es
+      _ -> lift $ runGE res
 
 infixl 2 `suchThatT`
 
@@ -356,11 +386,11 @@ scaleT sc (GenT gen) = GenT $ \mode msgs -> scale sc $ gen mode msgs
 -- | Access the `GenMode` we are running in, useful to decide e.g.  if we want
 -- to re-try in case of a `GenError` or give up
 getMode :: Applicative m => GenT m GenMode
-getMode = GenT $ \mode _ -> pure (pure mode)
+getMode = GenT $ \mode _ -> pure mode
 
 -- | Get the current stack of `explain` above you
 getMessages :: Applicative m => GenT m [NonEmpty String]
-getMessages = GenT $ \_ msgs -> pure (pure msgs)
+getMessages = GenT $ \_ msgs -> pure msgs
 
 -- | Locally change the generation mode
 withMode :: GenMode -> GenT m a -> GenT m a
@@ -377,7 +407,7 @@ frequencyT gs = do
   msgs <- getMessages
   r <-
     explain "suchThatT in oneofT" $
-      pureGen (frequency [(f, runGenT g mode msgs) | (f, g) <- gs]) `suchThatT` isOk
+      pureGen (frequency [(f, runStrictGen $ runGenT g mode msgs) | (f, g) <- gs]) `suchThatT` isOk
   runGE r
 
 -- | Lift `choose` to t`GenT`, failing with a `genError` in case of an empty interval
@@ -388,7 +418,7 @@ chooseT (a, b)
 
 -- | Get the size provided to the generator
 sizeT :: Monad m => GenT m Int
-sizeT = GenT $ \mode msgs -> sized $ \n -> runGenT (pure n) mode msgs
+sizeT = GenT $ \mode msgs -> strictGetSize
 
 -- ==================================================================
 -- Reflective analysis of the internal GE structure of (GenT GE x)
@@ -396,10 +426,8 @@ sizeT = GenT $ \mode msgs -> sized $ \n -> runGenT (pure n) mode msgs
 -- the program to control what happens in those cases.
 
 -- | Always succeeds, but returns the internal GE structure for analysis
-inspect :: forall m x. MonadGenError m => GenT GE x -> GenT m (GE x)
-inspect (GenT f) = GenT g
-  where
-    g mode msgs = do geThing <- f mode msgs; pure @Gen (pure @m geThing)
+inspect :: forall m a. MonadGenError m => GenT GE a -> GenT m (GE a)
+inspect (GenT f) = GenT $ \ mode msgs -> liftGenToStrict $ runStrictGen $ f mode msgs
 
 -- | Ignore all kinds of Errors, by squashing them into Nothing
 tryGenT :: MonadGenError m => GenT GE a -> GenT m (Maybe a)

From 05fb881f3f5e5b6df1f683bca86dc0ecc2359f0d Mon Sep 17 00:00:00 2001
From: Maximilian Algehed <m.algehed@gmail.com>
Date: Fri, 7 Nov 2025 08:19:47 +0100
Subject: [PATCH 2/5] ~20% speedup

---
 src/Constrained/GenT.hs | 39 +++++++++++++++++++++++----------------
 1 file changed, 23 insertions(+), 16 deletions(-)

diff --git a/src/Constrained/GenT.hs b/src/Constrained/GenT.hs
index 679197e..10e3eb3 100644
--- a/src/Constrained/GenT.hs
+++ b/src/Constrained/GenT.hs
@@ -24,6 +24,7 @@ module Constrained.GenT (
   suchThatT,
   suchThatWithTryT,
   scaleT,
+  resizeT,
   firstGenT,
   tryGenT,
   chooseT,
@@ -34,7 +35,6 @@ module Constrained.GenT (
   vectorOfT,
   listOfUntilLenT,
   listOfT,
-  resizeT,
   strictGen,
   looseGen,
 
@@ -97,28 +97,31 @@ instance Monad GE where
 -- Strict gen monad
 ------------------------------------------------------------------------
 
-liftGenToStrict :: Gen a -> StrictGenT m a
+liftGenToStrict :: Monad m => Gen a -> StrictGenT m a
 liftGenToStrict g = StrictGen $ \seed size -> do
   let (seed', seed'') = split seed
   pure (seed'', unGen g seed' size)
 
-runStrictGen :: StrictGenT m a -> Gen (m a)
+runStrictGen :: Functor m => StrictGenT m a -> Gen (m a)
 runStrictGen g = MkGen $ \seed size -> do
   snd <$> unStrictGen g seed size
 
-strictGetSize :: StrictGenT m Int
+strictGetSize :: Applicative m => StrictGenT m Int
 strictGetSize = StrictGen $ \ seed size -> pure (seed, size)
 
+scaleStrict :: (Int -> Int) -> StrictGenT m a -> StrictGenT m a
+scaleStrict f sg = StrictGen $ \ seed size -> unStrictGen sg seed (f size)
+
 newtype StrictGenT m a = StrictGen { unStrictGen :: QCGen -> Int -> m (QCGen, a) }
 
-instance Functor (StrictGenT m) where
+instance Functor m => Functor (StrictGenT m) where
   fmap f (StrictGen g) = StrictGen $ \ seed size -> second f <$> g seed size
 
-instance Applicative (StrictGenT m) where
+instance Monad m => Applicative (StrictGenT m) where
   pure a = StrictGen $ \ seed _ -> pure (seed, a)
   (<*>) = ap
 
-instance Monad (StrictGenT m) where
+instance Monad m => Monad (StrictGenT m) where
   StrictGen g >>= k = StrictGen $ \ seed size -> do
     (seed', a) <- g seed size
     unStrictGen (k a) seed' size
@@ -210,7 +213,7 @@ instance MonadGenError m => MonadGenError (GenT m) where
   fatalErrors es = GenT $ \_ xs -> lift $ fatalErrors (cat es xs)
 
   -- Perhaps we want to turn fatalError into genError, if mode_ is Loose?
-  explainNE e (GenT f) = GenT $ \mode es -> explainNE e $ f mode es
+  explainNE e (GenT f) = GenT $ \mode es -> StrictGen $ \ seed size -> explainNE e $ unStrictGen (f mode es) seed size
 
 -- ====================================================
 -- useful operations on NonEmpty
@@ -304,11 +307,11 @@ listFromGE = fromGE (const []) . explain "listFromGE"
 -- Useful operations on GenT
 
 -- | Run a t`GenT` generator in `Strict` mode
-strictGen :: GenT m a -> Gen (m a)
+strictGen :: Functor m => GenT m a -> Gen (m a)
 strictGen genT = runStrictGen $ runGenT genT Strict []
 
 -- | Run a t`GenT` generator in `Loose` mode
-looseGen :: GenT m a -> Gen (m a)
+looseGen :: Functor m => GenT m a -> Gen (m a)
 looseGen genT = runStrictGen $ runGenT genT Loose []
 
 -- | Turn a t`GenT` generator into a `Gen` generator in `Strict` mode
@@ -316,7 +319,7 @@ genFromGenT :: GenT GE a -> Gen a
 genFromGenT genT = errorGE <$> strictGen genT
 
 -- | Turn a `Gen` generator into a t`GenT` generator that never fails.
-pureGen :: Applicative m => Gen a -> GenT m a
+pureGen :: Monad m => Gen a -> GenT m a
 pureGen gen = GenT $ \_ _ -> liftGenToStrict gen
 
 -- | Lift `listOf` to t`GenT`
@@ -346,7 +349,7 @@ listOfUntilLenT gen goalLen validLen =
 -- | Lift `vectorOf` to t`GenT`
 vectorOfT :: MonadGenError m => Int -> GenT GE a -> GenT m [a]
 vectorOfT i gen = GenT $ \mode _ -> do
-  res <- _ -- pureGen $ fmap sequence . vectorOf i $ runStrictGen $ runGenT gen Strict []
+  res <- liftGenToStrict $ fmap sequence . vectorOf i $ runStrictGen $ runGenT gen Strict []
   case mode of
     Strict -> lift $ runGE res
     Loose -> case res of
@@ -381,15 +384,19 @@ suchThatWithTryT tries g p = do
 
 -- | Lift `scale` to t`GenT`
 scaleT :: (Int -> Int) -> GenT m a -> GenT m a
-scaleT sc (GenT gen) = GenT $ \mode msgs -> scale sc $ gen mode msgs
+scaleT sc (GenT gen) = GenT $ \mode msgs -> scaleStrict sc $ gen mode msgs
+
+-- | Lift `resize` to t`GenT`
+resizeT :: Int -> GenT m a -> GenT m a
+resizeT = scaleT . const
 
 -- | Access the `GenMode` we are running in, useful to decide e.g.  if we want
 -- to re-try in case of a `GenError` or give up
-getMode :: Applicative m => GenT m GenMode
+getMode :: Monad m => GenT m GenMode
 getMode = GenT $ \mode _ -> pure mode
 
 -- | Get the current stack of `explain` above you
-getMessages :: Applicative m => GenT m [NonEmpty String]
+getMessages :: Monad m => GenT m [NonEmpty String]
 getMessages = GenT $ \_ msgs -> pure msgs
 
 -- | Locally change the generation mode
@@ -418,7 +425,7 @@ chooseT (a, b)
 
 -- | Get the size provided to the generator
 sizeT :: Monad m => GenT m Int
-sizeT = GenT $ \mode msgs -> strictGetSize
+sizeT = GenT $ \_ _ -> strictGetSize
 
 -- ==================================================================
 -- Reflective analysis of the internal GE structure of (GenT GE x)

From 5f45ef3b3688b50763470095841a3ba662704a03 Mon Sep 17 00:00:00 2001
From: Maximilian Algehed <m.algehed@gmail.com>
Date: Thu, 13 Nov 2025 15:32:27 +0100
Subject: [PATCH 3/5] Better name

---
 src/Constrained/GenT.hs | 62 ++++++++++++++++++++---------------------
 1 file changed, 31 insertions(+), 31 deletions(-)

diff --git a/src/Constrained/GenT.hs b/src/Constrained/GenT.hs
index 10e3eb3..ebc6ef2 100644
--- a/src/Constrained/GenT.hs
+++ b/src/Constrained/GenT.hs
@@ -94,40 +94,40 @@ instance Monad GE where
   Result a >>= k = k a
 
 ------------------------------------------------------------------------
--- Strict gen monad
+-- Threading gen monad
 ------------------------------------------------------------------------
 
-liftGenToStrict :: Monad m => Gen a -> StrictGenT m a
-liftGenToStrict g = StrictGen $ \seed size -> do
+liftGenToThreading :: Monad m => Gen a -> ThreadingGenT m a
+liftGenToThreading g = ThreadingGen $ \seed size -> do
   let (seed', seed'') = split seed
   pure (seed'', unGen g seed' size)
 
-runStrictGen :: Functor m => StrictGenT m a -> Gen (m a)
-runStrictGen g = MkGen $ \seed size -> do
-  snd <$> unStrictGen g seed size
+runThreadingGen :: Functor m => ThreadingGenT m a -> Gen (m a)
+runThreadingGen g = MkGen $ \seed size -> do
+  snd <$> unThreadingGen g seed size
 
-strictGetSize :: Applicative m => StrictGenT m Int
-strictGetSize = StrictGen $ \ seed size -> pure (seed, size)
+strictGetSize :: Applicative m => ThreadingGenT m Int
+strictGetSize = ThreadingGen $ \ seed size -> pure (seed, size)
 
-scaleStrict :: (Int -> Int) -> StrictGenT m a -> StrictGenT m a
-scaleStrict f sg = StrictGen $ \ seed size -> unStrictGen sg seed (f size)
+scaleThreading :: (Int -> Int) -> ThreadingGenT m a -> ThreadingGenT m a
+scaleThreading f sg = ThreadingGen $ \ seed size -> unThreadingGen sg seed (f size)
 
-newtype StrictGenT m a = StrictGen { unStrictGen :: QCGen -> Int -> m (QCGen, a) }
+newtype ThreadingGenT m a = ThreadingGen { unThreadingGen :: QCGen -> Int -> m (QCGen, a) }
 
-instance Functor m => Functor (StrictGenT m) where
-  fmap f (StrictGen g) = StrictGen $ \ seed size -> second f <$> g seed size
+instance Functor m => Functor (ThreadingGenT m) where
+  fmap f (ThreadingGen g) = ThreadingGen $ \ seed size -> second f <$> g seed size
 
-instance Monad m => Applicative (StrictGenT m) where
-  pure a = StrictGen $ \ seed _ -> pure (seed, a)
+instance Monad m => Applicative (ThreadingGenT m) where
+  pure a = ThreadingGen $ \ seed _ -> pure (seed, a)
   (<*>) = ap
 
-instance Monad m => Monad (StrictGenT m) where
-  StrictGen g >>= k = StrictGen $ \ seed size -> do
+instance Monad m => Monad (ThreadingGenT m) where
+  ThreadingGen g >>= k = ThreadingGen $ \ seed size -> do
     (seed', a) <- g seed size
-    unStrictGen (k a) seed' size
+    unThreadingGen (k a) seed' size
 
-instance MonadTrans StrictGenT where
-  lift m = StrictGen $ \ seed _ -> (seed,) <$> m
+instance MonadTrans ThreadingGenT where
+  lift m = ThreadingGen $ \ seed _ -> (seed,) <$> m
 
 ------------------------------------------------------------------------
 -- The GenT monad
@@ -147,7 +147,7 @@ data GenMode
 
 -- | A `Gen` monad wrapper that allows different generation modes and different
 -- failure types.
-newtype GenT m a = GenT {runGenT :: GenMode -> [NonEmpty String] -> StrictGenT m a}
+newtype GenT m a = GenT {runGenT :: GenMode -> [NonEmpty String] -> ThreadingGenT m a}
   deriving (Functor)
 
 instance Monad m => Applicative (GenT m) where
@@ -213,7 +213,7 @@ instance MonadGenError m => MonadGenError (GenT m) where
   fatalErrors es = GenT $ \_ xs -> lift $ fatalErrors (cat es xs)
 
   -- Perhaps we want to turn fatalError into genError, if mode_ is Loose?
-  explainNE e (GenT f) = GenT $ \mode es -> StrictGen $ \ seed size -> explainNE e $ unStrictGen (f mode es) seed size
+  explainNE e (GenT f) = GenT $ \mode es -> ThreadingGen $ \ seed size -> explainNE e $ unThreadingGen (f mode es) seed size
 
 -- ====================================================
 -- useful operations on NonEmpty
@@ -308,11 +308,11 @@ listFromGE = fromGE (const []) . explain "listFromGE"
 
 -- | Run a t`GenT` generator in `Strict` mode
 strictGen :: Functor m => GenT m a -> Gen (m a)
-strictGen genT = runStrictGen $ runGenT genT Strict []
+strictGen genT = runThreadingGen $ runGenT genT Strict []
 
 -- | Run a t`GenT` generator in `Loose` mode
 looseGen :: Functor m => GenT m a -> Gen (m a)
-looseGen genT = runStrictGen $ runGenT genT Loose []
+looseGen genT = runThreadingGen $ runGenT genT Loose []
 
 -- | Turn a t`GenT` generator into a `Gen` generator in `Strict` mode
 genFromGenT :: GenT GE a -> Gen a
@@ -320,12 +320,12 @@ genFromGenT genT = errorGE <$> strictGen genT
 
 -- | Turn a `Gen` generator into a t`GenT` generator that never fails.
 pureGen :: Monad m => Gen a -> GenT m a
-pureGen gen = GenT $ \_ _ -> liftGenToStrict gen
+pureGen gen = GenT $ \_ _ -> liftGenToThreading gen
 
 -- | Lift `listOf` to t`GenT`
 listOfT :: MonadGenError m => GenT GE a -> GenT m [a]
 listOfT gen = do
-  lst <- pureGen . listOf $ runStrictGen $ runGenT gen Loose []
+  lst <- pureGen . listOf $ runThreadingGen $ runGenT gen Loose []
   catGEs lst
 
 -- | Generate a list of elements of length at most @goalLen@, but accepting
@@ -343,13 +343,13 @@ listOfUntilLenT gen goalLen validLen =
   genList `suchThatT` validLen . length
   where
     genList = do
-      res <- pureGen . vectorOf goalLen $ runStrictGen $ runGenT gen Loose []
+      res <- pureGen . vectorOf goalLen $ runThreadingGen $ runGenT gen Loose []
       catGEs res
 
 -- | Lift `vectorOf` to t`GenT`
 vectorOfT :: MonadGenError m => Int -> GenT GE a -> GenT m [a]
 vectorOfT i gen = GenT $ \mode _ -> do
-  res <- liftGenToStrict $ fmap sequence . vectorOf i $ runStrictGen $ runGenT gen Strict []
+  res <- liftGenToThreading $ fmap sequence . vectorOf i $ runThreadingGen $ runGenT gen Strict []
   case mode of
     Strict -> lift $ runGE res
     Loose -> case res of
@@ -384,7 +384,7 @@ suchThatWithTryT tries g p = do
 
 -- | Lift `scale` to t`GenT`
 scaleT :: (Int -> Int) -> GenT m a -> GenT m a
-scaleT sc (GenT gen) = GenT $ \mode msgs -> scaleStrict sc $ gen mode msgs
+scaleT sc (GenT gen) = GenT $ \mode msgs -> scaleThreading sc $ gen mode msgs
 
 -- | Lift `resize` to t`GenT`
 resizeT :: Int -> GenT m a -> GenT m a
@@ -414,7 +414,7 @@ frequencyT gs = do
   msgs <- getMessages
   r <-
     explain "suchThatT in oneofT" $
-      pureGen (frequency [(f, runStrictGen $ runGenT g mode msgs) | (f, g) <- gs]) `suchThatT` isOk
+      pureGen (frequency [(f, runThreadingGen $ runGenT g mode msgs) | (f, g) <- gs]) `suchThatT` isOk
   runGE r
 
 -- | Lift `choose` to t`GenT`, failing with a `genError` in case of an empty interval
@@ -434,7 +434,7 @@ sizeT = GenT $ \_ _ -> strictGetSize
 
 -- | Always succeeds, but returns the internal GE structure for analysis
 inspect :: forall m a. MonadGenError m => GenT GE a -> GenT m (GE a)
-inspect (GenT f) = GenT $ \ mode msgs -> liftGenToStrict $ runStrictGen $ f mode msgs
+inspect (GenT f) = GenT $ \ mode msgs -> liftGenToThreading $ runThreadingGen $ f mode msgs
 
 -- | Ignore all kinds of Errors, by squashing them into Nothing
 tryGenT :: MonadGenError m => GenT GE a -> GenT m (Maybe a)

From 850e2131842581f7212eb8aae12c826d15ed8ea5 Mon Sep 17 00:00:00 2001
From: Maximilian Algehed <m.algehed@gmail.com>
Date: Thu, 13 Nov 2025 15:45:18 +0100
Subject: [PATCH 4/5] Documentation

---
 src/Constrained/GenT.hs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/src/Constrained/GenT.hs b/src/Constrained/GenT.hs
index ebc6ef2..974892c 100644
--- a/src/Constrained/GenT.hs
+++ b/src/Constrained/GenT.hs
@@ -97,6 +97,26 @@ instance Monad GE where
 -- Threading gen monad
 ------------------------------------------------------------------------
 
+-- The normal Gen monad always splits the seed when doing >>=. This is for very
+-- good reasons - it lets you write generators that generate infinite data to
+-- the left of a >>= and let's your generators be very lazy!
+
+-- A traditional GenT m a implementation would inherit this splitting behaviour
+-- in order to let you keep writing infinite and lazy things to the left of >>=
+-- on the GenT m level. Now, the thing to realize about this is that unless
+-- your code is very carefully written to avoid it this means you're going to
+-- end up with unnecessary >>=s and thus unnecessary splits.
+
+-- To get around this issue of unnecessary splits we introduce a threading GenT
+-- implementation here that sacrifices letting you do infinite (and to some
+-- extent lazy) structures to the left of >>= on the GenT m level, but doesn't
+-- prohibit you from doing so on the Gen level.
+
+-- This drastically reduces the number of seed splits while still letting you
+-- write lazy and infinite generators in Gen land by being a little bit more
+-- careful. It works great for constrained-generators in particular, which has
+-- a tendency to be strict and by design avoids inifinte values.
+
 liftGenToThreading :: Monad m => Gen a -> ThreadingGenT m a
 liftGenToThreading g = ThreadingGen $ \seed size -> do
   let (seed', seed'') = split seed

From 05e2bc986bb3e34b1ee01a21ab2377b020aec1a6 Mon Sep 17 00:00:00 2001
From: Maximilian Algehed <m.algehed@gmail.com>
Date: Thu, 20 Nov 2025 14:12:01 +0100
Subject: [PATCH 5/5] fix warning

---
 src/Constrained/NumOrd.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/src/Constrained/NumOrd.hs b/src/Constrained/NumOrd.hs
index 8314392..f391dc8 100644
--- a/src/Constrained/NumOrd.hs
+++ b/src/Constrained/NumOrd.hs
@@ -71,7 +71,6 @@ import Data.List (nub)
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import qualified Data.List.NonEmpty as NE
 import Data.Maybe
-import qualified Data.Set as Set
 import Data.Typeable (typeOf)
 import Data.Word
 import GHC.Int