swap hedgehog out for QuickCheck

The test suite now runs on tasty + tasty-quickcheck. Translation is
mechanical: `property`/`forAll`/`lift` become
`monadicIO`/`pick`/`run`, `success`/`fail` become `pure ()`/`stop`
with a counterexample, and Hedgehog's ranged generators are replaced
by a `linear` helper that scales with QuickCheck's size parameter.
Shrinking is dropped since QuickCheck can't shrink these while keeping
the generated text within the ranges the assertions assume.

The expected-value patterns were also stale relative to the IR
(`LI`'s `child` field is gone, blocks carry a trailing `Attrs`, list
types carry a `style`), so they've been updated to match. The
structural checks are otherwise unchanged.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>

.gitignore

@@ -1,2 +1,4 @@
 dist-newstyle
 .shake
+.claude
+.serena

psb.cabal

@@ -36,7 +36,7 @@ test-suite test-markdown-parse
     hs-source-dirs: tests
     type: exitcode-stdio-1.0
     main-is: Markdown/Parse.hs
-    build-depends: base, text, megaparsec, transformers, hedgehog, time, psb
+    build-depends: base, text, megaparsec, transformers, QuickCheck, tasty, tasty-quickcheck, time, psb
     
     default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances
     default-language: Haskell2010

tests/Markdown/Parse.hs

@@ -3,156 +3,178 @@
 module Main where
 
 import Control.Exception (evaluate)
-import Control.Monad.Trans.Class (MonadTrans (lift))
-import Data.Either (isRight)
-import Data.Functor.Identity (Identity (Identity))
-import Data.String (IsString)
+import Data.Functor.Identity (Identity)
 import Data.Text (Text)
 import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
 import Data.Void (Void)
-import Debug.Trace (traceShow)
-import Hedgehog
-import qualified Hedgehog.Gen as Gen
-import qualified Hedgehog.Range as Range
 import IR
-import Markdown
 import qualified Markdown
-import System.Exit (exitFailure, exitSuccess)
 import System.Timeout (timeout)
-import Text.Megaparsec
+import Test.QuickCheck (Gen, Property, chooseInt, counterexample, elements, sized, vectorOf)
+import Test.QuickCheck.Monadic (PropertyM, monadicIO, pick, run, stop)
+import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty.QuickCheck (testProperty)
+import Text.Megaparsec (ParseErrorBundle, ParsecT, errorBundlePretty, parse)
 
 main :: IO ()
-main = do
-  cond <-
-    checkParallel $
-      Group
-        "Parse Tests"
-        [ ("all_compile", all_compiles),
-          ("block_html_compile_edgecase", block_html_compile_edgecase),
-          ("header_and_paragraph", header_and_paragraph),
-          ("paragraph_and_header_and_paragraph", paragraph_and_header_and_paragraph),
-          ("bold_and_header_and_paragraph", bold_and_header_and_paragraph),
-          ("code_block", code_block),
-          ("code_block_hanging", code_block_hanging),
-          ("two_blockquotes", two_blockquotes),
-          ("unordered_list", unordered_list),
-          ("header_after_unordered_list", header_after_unordered_list),
-          ("ordered_list", ordered_list),
-          ("multiple_ordered_lists", multiple_ordered_lists),
-          ("header_then_ordered_list", header_then_ordered_list),
-          ("simple_nested_ordered_list", simple_nested_ordered_list),
-          ("nested_unordered_list", nested_unordered_list),
-          ("greedy_plain_text", greedy_plain_text)
-          -- ("",),
-        ]
-  if cond
-    then exitSuccess
-    else exitFailure
+main = defaultMain tests
+
+tests :: TestTree
+tests =
+  testGroup
+    "Parse Tests"
+    [ testProperty "all_compile" all_compiles,
+      testProperty "block_html_compile_edgecase" block_html_compile_edgecase,
+      testProperty "header_and_paragraph" header_and_paragraph,
+      testProperty "paragraph_and_header_and_paragraph" paragraph_and_header_and_paragraph,
+      testProperty "bold_and_header_and_paragraph" bold_and_header_and_paragraph,
+      testProperty "code_block" code_block,
+      testProperty "code_block_hanging" code_block_hanging,
+      testProperty "two_blockquotes" two_blockquotes,
+      testProperty "unordered_list" unordered_list,
+      testProperty "header_after_unordered_list" header_after_unordered_list,
+      testProperty "ordered_list" ordered_list,
+      testProperty "multiple_ordered_lists" multiple_ordered_lists,
+      testProperty "header_then_ordered_list" header_then_ordered_list,
+      testProperty "simple_nested_ordered_list" simple_nested_ordered_list,
+      testProperty "nested_unordered_list" nested_unordered_list,
+      testProperty "greedy_plain_text" greedy_plain_text
+      -- testProperty "" ,
+    ]
+
+-- Hedgehog's Range.linear grows the upper bound with the size of the test
+-- case, this is the same thing in terms of QuickCheck's sizing
+linear :: Int -> Int -> Gen Int
+linear lo hi = sized $ \size ->
+  let scaled = lo + ((hi - lo) * min size 99) `div` 99
+   in chooseInt (lo, max lo scaled)
+
+textOf :: Gen Char -> Int -> Int -> Gen Text
+textOf char_gen lo hi = do
+  len <- linear lo hi
+  T.pack <$> vectorOf len char_gen
+
+ascii :: Gen Char
+ascii = elements ['\0' .. '\127']
+
+alpha :: Gen Char
+alpha = elements (['a' .. 'z'] <> ['A' .. 'Z'])
+
+alphaNum :: Gen Char
+alphaNum = elements (['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'])
 
 -- timeout of 1 second, all of these tests should be completely clear of that, if they run longer they should fail
-generic_parse inp = lift $ timeout 1000000 $ evaluate $ parse (Markdown.document :: ParsecT Void Text Identity IR.Document) "test_input" inp
+generic_parse :: Text -> PropertyM IO (Maybe (Either (ParseErrorBundle Text Void) Document))
+generic_parse inp = run $ timeout 1000000 $ evaluate $ parse (Markdown.document :: ParsecT Void Text Identity IR.Document) "test_input" inp
+
+-- the equivalent of Hedgehog's `success`
+succeed :: PropertyM IO ()
+succeed = pure ()
+
+-- the equivalent of Hedgehog's `fail`
+failWith :: String -> PropertyM IO a
+failWith message = stop $ counterexample message False
 
 all_compiles :: Property
-all_compiles = property $ do
-  xs <- forAll $ Gen.text (Range.linear 0 100) Gen.ascii
+all_compiles = monadicIO $ do
+  xs <- pick $ textOf ascii 0 100
   parsed <- generic_parse xs
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right _)) -> success
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right _)) -> succeed
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 block_html_compile_edgecase :: Property
-block_html_compile_edgecase = property $ do
-  let gen = forAll $ Gen.text (Range.linear 0 10) Gen.alphaNum
+block_html_compile_edgecase = monadicIO $ do
+  let gen = pick $ textOf alphaNum 0 10
   tagName <- gen
   misc1 <- gen
   misc2 <- gen
   parsed <- generic_parse $ (T.concat ["<", tagName, ">", misc1, "</", tagName, "> ", misc2])
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right _)) -> success
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right _)) -> succeed
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 header_and_paragraph :: Property
-header_and_paragraph = property $ do
-  header_text <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
-  header_level <- forAll $ Gen.int (Range.linear 1 6)
-  paragraph_text <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+header_and_paragraph = monadicIO $ do
+  header_text <- pick $ textOf alpha 1 10
+  header_level <- pick $ linear 1 6
+  paragraph_text <- pick $ textOf alpha 1 10
 
   let input = (T.pack $ take header_level $ repeat '#') <> header_text <> "\n\n" <> paragraph_text
 
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [Heading (H {level = header_level, text = [Text (header_text)]}), Paragraph (P ([Text paragraph_text]))]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [Heading (H {level = header_level, text = [Text (header_text)]}) _, Paragraph (P ([Text paragraph_text])) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 paragraph_and_header_and_paragraph :: Property
-paragraph_and_header_and_paragraph = property $ do
-  paragraph1_text <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
-  header_text <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
-  header_level <- forAll $ Gen.int (Range.linear 1 6)
-  paragraph2_text <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+paragraph_and_header_and_paragraph = monadicIO $ do
+  paragraph1_text <- pick $ textOf alpha 1 10
+  header_text <- pick $ textOf alpha 1 10
+  header_level <- pick $ linear 1 6
+  paragraph2_text <- pick $ textOf alpha 1 10
 
   let input = paragraph1_text <> "\n\n" <> (T.pack $ take header_level $ repeat '#') <> header_text <> "\n\n" <> paragraph2_text
 
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [Paragraph (P ([Text paragarph1_text])), Heading (H {level = header_level, text = [Text (header_text)]}), Paragraph (P ([Text paragraph2_text]))]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [Paragraph (P ([Text paragarph1_text])) _, Heading (H {level = header_level, text = [Text (header_text)]}) _, Paragraph (P ([Text paragraph2_text])) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 bold_and_header_and_paragraph :: Property
-bold_and_header_and_paragraph = property $ do
-  bold_text <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
-  header_text <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
-  header_level <- forAll $ Gen.int (Range.linear 1 6)
-  paragraph_text <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+bold_and_header_and_paragraph = monadicIO $ do
+  bold_text <- pick $ textOf alpha 1 10
+  header_text <- pick $ textOf alpha 1 10
+  header_level <- pick $ linear 1 6
+  paragraph_text <- pick $ textOf alpha 1 10
 
   let input = "**" <> bold_text <> "**\n\n" <> (T.pack $ take header_level $ repeat '#') <> header_text <> "\n\n" <> paragraph_text
 
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [Paragraph (P ([Bold [Text bold_text]])), Heading (H {level = header_level, text = [Text (header_text)]}), Paragraph (P ([Text paragraph_text]))]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [Paragraph (P ([Bold [Text bold_text] _])) _, Heading (H {level = header_level, text = [Text (header_text)]}) _, Paragraph (P ([Text paragraph_text])) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 code_block :: Property
-code_block = property $ do
-  language <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
-  code <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+code_block = monadicIO $ do
+  language <- pick $ textOf alpha 1 10
+  code <- pick $ textOf alpha 1 10
   let input = "```" <> language <> "\n" <> code <> "\n```"
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [Code (C {language, code})]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [Code (C {language, code}) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 code_block_hanging :: Property
-code_block_hanging = property $ do
-  language <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
-  code <- forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+code_block_hanging = monadicIO $ do
+  language <- pick $ textOf alpha 1 10
+  code <- pick $ textOf alpha 1 10
   let input = "```" <> language <> "\n" <> code <> "```"
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
+    Nothing -> failWith "Hit Timeout"
     -- we're just testing for hanging
-    (Just (Right _)) -> success
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    (Just (Right _)) -> succeed
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 two_blockquotes :: Property
-two_blockquotes = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+two_blockquotes = monadicIO $ do
+  let text_gen = pick $ textOf alpha 1 10
   text_1 <- text_gen
   text_2 <- text_gen
   let input = "> " <> text_1 <> "\n\n> " <> text_2
@@ -160,14 +182,14 @@ two_blockquotes = property $ do
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [BlockQuote (Q [Text text_1]), BlockQuote (Q [Text text_2])]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [BlockQuote (Q [Transparent [Text text_1]]) _, BlockQuote (Q [Transparent [Text text_2]]) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 unordered_list :: Property
-unordered_list = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+unordered_list = monadicIO $ do
+  let text_gen = pick $ textOf alpha 1 10
   text_1 <- text_gen
   text_2 <- text_gen
   let input = "- " <> text_1 <> "\n- " <> text_2
@@ -175,31 +197,31 @@ unordered_list = property $ do
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [List (L {list_type = Unordered, items = [LI {content = [Text text_1], child = Nothing}, LI {content = [Text text_2], child = Nothing}]})]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [List (L {list_type = Unordered {}, items = [LI {content = [Transparent [Text text_1]]}, LI {content = [Transparent [Text text_2]]}]}) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 header_after_unordered_list :: Property
-header_after_unordered_list = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+header_after_unordered_list = monadicIO $ do
+  let text_gen = pick $ textOf alpha 1 10
   bullet_text <- text_gen
   header_text <- text_gen
-  header_level <- forAll $ Gen.int (Range.linear 1 6)
+  header_level <- pick $ linear 1 6
 
   let input = "- " <> bullet_text <> "\n\n" <> (T.pack $ take header_level $ repeat '#') <> header_text
 
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [List (L {list_type = Unordered, items = [LI {content = [Text bullet_text], child = Nothing}]}), Heading (H {level = header_level, text = [Text header_text]})]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [List (L {list_type = Unordered {}, items = [LI {content = [Transparent [Text bullet_text]]}]}) _, Heading (H {level = header_level, text = [Text header_text]}) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 ordered_list :: Property
-ordered_list = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+ordered_list = monadicIO $ do
+  let text_gen = pick $ textOf alpha 1 10
   item_1 <- text_gen
   item_2 <- text_gen
   item_3 <- text_gen
@@ -208,14 +230,14 @@ ordered_list = property $ do
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [List (L {list_type = Ordered, items = [LI {content = [Text item_1], child = Nothing}, LI {content = [Text item_2], child = Nothing}, LI {content = [Text item_3], child = Nothing}]})]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [List (L {list_type = Ordered {}, items = [LI {content = [Transparent [Text item_1]]}, LI {content = [Transparent [Text item_2]]}, LI {content = [Transparent [Text item_3]]}]}) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 multiple_ordered_lists :: Property
-multiple_ordered_lists = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+multiple_ordered_lists = monadicIO $ do
+  let text_gen = pick $ textOf alpha 1 10
   item_1 <- text_gen
   item_2 <- text_gen
   item_3 <- text_gen
@@ -223,47 +245,47 @@ multiple_ordered_lists = property $ do
 
   parsed <- generic_parse input
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
+    Nothing -> failWith "Hit Timeout"
     ( Just
         ( Right
             ( Doc
-                [ List (L {list_type = Ordered, items = [LI {content = [Text item_1], child = Nothing}]}),
-                  List (L {list_type = Ordered, items = [LI {content = [Text item_2], child = Nothing}]}),
-                  List (L {list_type = Ordered, items = [LI {content = [Text item_3], child = Nothing}]})
+                [ List (L {list_type = Ordered {}, items = [LI {content = [Transparent [Text item_1]]}]}) _,
+                  List (L {list_type = Ordered {}, items = [LI {content = [Transparent [Text item_2]]}]}) _,
+                  List (L {list_type = Ordered {}, items = [LI {content = [Transparent [Text item_3]]}]}) _
                   ]
               )
           )
-      ) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+      ) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 simple_nested_ordered_list :: Property
-simple_nested_ordered_list = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+simple_nested_ordered_list = monadicIO $ do
+  let text_gen = pick $ textOf alpha 1 10
   item_1 <- text_gen
   item_2 <- text_gen
   let input = "1) " <> item_1 <> "\n    1) " <> item_2
 
   parsed <- generic_parse input
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
+    Nothing -> failWith "Hit Timeout"
     ( Just
         ( Right
             ( Doc
-                [ List (L {list_type = Ordered, items = [LI {content = [Text item_1], child = Just (L {list_type = Ordered, items = [LI {content = [Text item_2], child = Nothing}]})}]})
+                [ List (L {list_type = Ordered {}, items = [LI {content = [Transparent [Text item_1], List (L {list_type = Ordered {}, items = [LI {content = [Transparent [Text item_2]]}]}) _]}]}) _
                   ]
               )
           )
-      ) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+      ) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 -- - a
 --      - a
 -- - b
 nested_unordered_list :: Property
-nested_unordered_list = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+nested_unordered_list = monadicIO $ do
+  let text_gen = pick $ textOf alpha 1 10
   item_1 <- text_gen
   item_2 <- text_gen
   item_3 <- text_gen
@@ -271,27 +293,27 @@ nested_unordered_list = property $ do
 
   parsed <- generic_parse input
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
+    Nothing -> failWith "Hit Timeout"
     ( Just
         ( Right
             ( Doc
-                [ List (L {list_type = Unordered, items = [LI {content = [Text item_1], child = Just (L {list_type = Unordered, items = [LI {content = [Text item_2], child = Nothing}]})}, LI {content = [Text item_3], child = Nothing}]})
+                [ List (L {list_type = Unordered {}, items = [LI {content = [Transparent [Text item_1], List (L {list_type = Unordered {}, items = [LI {content = [Transparent [Text item_2]]}]}) _]}, LI {content = [Transparent [Text item_3]]}]}) _
                   ]
               )
           )
-      ) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+      ) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 -- ##
 -- 1)
 -- 2)
 -- 3)
 header_then_ordered_list :: Property
-header_then_ordered_list = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alpha
+header_then_ordered_list = monadicIO $ do
+  let text_gen = pick $ textOf alpha 1 10
   header <- text_gen
-  header_level <- forAll $ Gen.int (Range.linear 1 6)
+  header_level <- pick $ linear 1 6
   item_1 <- text_gen
   item_2 <- text_gen
   item_3 <- text_gen
@@ -300,31 +322,32 @@ header_then_ordered_list = property $ do
   parsed <- generic_parse input
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
+    Nothing -> failWith "Hit Timeout"
     ( Just
         ( Right
             ( Doc
-                [ Heading (H {level = header_level, text = header}),
+                [ Heading (H {level = header_level, text = header}) _,
                   List
                     ( L
-                        { list_type = Ordered,
+                        { list_type = Ordered {},
                           items =
-                            [ LI {content = [Text item_1], child = Nothing},
-                              LI {content = [Text item_2], child = Nothing},
-                              LI {content = [Text item_3], child = Nothing}
+                            [ LI {content = [Transparent [Text item_1]]},
+                              LI {content = [Transparent [Text item_2]]},
+                              LI {content = [Transparent [Text item_3]]}
                               ]
                         }
                       )
+                    _
                   ]
               )
           )
-      ) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+      ) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e
 
 greedy_plain_text :: Property
-greedy_plain_text = property $ do
-  let text_gen = forAll $ Gen.text (Range.linear 1 10) Gen.alphaNum
+greedy_plain_text = monadicIO $ do
+  let text_gen = pick $ textOf alphaNum 1 10
   pretext <- text_gen
   shown <- text_gen
   link <- text_gen
@@ -332,7 +355,7 @@ greedy_plain_text = property $ do
   parsed <- generic_parse $ T.concat [pretext, "[", shown, "]", "(", link, ")"]
 
   case parsed of
-    Nothing -> fail $ "Hit Timeout"
-    (Just (Right (Doc [Paragraph (P [Text (pretext), Link {linkText = [Text shown], url = link, title = Nothing}])]))) -> success
-    (Just (Right tree)) -> fail $ "Incorrect syntax tree: " <> show tree
-    (Just (Left e)) -> fail $ errorBundlePretty e
+    Nothing -> failWith "Hit Timeout"
+    (Just (Right (Doc [Paragraph (P [Text (pretext), Link {linkText = [Text shown], url = link, title = Nothing}]) _]))) -> succeed
+    (Just (Right tree)) -> failWith $ "Incorrect syntax tree: " <> show tree
+    (Just (Left e)) -> failWith $ errorBundlePretty e