diff --git a/src/Apropos/Gen.hs b/src/Apropos/Gen.hs
index 8a4d395..296d355 100644
--- a/src/Apropos/Gen.hs
+++ b/src/Apropos/Gen.hs
@@ -30,6 +30,7 @@ module Apropos.Gen (
   linear,
   linearFrom,
   singleton,
+  sample,
 ) where
 
 import Apropos.Gen.Range
@@ -44,8 +45,10 @@ import Data.Set qualified as Set
 import Data.String (fromString)
 import Hedgehog qualified as H
 import Hedgehog.Gen qualified as HGen
-import Hedgehog.Internal.Gen (generalize)
-import Hedgehog.Internal.Property (PropertyT (PropertyT))
+import Hedgehog.Internal.Gen (evalGenT, generalize)
+import Hedgehog.Internal.Property (PropertyT (PropertyT, unPropertyT), runTestT)
+import Hedgehog.Internal.Seed qualified as Seed
+import Hedgehog.Internal.Tree (NodeT (nodeValue), TreeT (runTreeT))
 import Hedgehog.Range qualified as HRange
 
 runGenModifiable :: GenModifiable a -> PropertyT IO (Either GenException a)
@@ -360,3 +363,25 @@ hRange :: Range -> H.Range Int
 hRange (Singleton s) = HRange.singleton s
 hRange (Linear lo hi) = HRange.linear lo hi
 hRange (LinearFrom mid lo hi) = HRange.linearFrom mid lo hi
+
+sample :: forall a. (Show a) => Gen a -> IO a
+sample gen =
+  let loop :: Int -> IO a
+      loop n =
+        if n <= 0
+          then error "Apropos.Gen.sample: too many discards, could not generate a sample"
+          else do
+            seed <- Seed.random
+            x <-
+              runTreeT
+                . evalGenT 30 seed
+                . fmap fst
+                . runTestT
+                . unPropertyT
+                . runGenModifiable
+                . forAll
+                $ gen
+            case nodeValue x of
+              Just (Right (Right a)) -> return a
+              _ -> loop (n - 1)
+   in loop (100 :: Int)