diff --git a/Earley.cabal b/Earley.cabal
--- a/Earley.cabal
+++ b/Earley.cabal
@@ -1,5 +1,5 @@
 name:                Earley
-version:             0.8.0
+version:             0.8.1
 synopsis:            Parsing all context-free grammars using Earley's algorithm.
 description:         See <https://www.github.com/ollef/Earley> for more
                      information and
@@ -14,6 +14,10 @@
 build-type:          Simple
 cabal-version:       >=1.10
 
+Flag Examples
+  Description: "Build examples"
+  Default:     False
+
 source-repository    head
   type:     git
   location: https://github.com/ollef/Earley.git
@@ -25,3 +29,77 @@
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:         -Wall -funbox-strict-fields
+
+executable earley-english
+  if !flag(examples)
+    buildable:         False
+  main-is:             English.hs
+  ghc-options:         -Wall
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  build-depends:       base, Earley, unordered-containers >=0.2
+
+executable earley-expr
+  if !flag(examples)
+    buildable:         False
+  main-is:             Expr.hs
+  ghc-options:         -Wall
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  build-depends:       base, Earley
+
+executable earley-expr2
+  if !flag(examples)
+    buildable:         False
+  main-is:             Expr2.hs
+  ghc-options:         -Wall
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  build-depends:       base, Earley
+
+executable earley-mixfix
+  if !flag(examples)
+    buildable:         False
+  main-is:             Mixfix.hs
+  ghc-options:         -Wall
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  build-depends:       base, Earley, containers
+
+executable earley-very-ambiguous
+  if !flag(examples)
+    buildable:         False
+  main-is:             VeryAmbiguous.hs
+  ghc-options:         -Wall
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  build-depends:       base, Earley
+
+executable earley-words
+  if !flag(examples)
+    buildable:         False
+  main-is:             Words.hs
+  ghc-options:         -Wall
+  hs-source-dirs:      examples
+  default-language:    Haskell2010
+  build-depends:       base, Earley
+
+benchmark bench
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      . bench
+  main-is:             BenchAll.hs
+  build-depends:       base, deepseq, criterion >=1.1, parsec >=3.1, ListLike
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+                       -O2
+                       -fmax-simplifier-iterations=10
+                       -fdicts-cheap
+                       -fspec-constr-count=6
+
+test-suite tests
+  type:                exitcode-stdio-1.0
+  main-is:             Tests.hs
+  ghc-options:         -Wall
+  hs-source-dirs:      tests
+  default-language:    Haskell2010
+  build-depends:       base, Earley, tasty >=0.10, tasty-quickcheck >=0.8, tasty-hunit >= 0.9
diff --git a/Text/Earley/Parser.hs b/Text/Earley/Parser.hs
--- a/Text/Earley/Parser.hs
+++ b/Text/Earley/Parser.hs
@@ -12,10 +12,10 @@
 import Control.Arrow
 import Control.Monad
 import Control.Monad.Fix
-import Control.Monad.ST.Lazy
+import Control.Monad.ST
 import Data.ListLike(ListLike)
 import qualified Data.ListLike as ListLike
-import Data.STRef.Lazy
+import Data.STRef
 import Text.Earley.Grammar
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid
@@ -169,7 +169,7 @@
                       -- position.
   , unconsumed :: i   -- ^ The part of the input string that was not consumed,
                       -- which may be empty.
-  } deriving Show
+  } deriving (Eq, Ord, Read, Show)
 
 -- | The result of a parse.
 data Result s e i a
@@ -184,17 +184,17 @@
     -- continuation.
   deriving Functor
 
-{-# INLINE uncons #-}
-uncons :: ListLike i t => i -> Maybe (t, i)
-uncons i
-  | ListLike.null i = Nothing
-  | otherwise       = Just (ListLike.head i, ListLike.tail i)
+{-# INLINE safeHead #-}
+safeHead :: ListLike i t => i -> Maybe t
+safeHead ts
+  | ListLike.null ts = Nothing
+  | otherwise        = Just $ ListLike.head ts
 
 {-# INLINE safeTail #-}
 safeTail :: ListLike i t => i -> i
-safeTail ts'
-  | ListLike.null ts' = ts'
-  | otherwise         = ListLike.tail ts'
+safeTail ts
+  | ListLike.null ts = ts
+  | otherwise        = ListLike.tail ts
 
 {-# SPECIALISE parse :: [State s a e t a]
                      -> [ST s [a]]
@@ -214,23 +214,23 @@
       -> Pos               -- ^ The current position in the input string
       -> i                 -- ^ The input string
       -> ST s (Result s e i a)
-parse [] [] [] !reset names !pos !ts = do
+parse [] [] [] reset names !pos ts = do
   reset
   return $ Ended Report {position = pos, expected = names, unconsumed = ts}
-parse [] [] !next !reset _ !pos !ts = do
+parse [] [] next reset _ !pos ts = do
   reset
   parse next [] [] (return ()) [] (pos + 1) $ safeTail ts
-parse [] !results !next !reset names !pos !ts = do
+parse [] results next reset names !pos ts = do
   reset
   return $ Parsed (concat <$> sequence results) pos ts
          $ parse [] [] next (return ()) names pos ts
-parse (st:ss) !results !next !reset names !pos !ts = case st of
+parse (st:ss) results next reset names !pos ts = case st of
   Final f args -> parse ss (args f : results) next reset names pos ts
   State spos pr args scont -> case pr of
-    Terminal f p -> case uncons ts of
-      Just (t, _) | f t ->
+    Terminal f p -> case safeHead ts of
+      Just t | f t ->
         parse ss results (State spos p (pureArg t args) scont : next) reset names pos ts
-      _                 -> parse ss results next reset names pos ts
+      _            -> parse ss results next reset names pos ts
     NonTerminal r p -> do
       rkref <- readSTRef $ ruleConts r
       ks    <- readSTRef rkref
@@ -270,17 +270,19 @@
            | otherwise -> parse ss results next reset names pos ts
     Alts as (Pure f) -> do
       let args' = funArg f `composeArgs` args
-          sts   = [State pos a args' scont | a <- as]
+          sts   = [State spos a args' scont | a <- as]
       parse (sts ++ ss) results next reset names pos ts
     Alts as p -> do
       scont' <- newConts =<< newSTRef [Cont spos noArgs p args scont]
-      let sts = [State pos a noArgs scont' | a <- as]
+      -- State is (-1) so that nullable alts are expanded correctly
+      let sts = [State (-1) a noArgs scont' | a <- as]
       parse (sts ++ ss) results next reset names pos ts
     Many p q    -> do
-      scont' <- newConts =<< newSTRef [Cont spos noArgs (Many p ((\f as a -> f (a : as)) <$> q)) args scont]
-      let st' = State pos p noArgs scont'
-          nst = State spos q (pureArg [] args) scont
-      parse (st' : nst : ss) results next reset names pos ts
+      c  <- newSTRef =<< newSTRef mempty
+      nr <- newSTRef Nothing
+      let r   = Rule (pure [] <|> (:) <$> p <*> NonTerminal r (Pure id)) nr c
+          st' = State spos (NonTerminal r q) args scont
+      parse (st' : ss) results next reset names pos ts
     Named pr' n -> parse (State spos pr' args scont : ss) results next reset (n : names) pos ts
 
 {-# INLINE parser #-}
@@ -301,7 +303,7 @@
   where
     go :: Result s e i a -> ST s ([(a, Int)], Report e i)
     go r = case r of
-      Ended rep         -> return ([], rep)
+      Ended rep          -> return ([], rep)
       Parsed mas pos _ k -> do
         as <- mas
         fmap (first (zip as (repeat pos) ++)) $ go =<< k
diff --git a/bench/BenchAll.hs b/bench/BenchAll.hs
new file mode 100644
--- /dev/null
+++ b/bench/BenchAll.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE RecursiveDo, FlexibleContexts #-}
+module Main where
+
+import Control.Applicative
+import Control.Exception
+import Control.DeepSeq
+import Criterion.Main
+import Data.Char
+import Data.Maybe
+import Text.Earley
+import qualified Text.Parsec as Parsec
+import qualified Text.Parsec.Pos as Parsec
+
+data Expr
+  = Add Expr Expr
+  | Mul Expr Expr
+  | Var String
+  deriving (Eq, Ord, Show)
+
+instance NFData Expr where
+  rnf (Add a b) = rnf a `seq` rnf b
+  rnf (Mul a b) = rnf a `seq` rnf b
+  rnf (Var s)   = rnf s
+
+type Token = String
+
+tokenParens :: Bool -> [Token] -> [Token]
+tokenParens True s  = ["("] ++ s ++ [")"]
+tokenParens False s = s
+
+tokenExpr :: Int -> Expr -> [Token]
+tokenExpr _ (Var s) = [s]
+tokenExpr d (Add a b) = tokenParens (d > 0) $ tokenExpr 0 a ++ ["+"] ++ tokenExpr 1 b
+tokenExpr d (Mul a b) = tokenParens (d > 1) $ tokenExpr 1 a ++ ["*"] ++ tokenExpr 2 b
+
+linearSum :: Int -> Expr
+linearSum 1 = Var "x"
+linearSum n = Add (linearSum $ n - 1) (Var "x")
+
+treeSum :: Int -> Expr
+treeSum 1 = Var "x"
+treeSum n = let a = n `div` 2 -- will be at least 1
+                b = n - a
+            in Add (treeSum a) (treeSum b)
+
+-- Earley parser
+
+expr :: Grammar r String (Prod r String Token Expr)
+expr = mdo
+  x1 <- rule $ Add <$> x1 <* namedSymbol "+" <*> x2
+            <|> x2
+            <?> "sum"
+  x2 <- rule $ Mul <$> x2 <* namedSymbol "*" <*> x3
+            <|> x3
+            <?> "product"
+  x3 <- rule $ Var <$> (satisfy isIdent <?> "identifier")
+            <|> namedSymbol "(" *> x1 <* namedSymbol ")"
+  return x1
+
+isIdent :: String -> Bool
+isIdent (x:_) = isAlpha x
+isIdent _     = False
+
+sepBy1 :: Prod r e t a -> Prod r e t op -> Grammar r e (Prod r e t [a])
+sepBy1 p op = mdo
+  ops <- rule $ pure [] <|> (:) <$ op <*> p <*> ops
+  rule $ (:) <$> p <*> ops
+
+expr' :: Grammar r String (Prod r String Token Expr)
+expr' = mdo
+  let var = Var <$> satisfy isIdent <|> symbol "(" *> mul <* symbol ")"
+  mul <- fmap (foldl1 Mul) <$> add `sepBy1` symbol "*"
+  add <- fmap (foldl1 Add) <$> var `sepBy1` symbol "+"
+  return mul
+
+parseEarley :: [Token] -> Maybe Expr
+parseEarley input = listToMaybe (fst (fullParses (parser expr input)))
+
+parseEarley' :: [Token] -> Maybe Expr
+parseEarley' input = listToMaybe (fst (fullParses (parser expr' input)))
+
+-- Parsec parsec
+
+type Parsec = Parsec.Parsec [Token] ()
+
+parsecExpr :: Parsec Expr
+parsecExpr = mul
+  where mul   = foldl1 Mul <$> add `Parsec.sepBy1` t "*"
+        add   = foldl1 Add <$> var `Parsec.sepBy1` t "+"
+        ident = Parsec.token id pos $ \y -> if isIdent y then Just (Var y) else Nothing
+        var   = ident <|> (t "(" *> mul <* t ")")
+        t x   = Parsec.token id pos $ \y -> if x == y then Just x else Nothing
+        pos   = const (Parsec.initialPos "")
+
+parseParsec :: [Token] -> Maybe Expr
+parseParsec =  either (const Nothing) Just . Parsec.parse parsecExpr ""
+
+-- Our benchmark harness.
+
+linearInput :: Int -> (String, [Token])
+linearInput size = (show size, tokenExpr 0 $ linearSum size)
+
+treeInput :: Int -> (String, [Token])
+treeInput size = (show size, tokenExpr 0 $ treeSum size)
+
+inputBench :: (String, [Token]) -> Benchmark
+inputBench (name, input) = bench name $ nf id input
+
+earleyBench :: (String, [Token]) -> Benchmark
+earleyBench (name, input) = bench name $ nf parseEarley input
+
+earley'Bench :: (String, [Token]) -> Benchmark
+earley'Bench (name, input) = bench name $ nf parseEarley' input
+
+parsecBench :: (String, [Token]) -> Benchmark
+parsecBench (name, input) = bench name $ nf parseParsec input
+
+benchSizes :: [Int]
+benchSizes = [100, 200] -- [51, 101, 151, 201]
+
+linearInputs :: [(String, [Token])]
+linearInputs = map linearInput benchSizes
+
+treeInputs :: [(String, [Token])]
+treeInputs = map treeInput benchSizes
+
+main :: IO ()
+main = do
+  evaluate (rnf linearInputs)
+  evaluate (rnf treeInputs)
+  defaultMain
+    [ -- bgroup "inputs" $ map inputBench linearInputs 
+      bgroup "earley" $ map earleyBench linearInputs
+    , bgroup "earley'" $ map earley'Bench linearInputs
+    , bgroup "parsec" $ map parsecBench linearInputs
+    -- , bgroup "inputsTree" $ map inputBench treeInputs
+    , bgroup "earleyTree" $ map earleyBench treeInputs
+    , bgroup "earley'Tree" $ map earley'Bench treeInputs
+    , bgroup "parsecTree" $ map parsecBench treeInputs
+    ]
+
diff --git a/examples/English.hs b/examples/English.hs
new file mode 100644
--- /dev/null
+++ b/examples/English.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE RecursiveDo #-}
+import Control.Applicative
+import Text.Earley
+import qualified Data.HashSet as HS
+
+type Noun      = String
+type Verb      = String
+type Adjective = String
+
+nouns, verbs, adjectives :: HS.HashSet String
+nouns      = HS.fromList ["parsers", "sentences", "grammars"]
+verbs      = HS.fromList ["parse", "munch", "annihilate", "confuse", "use"]
+adjectives = HS.fromList ["many", "great", "long", "confusing"]
+
+
+data Sentence = Sentence NounPhrase VerbPhrase
+  deriving Show
+data NounPhrase = NounPhrase Adjective NounPhrase
+                | Noun Noun
+  deriving Show
+data VerbPhrase = VerbPhrase Verb NounPhrase
+                | Verb Verb
+  deriving Show
+
+sentence :: Grammar r String (Prod r String String Sentence)
+sentence = mdo
+  noun       <- rule $ satisfy (`HS.member` nouns)      <?> "noun"
+  verb       <- rule $ satisfy (`HS.member` verbs)      <?> "verb"
+  adjective  <- rule $ satisfy (`HS.member` adjectives) <?> "adjective"
+  nounPhrase <- rule $  NounPhrase <$> adjective <*> nounPhrase
+                    <|> Noun <$> noun
+                    <?> "noun phrase"
+  verbPhrase <- rule $  VerbPhrase <$> verb <*> nounPhrase
+                    <|> Verb <$> verb
+                    <?> "verb phrase"
+  return $ Sentence <$> nounPhrase <*> verbPhrase <?> "sentence"
+
+main :: IO ()
+main = do
+  let p = parser sentence . words
+  print $ fullParses $ p "parsers use grammars"
+  print $ fullParses $ p "parsers munch long sentences"
+  print $ fullParses $ p "many great sentences confuse parsers"
+  print $ fullParses $ p "parsers use use"
+  print $ fullParses $ p "grammars many great confusing"
diff --git a/examples/Expr.hs b/examples/Expr.hs
new file mode 100644
--- /dev/null
+++ b/examples/Expr.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE RecursiveDo #-}
+import Control.Applicative
+import Data.Char
+import System.Environment
+import Text.Earley
+
+data Expr
+  = Add Expr Expr
+  | Mul Expr Expr
+  | Var String
+  deriving (Eq, Ord, Show)
+
+expr :: Grammar r String (Prod r String String Expr)
+expr = mdo
+  x1 <- rule $ Add <$> x1 <* namedSymbol "+" <*> x2
+            <|> x2
+            <?> "sum"
+  x2 <- rule $ Mul <$> x2 <* namedSymbol "*" <*> x3
+            <|> x3
+            <?> "product"
+  x3 <- rule $ Var <$> (satisfy ident <?> "identifier")
+            <|> namedSymbol "(" *> x1 <* namedSymbol ")"
+  return x1
+  where
+    ident (x:_) = isAlpha x
+    ident _     = False
+
+main :: IO ()
+main = do
+  x:_ <- getArgs
+  print $ fullParses $ parser expr $ words x
diff --git a/examples/Expr2.hs b/examples/Expr2.hs
new file mode 100644
--- /dev/null
+++ b/examples/Expr2.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE ScopedTypeVariables, RecursiveDo #-}
+import Data.Char
+import System.Environment
+import Control.Applicative
+import Text.Earley
+
+data Expr
+  = Expr :+: Expr
+  | Expr :*: Expr
+  | Var String
+  | Lit Int
+  deriving (Show)
+
+grammar :: forall r. Grammar r String (Prod r String Char Expr)
+grammar = mdo
+
+  whitespace <- rule $ many $ satisfy isSpace
+
+  let token :: Prod r String Char a -> Prod r String Char a
+      token p = whitespace *> p
+
+      sym x   = token $ symbol x <?> [x]
+
+      ident   = token $ (:) <$> satisfy isAlpha <*> many (satisfy isAlphaNum) <?> "identifier"
+      num     = token $ some (satisfy isDigit) <?> "number"
+
+  expr0 <- rule
+     $ (Lit . read)  <$> num
+    <|> Var  <$> ident
+    <|> sym '(' *> expr2 <* sym ')'
+
+  expr1 <- rule
+    $ (:*:) <$> expr1 <* sym '*' <*> expr0
+   <|> expr0
+
+  expr2 <- rule
+    $ (:+:) <$> expr2 <* sym '+' <*> expr1
+   <|> expr1
+
+  return $ expr2 <* whitespace
+
+main :: IO ()
+main = do
+  x:_ <- getArgs
+  print $ fullParses $ parser grammar x
diff --git a/examples/Mixfix.hs b/examples/Mixfix.hs
new file mode 100644
--- /dev/null
+++ b/examples/Mixfix.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE RecursiveDo #-}
+import Control.Applicative
+import Control.Arrow(first)
+import Data.Foldable(asum, foldrM)
+import System.Environment
+import Text.Earley
+import qualified Data.Set as S
+
+type Ident = String
+
+data IdentPart = Ident Ident | Hole
+  deriving Show
+
+type HoleyIdent = [IdentPart]
+
+holey :: Ident -> HoleyIdent
+holey ""       = []
+holey ('_':xs) = Hole    : holey xs
+holey xs       = Ident i : holey rest
+  where (i, rest) = span (/= '_') xs 
+
+data Assoc = LeftAssoc | RightAssoc | NonAssoc
+  deriving (Eq, Show)
+
+data Expr = V HoleyIdent | App Expr [Expr]
+  deriving Show
+
+grammar :: [[(HoleyIdent, Assoc)]] -> Grammar r String (Prod r String String Expr)
+grammar table = mdo
+  let ident = (V . (:[]) . Ident) <$> satisfy (`S.notMember` mixfixParts)
+  expr  <- foldrM ($) ident (normalApp expr : levels expr)
+  return expr
+  where
+    mixfixParts = S.fromList [s | xs <- table, (ys, _) <- xs, Ident s <- ys]
+    normalApp expr next = rule $ App <$> expr <*> some next
+                              <|> next
+    levels expr = map (level expr) table
+    level expr idents next = mdo
+      same <- rule $ asum $ next : map (mixfixIdent same) idents
+      return same
+      where
+        mixfixIdent same (ps, a) = App (V ps) <$> go ps
+          where
+            go ps' = case ps' of
+              [Ident s]         -> []    <$  namedSymbol s
+              Hole:rest         -> (:)   <$> (if a == RightAssoc then next else same) <*> go rest
+              [Ident s, Hole]   -> (:[]) <$  namedSymbol s <*> (if a == LeftAssoc then next else same)
+              Ident s:Hole:rest -> (:)   <$  namedSymbol s <*> expr <*> go rest
+              _                 -> error "invalid identifier"
+
+identTable :: [[(HoleyIdent, Assoc)]]
+identTable = (map . map) (first holey)
+  [ [("_->_",          RightAssoc)]
+  , [("_,_",           NonAssoc)]
+  , [("if_then_else_", RightAssoc)]
+  , [("_|-_:_",        NonAssoc)]
+  , [("_+_",           LeftAssoc)]
+  , [("_*_",           LeftAssoc)]
+  , [("(_)",           NonAssoc)
+    ,("[_]",           NonAssoc)
+    ,("<_>",           NonAssoc)
+    ]
+  ]
+
+pretty :: Expr -> String
+pretty (V ps) = concatMap go ps
+  where
+    go Hole      = "_"
+    go (Ident s) = s
+pretty (App e es) = "(" ++ pretty e ++ " " ++ unwords (map pretty es) ++ ")"
+
+tokenize :: String -> [Ident]
+tokenize ""        = []
+tokenize (' ':xs)  = tokenize xs
+tokenize ('\n':xs) = tokenize xs
+tokenize (x:xs)
+  | x `S.member` special = [x] : tokenize xs
+  | otherwise            = (x:as) : tokenize bs
+  where
+    (as, bs) = span (`S.notMember` special) xs
+    special = S.fromList "()[], \n"
+
+main :: IO ()
+main = do
+  x:_ <- getArgs
+  print $ first (map pretty) $ fullParses $ parser (grammar identTable) (tokenize x)
diff --git a/examples/VeryAmbiguous.hs b/examples/VeryAmbiguous.hs
new file mode 100644
--- /dev/null
+++ b/examples/VeryAmbiguous.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE RecursiveDo #-}
+import Control.Applicative
+import System.Environment
+import Text.Earley
+
+g :: Grammar r Char (Prod r Char Char ())
+g = mdo
+  s <- rule $ () <$ symbol 'b'
+           <|> () <$ s <* s
+           <|> () <$ s <* s <* s
+           <?> 's'
+  return s
+
+main :: IO ()
+main = do
+  xs:_ <- getArgs
+  print $ report $ parser g xs
diff --git a/examples/Words.hs b/examples/Words.hs
new file mode 100644
--- /dev/null
+++ b/examples/Words.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE RecursiveDo #-}
+import Data.Char
+import Control.Applicative
+import System.Environment
+
+import Text.Earley
+
+grammar :: Grammar r String (Prod r String Char [String])
+grammar = mdo
+  whitespace  <- rule $ () <$ many (satisfy isSpace)
+  whitespace1 <- rule $ () <$ satisfy isSpace <* whitespace <?> "whitespace"
+
+  ident <- rule 
+    $ (:) <$> satisfy isAlpha <*> many (satisfy isAlphaNum)
+   <?> "identifier"
+
+  expr <- rule
+    $  (:)   <$> ident <* whitespace1 <*> expr
+   <|> (:[]) <$> ident <* whitespace
+
+  return expr
+
+main :: IO ()
+main = do
+  x:_ <- getArgs
+  print $ fullParses $ parser grammar x
diff --git a/tests/Tests.hs b/tests/Tests.hs
new file mode 100644
--- /dev/null
+++ b/tests/Tests.hs
@@ -0,0 +1,187 @@
+{-# LANGUAGE RecursiveDo, ScopedTypeVariables #-}
+import Test.Tasty
+import Test.Tasty.QuickCheck as QC
+import Test.Tasty.HUnit      as HU
+
+import Data.Char
+import Control.Applicative
+import Text.Earley
+
+main :: IO ()
+main = defaultMain tests -- -putStrLn . prettyExpr 0 $ Add (Add (Var "a") (Var "b")) (Add (Var "c") (Var "d")) -- defaultMain tests
+
+tests :: TestTree
+tests = testGroup "Tests" [qcProps, unitTests]
+
+qcProps :: TestTree
+qcProps = testGroup "QuickCheck Properties"
+  [ QC.testProperty "Expr: parse . pretty = id" $
+    \e -> [e] === parseExpr (prettyExpr 0 e)
+  , QC.testProperty "Ambiguous Expr: parse . pretty ≈ id" $
+    \e -> e `elem` parseAmbiguousExpr (prettyExpr 0 e)
+  , QC.testProperty "The empty parser doesn't parse anything" $
+    \(input :: String) ->
+      allParses (parser (return empty :: forall r. Grammar r () (Prod r () Char ())) input)
+      == (,) [] Report { position   = 0
+                       , expected   = []
+                       , unconsumed = input
+                       }
+  , QC.testProperty "Many empty parsers parse very little" $
+    \(input :: String) ->
+      allParses (parser (return $ many empty <* pure "blah" :: forall r. Grammar r () (Prod r () Char [()])) input)
+      == (,) [([], 0)] Report { position   = 0
+                              , expected   = []
+                              , unconsumed = input
+                              }
+  ]
+
+unitTests :: TestTree
+unitTests = testGroup "Unit Tests"
+  [ HU.testCase "VeryAmbiguous gives the right number of results" $
+      length (fst $ fullParses $ parser veryAmbiguous $ replicate 8 'b') @?= 2871
+  , HU.testCase "VeryAmbiguous gives the correct report" $
+      report (parser veryAmbiguous $ replicate 3 'b') @?=
+      Report {position = 3, expected = "s", unconsumed = ""}
+  , HU.testCase "Inline alternatives work" $
+      let input = "ababbbaaabaa" in
+      allParses (parser inlineAlts input) @?= allParses (parser nonInlineAlts input)
+  , HU.testCase "Some reversed words" $
+      let input = "wordwordstop"
+          l     = length input in
+      allParses (parser someWords input)
+      @?= (,) [(["stop", "drow", "drow"], l)] Report { position   = l
+                                                     , expected   = []
+                                                     , unconsumed = []
+                                                     }
+  , HU.testCase "Optional Nothing" $
+      fullParses (parser (return optional_) "b")
+      @?= (,) [(Nothing, 'b')] Report {position = 1, expected = "", unconsumed = ""}
+  , HU.testCase "Optional Just" $
+      fullParses (parser (return optional_) "ab")
+      @?= (,) [(Just 'a', 'b')] Report {position = 2, expected = "", unconsumed = ""}
+  , HU.testCase "Optional using rules Nothing" $
+      fullParses (parser optionalRule "b")
+      @?= (,) [(Nothing, 'b')] Report {position = 1, expected = "", unconsumed = ""}
+  , HU.testCase "Optional using rules Just" $
+      fullParses (parser optionalRule "ab")
+      @?= (,) [(Just 'a', 'b')] Report {position = 2, expected = "", unconsumed = ""}
+  , HU.testCase "Optional without continuation Nothing" $
+      fullParses (parser (return $ optional $ namedSymbol 'a') "")
+      @?= (,) [Nothing] Report {position = 0, expected = "a", unconsumed = ""}
+  , HU.testCase "Optional without continuation Just" $
+      fullParses (parser (return $ optional $ namedSymbol 'a') "a")
+      @?= (,) [Just 'a'] Report {position = 1, expected = "", unconsumed = ""}
+  , HU.testCase "Optional using rules without continuation Nothing" $
+      fullParses (parser (rule $ optional $ namedSymbol 'a') "")
+      @?= (,) [Nothing] Report {position = 0, expected = "a", unconsumed = ""}
+  , HU.testCase "Optional using rules without continuation Just" $
+      fullParses (parser (rule $ optional $ namedSymbol 'a') "a")
+      @?= (,) [Just 'a'] Report {position = 1, expected = "", unconsumed = ""}
+  ]
+
+optional_ :: Prod r Char Char (Maybe Char, Char)
+optional_ = (,) <$> optional (namedSymbol 'a') <*> namedSymbol 'b'
+
+optionalRule :: Grammar r Char (Prod r Char Char (Maybe Char, Char))
+optionalRule = mdo
+  test <- rule $ (,) <$> optional (namedSymbol 'a') <*> namedSymbol 'b'
+  return test
+
+inlineAlts :: Grammar r Char (Prod r Char Char String)
+inlineAlts = mdo
+  p <- rule $ pure []
+           <|> (:) <$> (namedSymbol 'a' <|> namedSymbol 'b') <*> p
+  return p
+
+nonInlineAlts :: Grammar r Char (Prod r Char Char String)
+nonInlineAlts = mdo
+  ab <- rule $ namedSymbol 'a' <|> namedSymbol 'b'
+  p  <- rule $ pure [] <|> (:) <$> ab <*> p
+  return p
+
+someWords :: Grammar r () (Prod r () Char [String])
+someWords = return $ flip (:) <$> (map reverse <$> some (word "word")) <*> word "stop"
+
+veryAmbiguous :: Grammar r Char (Prod r Char Char ())
+veryAmbiguous = mdo
+  s <- rule $ () <$ symbol 'b'
+           <|> () <$ s <* s
+           <|> () <$ s <* s <* s
+           <?> 's'
+  return s
+
+parseExpr :: String -> [Expr]
+parseExpr input = fst (fullParses (parser expr (lexExpr input))) -- We need to annotate types for point-free version
+
+parseAmbiguousExpr :: String -> [Expr]
+parseAmbiguousExpr input = fst (fullParses (parser ambiguousExpr (lexExpr input)))
+
+data Expr
+  = Add Expr Expr
+  | Mul Expr Expr
+  | Var String
+  deriving (Eq, Ord, Show)
+
+instance Arbitrary Expr where
+  arbitrary = sized arbExpr
+    where arbIdent           = Var <$> elements ["a", "b", "c", "x", "y", "z"]
+          arbExpr n | n > 0  = oneof [ arbIdent
+                                     , Add <$> arbExpr1 <*> arbExpr1
+                                     , Mul <$> arbExpr1 <*> arbExpr1
+                                     ]
+                                     where arbExpr1 = arbExpr (n `div` 2)
+          arbExpr _          = arbIdent
+
+  shrink (Var _)    = []
+  shrink (Add a b)  = a : b : [ Add a' b | a' <- shrink a ] ++ [ Add a b' | b' <- shrink b ]
+  shrink (Mul a b)  = a : b : [ Mul a' b | a' <- shrink a ] ++ [ Mul a b' | b' <- shrink b ]
+
+expr :: Grammar r String (Prod r String String Expr)
+expr = mdo
+  x1 <- rule $ Add <$> x1 <* namedSymbol "+" <*> x2
+            <|> x2
+            <?> "sum"
+  x2 <- rule $ Mul <$> x2 <* namedSymbol "*" <*> x3
+            <|> x3
+            <?> "product"
+  x3 <- rule $ Var <$> (satisfy ident <?> "identifier")
+            <|> namedSymbol "(" *> x1 <* namedSymbol ")"
+  return x1
+  where
+    ident (x:_) = isAlpha x
+    ident _     = False
+
+ambiguousExpr :: Grammar r String (Prod r String String Expr)
+ambiguousExpr = mdo
+  x1 <- rule $ Add <$> x1 <* namedSymbol "+" <*> x1
+            <|> x2
+            <?> "sum"
+  x2 <- rule $ Mul <$> x2 <* namedSymbol "*" <*> x2
+            <|> x3
+            <?> "product"
+  x3 <- rule $ Var <$> (satisfy ident <?> "identifier")
+            <|> namedSymbol "(" *> x1 <* namedSymbol ")"
+  return x1
+  where
+    ident (x:_) = isAlpha x
+    ident _     = False
+
+prettyParens :: Bool -> String -> String
+prettyParens True s  = "(" ++ s ++ ")"
+prettyParens False s = s
+
+prettyExpr :: Int -> Expr -> String
+prettyExpr _ (Var s) = s
+prettyExpr d (Add a b) = prettyParens (d > 0) $ prettyExpr 0 a ++ " + " ++ prettyExpr 1 b
+prettyExpr d (Mul a b) = prettyParens (d > 1) $ prettyExpr 1 a ++ " * " ++ prettyExpr 2 b
+
+-- @words@ like lexer, but consider parentheses as separate tokens
+lexExpr :: String -> [String]
+lexExpr ""        = []
+lexExpr ('(' : s) = "(" : lexExpr s
+lexExpr (')' : s) = ")" : lexExpr s
+lexExpr (c : s)
+  | isSpace c     = lexExpr s
+  | otherwise     = let (tok, rest) = span p (c : s)
+                    in tok : lexExpr rest
+  where p x       = not (x == '(' || x == ')' || isSpace x)