diff --git a/Text/HTML/Parser.hs b/Text/HTML/Parser.hs
--- a/Text/HTML/Parser.hs
+++ b/Text/HTML/Parser.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 
 -- | This is a performance-oriented HTML tokenizer aim at web-crawling
 -- applications. It follows the HTML5 parsing specification quite closely,
@@ -14,6 +15,12 @@
     , Token(..)
     , TagName, AttrName, AttrValue
     , Attr(..)
+      -- * Rendering, text canonicalization
+    , renderTokens
+    , renderToken
+    , renderAttrs
+    , renderAttr
+    , canonicalizeTokens
     ) where
 
 import Data.Char hiding (isSpace)
@@ -33,6 +40,8 @@
 import qualified Data.Text.Lazy.Builder as B
 import Prelude hiding (take, takeWhile)
 
+-- Section numbers refer to W3C HTML 5.2 specification.
+
 -- | A tag name (e.g. @body@)
 type TagName   = Text
 
@@ -46,6 +55,8 @@
 data Token
   -- | An opening tag. Attribute ordering is arbitrary.
   = TagOpen !TagName [Attr]
+  -- | A self-closing tag.
+  | TagSelfClose !TagName [Attr]
   -- | A closing tag.
   | TagClose !TagName
   -- | The content between tags.
@@ -58,6 +69,10 @@
   | Doctype !Text
   deriving (Show, Ord, Eq, Generic)
 
+-- | This is a bit of a hack
+endOfFileToken :: Token
+endOfFileToken = ContentText ""
+
 -- | An attribute of a tag
 data Attr = Attr !AttrName !AttrValue
           deriving (Show, Eq, Ord)
@@ -78,48 +93,55 @@
       then return $ ContentText content
       else char '<' >> tagOpen
 
--- | /§8.2.4.3/: Tag open state
+-- | /§8.2.4.6/: Tag open state
 tagOpen :: Parser Token
 tagOpen =
         (char '!' >> markupDeclOpen)
     <|> (char '/' >> endTagOpen)
-    <|> (char '?' >> bogusComment)
-    <|> tryStartTag
+    <|> (char '?' >> bogusComment mempty)
+    <|> tagNameOpen
     <|> other
   where
-    tryStartTag = do
-        c <- peekChar'
-        guard $ isAsciiUpper c || isAsciiLower c
-        tagName
-
     other = do
         return $ ContentChar '<'
 
--- | /§8.2.4.9/: End tag open state
--- TODO: This isn't right
+-- | /§8.2.4.7/: End tag open state
 endTagOpen :: Parser Token
-endTagOpen = do
-    name <- takeWhile $ \c -> isAsciiUpper c || isAsciiLower c
-    char '>'
-    return $ TagClose name
+endTagOpen = tagNameClose
 
--- | /§8.2.4.10/: Tag name state
+-- | /§8.2.4.8/: Tag name state: the open case
 --
--- deviation: no lower-casing
-tagName :: Parser Token
-tagName = do
-    tag <- takeWhile $ notInClass "\x09\x0a\x0c />"
+-- deviation: no lower-casing, don't handle NULL characters
+tagNameOpen :: Parser Token
+tagNameOpen = do
+    tag <- tagName'
     id $  (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag [])
       <|> (char '/' >> selfClosingStartTag tag [])
       <|> (char '>' >> return (TagOpen tag []))
 
--- | /§8.2.4.43/: Self-closing start tag state
+-- | /§8.2.4.10/: Tag name state: close case
+tagNameClose :: Parser Token
+tagNameClose = do
+    tag <- tagName'
+    char '>' >> return (TagClose tag)
+
+-- | /§8.2.4.10/: Tag name state: common code
+--
+-- deviation: no lower-casing, don't handle NULL characters
+tagName' :: Parser Text
+tagName' = do
+    c <- peekChar'
+    guard $ isAsciiUpper c || isAsciiLower c
+    takeWhile $ notInClass "\x09\x0a\x0c /<>"
+
+-- | /§8.2.4.40/: Self-closing start tag state
 selfClosingStartTag :: TagName -> [Attr] -> Parser Token
 selfClosingStartTag tag attrs = do
-        (char '>' >> return (TagOpen tag attrs))
+        (char '>' >> return (TagSelfClose tag attrs))
+    <|> (endOfInput >> return endOfFileToken)
     <|> beforeAttrName tag attrs
 
--- | /§8.2.4.34/: Before attribute name state
+-- | /§8.2.4.32/: Before attribute name state
 --
 -- deviation: no lower-casing
 beforeAttrName :: TagName -> [Attr] -> Parser Token
@@ -130,26 +152,29 @@
       -- <|> (char '\x00' >> attrName tag attrs) -- TODO: NULL
       <|> attrName tag attrs
 
--- | /§8.2.4.35/: Attribute name state
+-- | /§8.2.4.33/: Attribute name state
 attrName :: TagName -> [Attr] -> Parser Token
 attrName tag attrs = do
-    name <- takeWhile $ notInClass "\x09\x0a\x0c /=>\x00"
-    id $  (satisfy (inClass "\x09\x0a\x0c ") >> afterAttrName tag attrs name)
-      <|> (char '/' >> selfClosingStartTag tag attrs)
+    name <- takeWhile $ notInClass "\x09\x0a\x0c /=>"
+    id $  (endOfInput >> afterAttrName tag attrs name)
       <|> (char '=' >> beforeAttrValue tag attrs name)
-      <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
+      <|> try (do mc <- peekChar
+                  case mc of
+                    Just c | inClass "\x09\x0a\x0c />" c ->  afterAttrName tag attrs name
+                    _ -> empty)
       -- <|> -- TODO: NULL
 
--- | /§8.2.4.36/: After attribute name state
+-- | /§8.2.4.34/: After attribute name state
 afterAttrName :: TagName -> [Attr] -> AttrName -> Parser Token
 afterAttrName tag attrs name = do
     skipWhile $ inClass "\x09\x0a\x0c "
     id $  (char '/' >> selfClosingStartTag tag attrs)
       <|> (char '=' >> beforeAttrValue tag attrs name)
       <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
+      <|> (endOfInput >> return endOfFileToken)
       <|> attrName tag (Attr name T.empty : attrs)  -- not exactly sure this is right
 
--- | /§8.2.4.37/: Before attribute value state
+-- | /§8.2.4.35/: Before attribute value state
 beforeAttrValue :: TagName -> [Attr] -> AttrName -> Parser Token
 beforeAttrValue tag attrs name = do
     skipWhile $ inClass "\x09\x0a\x0c "
@@ -158,98 +183,141 @@
       <|> (char '>' >> return (TagOpen tag (Attr name T.empty : attrs)))
       <|> attrValueUnquoted tag attrs name
 
--- | /§8.2.4.38/: Attribute value (double-quoted) state
+-- | /§8.2.4.36/: Attribute value (double-quoted) state
 attrValueDQuoted :: TagName -> [Attr] -> AttrName -> Parser Token
 attrValueDQuoted tag attrs name = do
     value <- takeWhile (/= '"')
-    char '"'
+    _ <- char '"'
     afterAttrValueQuoted tag attrs name value
 
--- | /§8.2.4.39/: Attribute value (single-quoted) state
+-- | /§8.2.4.37/: Attribute value (single-quoted) state
 attrValueSQuoted :: TagName -> [Attr] -> AttrName -> Parser Token
 attrValueSQuoted tag attrs name = do
     value <- takeWhile (/= '\'')
-    char '\''
+    _ <- char '\''
     afterAttrValueQuoted tag attrs name value
 
--- | /§8.2.4.40/: Attribute value (unquoted) state
+-- | /§8.2.4.38/: Attribute value (unquoted) state
 attrValueUnquoted :: TagName -> [Attr] -> AttrName -> Parser Token
 attrValueUnquoted tag attrs name = do
     value <- takeTill (inClass "\x09\x0a\x0c >")
     id $  (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs) -- unsure: don't emit?
       <|> (char '>' >> return (TagOpen tag (Attr name value : attrs)))
+      <|> (endOfInput >> return endOfFileToken)
 
--- | /§8.2.4.42/: After attribute value (quoted) state
+-- | /§8.2.4.39/: After attribute value (quoted) state
 afterAttrValueQuoted :: TagName -> [Attr] -> AttrName -> AttrValue -> Parser Token
 afterAttrValueQuoted tag attrs name value =
           (satisfy (inClass "\x09\x0a\x0c ") >> beforeAttrName tag attrs')
       <|> (char '/' >> selfClosingStartTag tag attrs')
       <|> (char '>' >> return (TagOpen tag attrs'))
+      <|> (endOfInput >> return endOfFileToken)
   where attrs' = Attr name value : attrs
 
--- | /§8.2.4.45/: Markup declaration open state
+-- | /§8.2.4.41/: Bogus comment state
+bogusComment :: Builder -> Parser Token
+bogusComment content = do
+        (char '>' >> return (Comment content))
+    <|> (endOfInput >> return (Comment content))
+    <|> (char '\x00' >> bogusComment (content <> "\xfffd"))
+    <|> (anyChar >>= \c -> bogusComment (content <> B.singleton c))
+
+-- | /§8.2.4.42/: Markup declaration open state
 markupDeclOpen :: Parser Token
 markupDeclOpen =
-        try comment
+        try comment_
     <|> try docType
-        -- TODO: Fix the rest
+    <|> bogusComment mempty
   where
-    comment = string "--" >> commentStart
+    comment_ = string "--" >> commentStart
     docType = do
         -- switching this to asciiCI slowed things down by a factor of two
         s <- take 7
         guard $ T.toLower s == "doctype"
         doctype
 
--- | /§8.2.4.46/: Comment start state
+-- | /§8.2.4.43/: Comment start state
 commentStart :: Parser Token
 commentStart = do
           (char '-' >> commentStartDash)
       <|> (char '>' >> return (Comment mempty))
       <|> comment mempty
 
--- | /§8.2.4.47/: Comment start dash state
+-- | /§8.2.4.44/: Comment start dash state
 commentStartDash :: Parser Token
 commentStartDash =
           (char '-' >> commentEnd mempty)
       <|> (char '>' >> return (Comment mempty))
-      <|> (do c <- anyChar
-              comment (B.singleton '-' <> B.singleton c) )
+      <|> (endOfInput >> return (Comment mempty))
+      <|> (comment (B.singleton '-'))
 
--- | /§8.2.4.48/: Comment state
+-- | /§8.2.4.45/: Comment state
 comment :: Builder -> Parser Token
 comment content0 = do
-    content <- B.fromText <$> takeWhile (notInClass "-")
-    id $  (char '-' >> commentEndDash (content0 <> content))
+    content <- B.fromText <$> takeWhile (notInClass "-\x00<")
+    id $  (char '<' >> commentLessThan (content0 <> content <> "<"))
+      <|> (char '-' >> commentEndDash (content0 <> content))
       <|> (char '\x00' >> comment (content0 <> content <> B.singleton '\xfffd'))
+      <|> (endOfInput >> return (Comment $ content0 <> content))
 
--- | /§8.2.4.49/: Comment end dash state
+-- | /§8.2.46/: Comment less-than sign state
+commentLessThan :: Builder -> Parser Token
+commentLessThan content =
+        (char '!' >> commentLessThanBang (content <> "!"))
+    <|> (char '<' >> commentLessThan (content <> "<"))
+    <|> comment content
+
+-- | /§8.2.47/: Comment less-than sign bang state
+commentLessThanBang :: Builder -> Parser Token
+commentLessThanBang content =
+        (char '-' >> commentLessThanBangDash content)
+    <|> comment content
+
+-- | /§8.2.48/: Comment less-than sign bang dash state
+commentLessThanBangDash :: Builder -> Parser Token
+commentLessThanBangDash content =
+        (char '-' >> commentLessThanBangDashDash content)
+    <|> commentEndDash content
+
+-- | /§8.2.49/: Comment less-than sign bang dash dash state
+commentLessThanBangDashDash :: Builder -> Parser Token
+commentLessThanBangDashDash content =
+        (char '>' >> comment content)
+    <|> (endOfInput >> comment content)
+    <|> commentEnd content
+
+-- | /§8.2.4.50/: Comment end dash state
 commentEndDash :: Builder -> Parser Token
 commentEndDash content = do
         (char '-' >> commentEnd content)
-    <|> (char '\x00' >> comment (content <> "-\xfffd"))
-    <|> (anyChar >>= \c -> comment (content <> "-" <> B.singleton c))
+    <|> (endOfInput >> return (Comment content))
+    <|> (comment (content <> "-"))
 
--- | /§8.2.4.50/: Comment end state
+-- | /§8.2.4.51/: Comment end state
 commentEnd :: Builder -> Parser Token
 commentEnd content = do
         (char '>' >> return (Comment content))
-    <|> (char '\x00' >> comment (content <> "-\xfffd"))
-    -- <|> ()  TODO: other cases
-    <|> (anyChar >>= \c -> comment (content <> "-" <> B.singleton c))
+    <|> (char '!' >> commentEndBang content)
+    <|> (char '-' >> commentEnd (content <> "-"))
+    <|> (endOfInput >> return (Comment content))
+    <|> (comment (content <> "--"))
 
--- | /§8.2.4.52/: DOCTYPE state
+-- | /§8.2.4.52/: Comment end bang state
+commentEndBang :: Builder -> Parser Token
+commentEndBang content = do
+        (char '-' >> commentEndDash (content <> "--!"))
+    <|> (char '>' >> return (Comment content))
+    <|> (endOfInput >> return (Comment content))
+    <|> (comment (content <> "--!"))
+
+-- | /§8.2.4.53/: DOCTYPE state
 -- FIXME
 doctype :: Parser Token
 doctype = do
     content <- takeTill (=='>')
-    char '>'
+    _ <- char '>'
     return $ Doctype content
 
--- | /§8.2.4.44/: Bogus comment state
-bogusComment :: Parser Token
-bogusComment = fail "Bogus comment"
-
 -- | Parse a lazy list of tokens from strict 'Text'.
 parseTokens :: Text -> [Token]
 parseTokens = unfoldr f
@@ -277,3 +345,43 @@
         case AL.parse token t of
             AL.Done rest tok -> Just (tok, rest)
             _                -> Nothing
+
+-- | See 'renderToken'.
+renderTokens :: [Token] -> TL.Text
+renderTokens = mconcat . fmap renderToken
+
+-- | (Somewhat) canonical string representation of 'Token'.
+renderToken :: Token -> TL.Text
+renderToken = TL.fromStrict . mconcat . \case
+    (TagOpen n [])         -> ["<", n, ">"]
+    (TagOpen n attrs)      -> ["<", n, " ", renderAttrs attrs, ">"]
+    (TagSelfClose n attrs) -> ["<", n, " ", renderAttrs attrs, " />"]
+    (TagClose n)           -> ["</", n, ">"]
+    (ContentChar c)        -> [T.singleton c]
+    (ContentText t)        -> [t]
+    (Comment builder)      -> ["<!--", TL.toStrict $ B.toLazyText builder, "-->"]
+    (Doctype t)            -> ["<!DOCTYPE", t, ">"]
+
+-- | See 'renderAttr'.
+renderAttrs :: [Attr] -> Text
+renderAttrs = T.unwords . fmap renderAttr . reverse
+
+-- | Does not escape quotation in attribute values!
+renderAttr :: Attr -> Text
+renderAttr (Attr k v) = mconcat [k, "=\"", v, "\""]
+
+-- | Meld neighoring 'ContentChar' and 'ContentText' constructors together and drops empty text
+-- elements.
+canonicalizeTokens :: [Token] -> [Token]
+canonicalizeTokens = filter (/= ContentText "") . meldTextTokens
+
+meldTextTokens :: [Token] -> [Token]
+meldTextTokens = concatTexts . fmap charToText
+  where
+    charToText (ContentChar c) = ContentText (T.singleton c)
+    charToText t = t
+
+    concatTexts = \case
+      (ContentText t : ContentText t' : ts) -> concatTexts $ ContentText (t <> t') : ts
+      (t : ts) -> t : concatTexts ts
+      [] -> []
diff --git a/Text/HTML/Tree.hs b/Text/HTML/Tree.hs
new file mode 100644
--- /dev/null
+++ b/Text/HTML/Tree.hs
@@ -0,0 +1,71 @@
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ViewPatterns          #-}
+
+module Text.HTML.Tree
+    ( -- * Constructing forests
+      tokensToForest
+    , ParseTokenForestError(..), PStack(..)
+    , nonClosing
+      -- * Deconstructing forests
+    , tokensFromForest
+    , tokensFromTree
+    ) where
+
+import           Data.Monoid
+import           Data.Text (Text)
+import           Data.Tree
+import           Text.HTML.Parser
+
+
+tokensToForest :: [Token] -> Either ParseTokenForestError (Forest Token)
+tokensToForest = f (PStack [] [])
+  where
+    f (PStack ss []) [] = Right (reverse ss)
+    f pstack []         = Left $ ParseTokenForestErrorBracketMismatch pstack Nothing
+    f pstack (t : ts)   = case t of
+        TagOpen n _     -> if n `elem` nonClosing
+                             then f (pushFlatSibling t pstack) ts
+                             else f (pushParent t pstack) ts
+        TagSelfClose {} -> f (pushFlatSibling t pstack) ts
+        TagClose n      -> (`f` ts) =<< popParent n pstack
+        ContentChar _   -> f (pushFlatSibling t pstack) ts
+        ContentText _   -> f (pushFlatSibling t pstack) ts
+        Comment _       -> f (pushFlatSibling t pstack) ts
+        Doctype _       -> f (pushFlatSibling t pstack) ts
+
+nonClosing :: [Text]
+nonClosing = ["br", "hr", "img"]
+
+data ParseTokenForestError =
+    ParseTokenForestErrorBracketMismatch PStack (Maybe Token)
+  deriving (Eq, Show)
+
+data PStack = PStack
+    { _pstackToplevelSiblings :: Forest Token
+    , _pstackParents          :: [(Token, Forest Token)]
+    }
+  deriving (Eq, Show)
+
+pushParent :: Token -> PStack -> PStack
+pushParent t (PStack ss ps) = PStack [] ((t, ss) : ps)
+
+popParent :: TagName -> PStack -> Either ParseTokenForestError PStack
+popParent n (PStack ss ((p@(TagOpen n' _), ss') : ps))
+    | n == n' = Right $ PStack (Node p (reverse ss) : ss') ps
+popParent n pstack
+    = Left $ ParseTokenForestErrorBracketMismatch pstack (Just $ TagClose n)
+
+pushFlatSibling :: Token -> PStack -> PStack
+pushFlatSibling t (PStack ss ps) = PStack (Node t [] : ss) ps
+
+
+tokensFromForest :: Forest Token -> [Token]
+tokensFromForest = mconcat . fmap tokensFromTree
+
+tokensFromTree :: Tree Token -> [Token]
+tokensFromTree (Node o@(TagOpen n _) ts) | n `notElem` nonClosing
+    = [o] <> tokensFromForest ts <> [TagClose n]
+tokensFromTree (Node t [])
+    = [t]
+tokensFromTree _
+    = error "renderTokenTree: leaf node with children."
diff --git a/html-parse.cabal b/html-parse.cabal
--- a/html-parse.cabal
+++ b/html-parse.cabal
@@ -1,5 +1,5 @@
 name:                html-parse
-version:             0.2.0.0
+version:             0.2.0.1
 synopsis:            A high-performance HTML tokenizer
 description:
     This package provides a fast and reasonably robust HTML5 tokenizer built
@@ -9,6 +9,13 @@
     The package targets similar use-cases to the venerable @tagsoup@ library,
     but is significantly more efficient, achieving parsing speeds of over 50
     megabytes per second on modern hardware with and typical web documents.
+    .
+    For instance,
+    .
+    >>> parseTokens "<div><h1 class=widget>Hello World</h1><br/>"
+    [TagOpen "div" [],TagOpen "h1" [Attr "class" "widget"],
+     ContentText "Hello World",TagClose "h1",TagSelfClose "br" []]
+
 homepage:            http://github.com/bgamari/html-parse
 license:             BSD3
 license-file:        LICENSE
@@ -18,18 +25,22 @@
 category:            Text
 build-type:          Simple
 cabal-version:       >=1.10
+tested-with:         GHC==8.0.2, GHC==7.10.3, GHC==7.8.4
 
+
 source-repository head
   type:                git
   location:            git://github.com/bgamari/html-parse
 
 library
-  exposed-modules:     Text.HTML.Parser
+  exposed-modules:     Text.HTML.Parser, Text.HTML.Tree
+  ghc-options:         -Wall
   other-extensions:    OverloadedStrings, DeriveGeneric
-  build-depends:       base >=4.8 && <4.10,
+  build-depends:       base >=4.7 && <4.11,
                        deepseq >=1.4 && <1.5,
                        attoparsec >=0.13 && <0.14,
-                       text >=1.2 && <1.3
+                       text >=1.2 && <1.3,
+                       containers >=0.5 && <0.6
   default-language:    Haskell2010
 
 benchmark bench
@@ -42,4 +53,21 @@
                        text,
                        tagsoup >= 0.13,
                        criterion >= 1.1
+  default-language:    Haskell2010
+
+test-suite spec
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      tests
+  main-is:             Spec.hs
+  other-modules:       Text.HTML.ParserSpec, Text.HTML.TreeSpec
+  ghc-options:         -Wall -with-rtsopts=-T
+  build-depends:       base,
+                       containers,
+                       hspec,
+                       hspec-discover,
+                       html-parse,
+                       QuickCheck,
+                       quickcheck-instances,
+                       string-conversions,
+                       text
   default-language:    Haskell2010
diff --git a/tests/Spec.hs b/tests/Spec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Spec.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/tests/Text/HTML/ParserSpec.hs b/tests/Text/HTML/ParserSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/HTML/ParserSpec.hs
@@ -0,0 +1,102 @@
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE ViewPatterns               #-}
+
+{-# OPTIONS_GHC -Wall -Werror -fno-warn-orphans -fno-warn-unused-imports #-}
+
+module Text.HTML.ParserSpec
+where
+
+import Control.Applicative
+import Data.Monoid
+import Data.List ((\\))
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as B
+import           Test.Hspec
+import           Test.QuickCheck
+import           Test.QuickCheck.Instances ()
+import           Text.HTML.Parser
+
+
+instance Arbitrary Token where
+  arbitrary = oneof [validOpen, validClose, validFlat]
+
+  shrink (TagOpen n as)      = TagOpen n <$> shrink as
+  shrink (TagSelfClose n as) = TagSelfClose n <$> shrink as
+  shrink (TagClose _)        = []
+  shrink (ContentText _)     = []
+  shrink (ContentChar _)     = []
+  shrink (Comment b)         = Comment . B.fromText <$> (shrink . TL.toStrict . B.toLazyText $ b)
+  shrink (Doctype t)         = Doctype <$> shrink t
+
+instance Arbitrary Attr where
+  arbitrary = Attr <$> validXmlAttrName <*> validXmlAttrValue
+  shrink (Attr k v) = Attr <$> shrink k <*> shrink v
+
+validOpen :: Gen Token
+validOpen = TagOpen <$> validXmlTagName <*> arbitrary
+
+validClose :: Gen Token
+validClose = TagClose <$> validXmlTagName
+
+validFlat :: Gen Token
+validFlat = oneof
+    [ TagSelfClose <$> validXmlTagName <*> arbitrary
+    , ContentChar <$> validXmlChar
+    , ContentText <$> validXmlText
+    , Comment . B.fromText <$> validXmlCommentText
+    , Doctype <$> validXmlText
+    ]
+
+-- FIXME: sometimes it is allowed to use '<' as text token, and we don't test that yet.  (whether we
+-- like this choice or not, we may want to follow the standard here.)  (same in tag names, attr
+-- names.)
+validXmlChar :: Gen Char
+validXmlChar = elements (['\x20'..'\x7E'] \\ "\x09\x0a\x0c /<>")
+
+validXmlText :: Gen T.Text
+validXmlText = T.pack <$> sized (`maxListOf` validXmlChar)
+
+validXmlTagName :: Gen T.Text
+validXmlTagName = do
+    initchar  <- elements $ ['a'..'z'] <> ['A'..'Z']
+    thenchars <- sized (`maxListOf` elements (['\x20'..'\x7E'] \\ "\x09\x0a\x0c /<>"))
+    pure . T.pack $ initchar : thenchars
+
+validXmlAttrName :: Gen T.Text
+validXmlAttrName = do
+    initchar  <- elements $ ['a'..'z'] <> ['A'..'Z']
+    thenchars <- sized (`maxListOf` elements (['\x20'..'\x7E'] \\ "\x09\x0a\x0c /=<>\x00"))
+    pure . T.pack $ initchar : thenchars
+
+-- FIXME: not sure if @Attr "key" "\""@ should be parseable, but it's not, so we don't test it.
+validXmlAttrValue :: Gen T.Text
+validXmlAttrValue = do
+    T.pack <$> sized (`maxListOf` elements (['\x20'..'\x7E'] \\ "\x09\x0a\x0c /=<>\x00\""))
+
+-- FIXME: i think this should be 'validXmlChar', but that will fail the test suite.
+validXmlCommentText :: Gen T.Text
+validXmlCommentText = do
+    T.pack <$> sized (`maxListOf` elements (['\x20'..'\x7E'] \\ "\x09\x0a\x0c /=<>\x00\"-"))
+
+maxListOf :: Int -> Gen a -> Gen [a]
+maxListOf n g = take n <$> listOf g
+
+
+spec :: Spec
+spec = do
+  it "parseTokens and renderTokens are inverse" . property . forAllShrink arbitrary shrink $
+    \(canonicalizeTokens -> tokens)
+      -> (parseTokens . TL.toStrict . renderTokens $ tokens) `shouldBe` tokens
+
+  it "canonicalizeTokens is idempotent" . property . forAllShrink arbitrary shrink $
+    \tokens
+      -> canonicalizeTokens tokens `shouldBe` canonicalizeTokens (canonicalizeTokens tokens)
+
+  describe "regression tests" $ do
+    describe "parseTokens" $ do
+      it "works on `<h1>Heading</h1>`" $ do
+        parseTokens "<h1>Heading</h1>" `shouldBe` [TagOpen "h1" [], ContentText "Heading", TagClose "h1"]
diff --git a/tests/Text/HTML/TreeSpec.hs b/tests/Text/HTML/TreeSpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Text/HTML/TreeSpec.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-# OPTIONS_GHC -Wall -Werror -fno-warn-orphans #-}
+
+module Text.HTML.TreeSpec
+where
+
+import           Control.Applicative
+import           Data.Tree
+import           Test.Hspec
+import           Test.QuickCheck
+import           Test.QuickCheck.Instances ()
+import           Text.HTML.Parser
+import           Text.HTML.ParserSpec
+import           Text.HTML.Tree
+import           Prelude
+
+
+arbitraryTokenForest :: Gen (Forest Token)
+arbitraryTokenForest = listOf arbitraryTokenTree
+
+arbitraryTokenTree :: Gen (Tree Token)
+arbitraryTokenTree = oneof
+    [ Node <$> validClosingOpen    <*> scale (`div` 5) arbitraryTokenForest
+    , Node <$> validNonClosingOpen <*> pure []
+    , Node <$> validFlat           <*> pure []
+    ]
+
+
+validNonClosingOpen :: Gen Token
+validNonClosingOpen = TagOpen <$> elements nonClosing <*> arbitrary
+
+validClosingOpen :: Gen Token
+validClosingOpen = do
+    n <- validXmlTagName
+    let n' = if n `elem` nonClosing then "_" else n
+    TagOpen n' <$> arbitrary
+
+
+spec :: Spec
+spec = do
+  it "parseTokenForests and renderTokenForest are inverses"
+    . property . forAllShrink arbitraryTokenForest shrink $
+      \forest -> tokensToForest (tokensFromForest forest) `shouldBe` Right forest