diff --git a/src/Text/HTML/WraXML/Document.hs b/src/Text/HTML/WraXML/Document.hs
--- a/src/Text/HTML/WraXML/Document.hs
+++ b/src/Text/HTML/WraXML/Document.hs
@@ -1,26 +1,23 @@
 module Text.HTML.WraXML.Document (
-   XMLDoc.T(..), XMLDoc.lift, show,
+   XMLDoc.T(..), XMLDoc.lift, format,
    ) where
 
 import qualified Text.HTML.WraXML.Tree    as HTMLTree
 import qualified Text.XML.WraXML.Document as XMLDoc
-import qualified Text.XML.WraXML.String   as XMLString
 import qualified Text.XML.Basic.Name as Name
-
-import Prelude hiding (show)
+import qualified Text.XML.Basic.Format as Format
 
 
-show ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XMLDoc.T i name XMLString.T -> String
-show (XMLDoc.Cons xml dtd trees) =
-   let (showHTML, showXMLDecl) =
+format ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   XMLDoc.T i name string -> ShowS
+format (XMLDoc.Cons xml dtd trees) =
+   let (formatHTML, formatXMLDecl) =
           maybe
-             (HTMLTree.showsMany, id)
+             (HTMLTree.formatMany, id)
              (\xmlDecl ->
-                 (HTMLTree.showsManyXHTML,
-                  XMLDoc.showXMLDeclaration xmlDecl)) xml
-   in  showXMLDecl .
-       maybe id XMLDoc.showDocType dtd .
-       showHTML trees $
-       ""
+                 (HTMLTree.formatManyXHTML,
+                  XMLDoc.formatXMLDeclaration xmlDecl)) xml
+   in  formatXMLDecl .
+       maybe id XMLDoc.formatDocType dtd .
+       formatHTML trees
diff --git a/src/Text/HTML/WraXML/Table.hs b/src/Text/HTML/WraXML/Table.hs
--- a/src/Text/HTML/WraXML/Table.hs
+++ b/src/Text/HTML/WraXML/Table.hs
@@ -15,7 +15,7 @@
 Ignores all non-table-row-tags and all non-table-cell-tags.
 -}
 simpleFromRows ::
-   (Name.Tag name, Eq name) =>
+   (Name.Tag name) =>
    [XMLTree.T i name str] ->  T i name str
 simpleFromRows =
    map (simpleFromRow . snd) .
@@ -23,7 +23,7 @@
    mapMaybe XMLTree.maybeTag
 
 simpleFromRow ::
-   (Name.Tag name, Eq name) =>
+   (Name.Tag name) =>
    [XMLTree.T i name str] ->  [[XMLTree.T i name str]]
 simpleFromRow =
    map snd .
diff --git a/src/Text/HTML/WraXML/Tree.hs b/src/Text/HTML/WraXML/Tree.hs
--- a/src/Text/HTML/WraXML/Tree.hs
+++ b/src/Text/HTML/WraXML/Tree.hs
@@ -10,24 +10,20 @@
 import qualified Text.XML.Basic.Attribute as Attr
 import qualified Text.XML.Basic.Name  as Name
 
-import Text.XML.WraXML.Tree (showLeaf, )
-import qualified Text.XML.Basic.Format as ShowXML
+import Text.XML.WraXML.Tree (formatLeaf, )
+import qualified Text.XML.Basic.Format as Format
 
 import           Data.List.HT (takeWhileRev, )
 import           Data.Tuple.HT (mapFst, )
 import           Control.Monad (liftM2, )
 import           Data.Maybe (mapMaybe, fromMaybe, )
 
--- import qualified Text.Show as Show
 
-import Prelude hiding (show, shows, )
 
-
-
 {- * Character decoding -}
 
 findMetaEncoding ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name String -> Maybe String
 findMetaEncoding =
    fmap (map Char.toLower . takeWhileRev ('='/=)) .
@@ -40,7 +36,7 @@
 and present these values like HTTP headers.
 -}
 getMetaHTTPHeaders ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name String -> [(String, String)]
 getMetaHTTPHeaders =
    mapMaybe (\attrs ->
@@ -62,7 +58,7 @@
 according to the encoding given in a META HTTP-EQUIV tag.
 -}
 decodeSpecialCharsMetaEncoding ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name XmlString.T -> [XmlTree.T i name String]
 decodeSpecialCharsMetaEncoding tree =
    let unicodeTree = XmlTree.unescape tree
@@ -76,47 +72,49 @@
 {- * Formatting -}
 
 
+{-
 show ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name XmlString.T -> String
 show leaf = shows leaf ""
+-}
 
-showsMany ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   [XmlTree.T i name XmlString.T] -> ShowS
-showsMany = ShowXML.many shows
+formatMany ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   [XmlTree.T i name string] -> ShowS
+formatMany = Format.many format
 
--- cf. src/Text/XML/HXT/DOM/XmlTreeFunctions.hs
-shows ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XmlTree.T i name XmlString.T -> ShowS
-shows =
-   Tree.fold (flip const) showBranch showLeaf .
+-- cf. src/Text/ML/HXT/DOM/XmlTreeFunctions.hs
+format ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   XmlTree.T i name string -> ShowS
+format =
+   Tree.fold (flip const) formatBranch formatLeaf .
    XmlTree.unwrap
 
-showBranch ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XmlTree.Branch name XmlString.T -> [ShowS] -> ShowS
-showBranch = showBranchGen False
+formatBranch ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   XmlTree.Branch name string -> [ShowS] -> ShowS
+formatBranch = formatBranchGen False
 
 
-showsManyXHTML ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   [XmlTree.T i name XmlString.T] -> ShowS
-showsManyXHTML = ShowXML.many showsXHTML
+formatManyXHTML ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   [XmlTree.T i name string] -> ShowS
+formatManyXHTML = Format.many formatXHTML
 
 -- cf. src/Text/XML/HXT/DOM/XmlTreeFunctions.hs
-showsXHTML ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XmlTree.T i name XmlString.T -> ShowS
-showsXHTML =
-   Tree.fold (flip const) showBranchXHTML showLeaf .
+formatXHTML ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   XmlTree.T i name string -> ShowS
+formatXHTML =
+   Tree.fold (flip const) formatBranchXHTML formatLeaf .
    XmlTree.unwrap
 
-showBranchXHTML ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XmlTree.Branch name XmlString.T -> [ShowS] -> ShowS
-showBranchXHTML = showBranchGen True
+formatBranchXHTML ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   XmlTree.Branch name string -> [ShowS] -> ShowS
+formatBranchXHTML = formatBranchGen True
 
 
 {- |
@@ -125,13 +123,13 @@
 Unfortunately we cannot generally merge @<tag></tag>@ to @<tag/>@
 since browsers expect e.g. separated @<div></div>@.
 -}
-showBranchGen ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   Bool -> XmlTree.Branch name XmlString.T -> [ShowS] -> ShowS
-showBranchGen xhtml branch showSubTrees =
+formatBranchGen ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   Bool -> XmlTree.Branch name string -> [ShowS] -> ShowS
+formatBranchGen xhtml branch formatSubTrees =
    case branch of
       XmlTree.Tag elm ->
          Elem.format
-            (\tagName -> null showSubTrees && Tag.isEmpty tagName)
-            (if xhtml then ShowXML.slash else id)
-            elm showSubTrees
+            (\tagName -> null formatSubTrees && Tag.isEmpty tagName)
+            (if xhtml then Format.slash else id)
+            elm formatSubTrees
diff --git a/src/Text/HTML/WraXML/Tree/HXT.hs b/src/Text/HTML/WraXML/Tree/HXT.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/WraXML/Tree/HXT.hs
@@ -0,0 +1,303 @@
+module Text.HTML.WraXML.Tree.HXT
+   (tidy, format, fromHTMLString, fromHTMLStringMetaEncoding,
+    errorAnnFromHTMLStringMetaEncoding,
+    errorAnnFromHTMLStringOpt, ErrorMsg,
+    getMetaHTTPHeaders, ) where
+
+import qualified Text.XML.HXT.DOM.TypeDefs as HXT
+-- import qualified Text.XML.HXT.DOM.XmlTreeFunctions as HXTTreeFunc
+import qualified Data.Tree.NTree.TypeDefs  as HXTTree
+
+import qualified Text.XML.WraXML.Tree.HXT as WraHXT
+
+import qualified Text.HTML.WraXML.Tree   as HTMLTree
+import qualified Text.XML.WraXML.Tree    as XmlTree
+
+import qualified Text.XML.Basic.Name.LowerCase as NameLC
+import qualified Text.XML.Basic.Name as Name
+
+import qualified Text.XML.Basic.Format    as Format
+
+-- needed for code copies from HXT at the of the file
+import Text.XML.HXT.DOM.XmlTree hiding (cmt, formatTree, )
+import Text.XML.HXT.DOM.XmlState
+   (XmlStateFilter, liftF, run',
+    setSystemParams, setSysErrorHandler, getErrorMsg,
+    errorMsgLogging, errorMsgToStderr, )
+import Text.XML.HXT.Parser.XmlParser  (parseXmlDocEncodingSpec, )
+import Text.XML.HXT.Parser.XmlInput   (guessDocEncoding, )
+import Text.XML.HXT.Parser.XmlOutput  (traceTree, traceSource, traceMsg, )
+import Text.XML.HXT.Parser.HtmlParser (parseHtmlDoc, )
+import Text.XML.HXT.Parser.HtmlParsec (isEmptyHtmlTag, )
+import Text.XML.HXT.DOM.EditFilters   (escapeXmlDoc, )
+import Text.XML.HXT.DOM.ShowXml       (xshow, {- showXmlTree, showQName, -})
+import Text.XML.HXT.DOM.QualifiedName (qualifiedName, )
+import Data.Tree.NTree.Filter         (liftMf, )
+
+import Control.Monad (msum, )
+import Data.Maybe (fromMaybe, )
+
+
+
+{- |
+Tidy a piece of HTML code.
+&   ->   &amp;
+<   ->   &lt;
+unquoted tag attribute values: size=-1   ->   size="-1"
+insert omitted closing tags
+-}
+tidy :: String -> IO String
+tidy input =
+   -- escapeXmlDoc replaces < by &lt; and so on
+   -- XmlParsec.substXmlEntities similar to escapeXmlDoc ?
+   fmap (($"") . formatTrees . (escapeXmlDoc .> getChildren))
+        (fromHTMLString input)
+
+
+-- * formatting
+
+{- |
+Like 'Text.XML.HXT.DOM.XmlTreeFunctions.xshow'
+but it shows empty tags the HTML way.
+E.g. it emits @<br>@ instead of @<br\/>@,
+@<noscript><\/noscript>@ instead of @<noscript\/>@.
+Many browsers prefer that.
+-}
+format :: HXT.XmlTree -> String
+format leaf = formatTrees (HXTTree.getChildren leaf) ""
+
+formatTrees	:: HXT.XmlTrees -> ShowS
+formatTrees	= foldr (.) id . map formatTree
+
+
+-- cf. src/Text/XML/HXT/DOM/XmlTreeFunctions.hs
+formatTree	:: HXT.XmlTree -> ShowS
+formatTree leaf =
+   case leaf of
+      (NTree (XPi n al) _) ->
+         showString "<?"
+         .
+         formatQName n
+         .
+         (foldr (.) id . map showPiAttr) al
+         .
+         showString "?>"
+           where
+             showPiAttr :: HXT.XmlTree -> String -> String
+             showPiAttr a@(NTree (XAttr an) cs) =
+	         if aName an == a_value
+	           then Format.blank . formatTrees cs
+	           else formatTree a
+             showPiAttr _ = id
+      (NTree (XTag t al) cs) ->
+         if null cs && isEmptyHtmlTag (HXT.qualifiedName t)
+           then Format.lt . formatQName t . formatTrees al . Format.gt
+           else Format.lt . formatQName t . formatTrees al . Format.gt
+                 . formatTrees cs
+                 . Format.lt . Format.slash . formatQName t . Format.gt
+      (NTree (XAttr an) cs) ->
+         Format.blank . formatQName an . Format.eq . Format.stringQuoted (formatTrees cs "")
+      (NTree (XError l e) _) ->
+         showString "<!-- ERROR (" . showString (show l) . showString "):\n"
+          . showString e . showString "\n-->"
+      _ -> (xshow [leaf] ++) -- showXmlTree leaf
+
+
+formatQName :: QName -> ShowS
+formatQName = showString . qualifiedName
+
+
+-- * parsing and encoding
+
+{- |
+Search for a META tag for the encoding of the HTML text.
+-}
+findMetaEncoding :: String -> IO (Maybe String)
+findMetaEncoding str =
+   do htmlTrees <- xmlTreesFromHTMLString str
+      return (msum (map HTMLTree.findMetaEncoding (htmlTrees :: [XmlTree.T () NameLC.T String])))
+
+getMetaHTTPHeaders :: String -> IO [(String, String)]
+getMetaHTTPHeaders str =
+   do htmlTrees <- xmlTreesFromHTMLString str
+      return (concatMap HTMLTree.getMetaHTTPHeaders (htmlTrees :: [XmlTree.T () NameLC.T String]))
+
+xmlTreesFromHTMLString ::
+   (Name.Tag name, Name.Attribute name) =>
+   String -> IO [XmlTree.T () name String]
+xmlTreesFromHTMLString str =
+   do hxtTree <- fromHTMLString str
+      -- it will hopefully be only one HTML tree
+      return $
+         map (XmlTree.unescape . WraHXT.toXmlTree)
+             (filter (WraHXT.checkTagName "html" . HXTTree.getNode)
+                     (HXTTree.getChildren hxtTree))
+
+
+{- |
+Guess the encoding from the META-HTTP-EQUIV attribute, if available.
+Otherwise fall back to ISO-Latin-1.
+-}
+fromHTMLStringMetaEncoding :: String -> IO HXT.XmlTree
+fromHTMLStringMetaEncoding str =
+   do enc <- findMetaEncoding str
+      fromHTMLStringOpt [(a_encoding, fromMaybe isoLatin1 enc)] str
+
+{-
+With no encoding option given,
+utf8ToUnicode fails when trying to interpret ISO-Latin characters as UTF-8 characters
+-}
+fromHTMLString :: String -> IO HXT.XmlTree
+fromHTMLString = fromHTMLStringOpt [(a_encoding, isoLatin1)]
+
+fromHTMLStringOpt :: Attributes -> String -> IO HXT.XmlTree
+fromHTMLStringOpt options input =
+   do (tree,_,_) <- errorAnnFromHTMLStringOpt options input
+      return tree
+
+type ErrorMsg = (Int,String)
+
+errorAnnFromHTMLStringMetaEncoding ::
+   String -> IO (HXT.XmlTree, [ErrorMsg], Int)
+errorAnnFromHTMLStringMetaEncoding str =
+   do enc <- findMetaEncoding str
+      errorAnnFromHTMLStringOpt [(a_encoding, fromMaybe isoLatin1 enc)] str
+
+{- |
+Adaption of Text.XML.HXT.Parser.MainFunctions.getXmlDocument
+-}
+errorAnnFromHTMLStringOpt ::
+   Attributes -> String -> IO (HXT.XmlTree, [ErrorMsg], Int)
+errorAnnFromHTMLStringOpt options contents =
+   do
+      let options' =
+             (a_collect_errors, v_1) :	-- collect errors
+	     (a_issue_errors,   v_0) :	-- but don't issue
+	    				-- can be overwritten by supporting other values in options
+             options
+      (root:errs) <- run' $ parseDocument options' contents emptyRoot
+      let elvl = intValueOf a_status root
+      let errMsgs = map ((\(XError level msg) -> (level, msg)) . getNode) errs
+      return (root, errMsgs, elvl)
+
+
+
+
+{- |
+An input handler alternative
+to Text.XML.HXT.Parser.ProtocolHandlerFile.
+It returns the argument string as something
+that can be further processed by HXT functions.
+-}
+getStringContents :: String -> XmlStateFilter a
+getStringContents contents =
+   return . replaceChildren (xtext contents)
+   .>>
+   {- We must attach some encoding info to the tree
+      which is processed by the HTML parser.
+      Using this encoding information
+      the HTML parser converts e.g. UTF-8 characters to Unicode characters.
+      Cf. Parser.XmlInput.getXmlContents -}
+   liftF parseXmlDocEncodingSpec
+   .>>
+   guessDocEncoding
+
+
+{- |
+Adaption of Text.XML.HXT.Parser.MainFunctions.parseDocument
+-}
+parseDocument :: Attributes -> String -> XmlStateFilter state
+parseDocument userOptions contents
+    = processDocument userOptions defaultOptions
+      ( traceMsg 1 "parseDocument: options added, start processing"
+	.>>
+	traceTree
+	.>>
+	getStringContents contents		-- get the content as text
+	.>>
+	parseHtmlDoc				-- parse everything as HTML
+	.>>
+--        liftMf canonicalizeForXPath
+--	.>>
+	traceMsg 1 "parseDocument: document processed"	-- trace output
+	.>>
+	traceSource
+	.>>
+	traceTree
+      )
+    where
+    defaultOptions
+	= [ ( a_parse_html,		v_1 )
+	  , ( a_validate,		v_1 )
+	  , ( a_issue_errors,		v_1 )
+	  , ( a_issue_warnings,		v_1 )
+	  , ( a_check_namespaces,	v_0 )
+	  , ( a_canonicalize,		v_1 )
+	  , ( a_preserve_comment,	v_0 )
+	  , ( a_remove_whitespace,	v_0 )
+	  ]
+
+
+{- |
+Copy of Text.XML.HXT.Parser.MainFunctions.addOptions add addDefaultOptions
+-}
+addOptions	  :: Attributes -> XmlFilter
+addOptions
+    = seqF . map (uncurry addAttr)
+
+addDefaultOptions :: Attributes -> XmlFilter
+addDefaultOptions
+    = seqF . map (\ (n,v) -> addAttr n v `whenNot` hasAttr n)
+
+
+{- |
+Copy of Text.XML.HXT.Parser.MainFunctions.processDocument
+-}
+processDocument	:: Attributes -> Attributes -> XmlStateFilter state -> XmlStateFilter state
+processDocument userOptions defaultOptions processFilter
+    = liftMf isRoot
+      .>>
+      liftMf (addOptions userOptions
+	      .>
+	      addOptions [(a_status, show c_ok)]
+	     )
+      .>>
+      liftMf (addDefaultOptions defaultOptions)
+      .>>
+      setSystemParams							-- store options in system state
+      .>>
+      choiceM
+      [ hasOption a_propagate_errors					-- error handling is set by calling environment
+		:-> thisM
+
+      , hasOption a_collect_errors
+	.>
+	hasOption a_issue_errors
+		:-> performAction (\ _ -> setSysErrorHandler (errorMsgLogging.>> errorMsgToStderr)	)
+
+      , hasOption a_collect_errors
+		:-> performAction (\ _ -> setSysErrorHandler errorMsgLogging	)
+
+      , hasOption a_issue_errors
+		:-> performAction (\ _ -> setSysErrorHandler errorMsgToStderr	)
+
+      , this
+		:-> performAction (\ _ -> setSysErrorHandler noneM		)
+      ]
+      .>>
+      processFilter
+      .>>
+      ( thisM
+        +++>>
+	( hasOption a_collect_errors
+          `guardsM`
+	  getErrorMsg
+	)
+      )
+
+
+{-
+putStr . xshow =<< run' (Text.XML.HXT.Parser.MainFunctions.parseDocument [(a_source,"lousy.html"), (a_parse_html,v_1)] emptyRoot)
+
+readFile "lousy.html" >>= tidy >>= putStr
+-}
diff --git a/src/Text/XML/WraXML/Document.hs b/src/Text/XML/WraXML/Document.hs
--- a/src/Text/XML/WraXML/Document.hs
+++ b/src/Text/XML/WraXML/Document.hs
@@ -1,10 +1,9 @@
 module Text.XML.WraXML.Document where
 
-import qualified Text.XML.WraXML.Tree    as XmlTree
-import qualified Text.XML.WraXML.String  as XmlString
+import qualified Text.XML.WraXML.Tree as XmlTree
 import qualified Text.XML.Basic.Attribute as Attr
 import qualified Text.XML.Basic.Name as Name
-import qualified Text.XML.Basic.Format as ShowXML
+import qualified Text.XML.Basic.Format as Format
 
 
 
@@ -15,12 +14,12 @@
      deriving Show
 
 instance
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
       Functor (T i name) where
    fmap f = lift f (map (fmap f))
 
 lift ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    (str0 -> str1) ->
    ([XmlTree.T i name str0] -> [XmlTree.T i name str1]) ->
    T i name str0 -> T i name str1
@@ -28,23 +27,27 @@
    Cons (fmap (map (fmap g)) xml) dtd $ f trees
 
 
-showXMLDeclaration ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   [Attr.T name XmlString.T] -> ShowS
-showXMLDeclaration attrs =
+formatXMLDeclaration ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   [Attr.T name string] -> ShowS
+formatXMLDeclaration attrs =
    showString "<?xml" . Attr.formatListBlankHead attrs . showString "?>" .
-   ShowXML.nl
+   Format.nl
 
-showDocType :: String -> ShowS
-showDocType dtdStr =
-   showString "<!DOCTYPE " . showString dtdStr . showString ">" .
-   ShowXML.nl
+formatDocType :: String -> ShowS
+formatDocType dtdStr =
+   Format.angle (showString "!DOCTYPE " . showString dtdStr) .
+   Format.nl
 
-show ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   T i name XmlString.T -> String
-show (Cons xml dtd trees) =
-   maybe id showXMLDeclaration xml .
-   maybe id showDocType dtd .
-   XmlTree.showsMany trees $
-   ""
+format ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   T i name string -> ShowS
+format (Cons xml dtd trees) =
+   maybe id formatXMLDeclaration xml .
+   maybe id formatDocType dtd .
+   XmlTree.formatMany trees
+
+instance
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+      Format.C (T i name string) where
+   run = format
diff --git a/src/Text/XML/WraXML/Document/TagSoup.hs b/src/Text/XML/WraXML/Document/TagSoup.hs
--- a/src/Text/XML/WraXML/Document/TagSoup.hs
+++ b/src/Text/XML/WraXML/Document/TagSoup.hs
@@ -38,7 +38,7 @@
    modify dropSpace >> state f
 
 toXmlDocument ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    [Tag] -> XmlDoc.T Position.T name String
 toXmlDocument ts =
    flip evalState
@@ -66,7 +66,7 @@
 -}
 
 toXmlDocumentString ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    [Tag] -> XmlDoc.T Position.T name String
 toXmlDocumentString =
    toXmlDocument
diff --git a/src/Text/XML/WraXML/Document/TagSoupHT.hs b/src/Text/XML/WraXML/Document/TagSoupHT.hs
deleted file mode 100644
--- a/src/Text/XML/WraXML/Document/TagSoupHT.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-module Text.XML.WraXML.Document.TagSoupHT where
-
-import qualified Text.XML.WraXML.Tree.TagSoupHT as TreeTagSoup
-import qualified Text.XML.WraXML.Document as XmlDoc
--- import qualified Text.XML.WraXML.Tree     as XmlTree
-
-import qualified Text.HTML.TagSoup.HT.Parser      as TagParser
-import qualified Text.HTML.TagSoup.HT.Tag         as Tag
-import qualified Text.HTML.TagSoup.HT.PositionTag as PosTag
-import qualified Text.XML.Basic.Position    as Position
-import qualified Text.HTML.Basic.Tag as TagH
-import qualified Text.HTML.Basic.Character    as HTMLChar
-
-import qualified Text.XML.Basic.Name.LowerCase as NameLC
-import qualified Text.XML.Basic.Name           as Name
-import qualified Text.XML.Basic.ProcessingInstruction as PI
-
-import Data.List.HT (viewL, )
-import Data.Maybe (fromMaybe, )
-import Control.Monad (guard, )
-
-import Control.Monad.Trans.State (State, state, evalState, modify, gets, )
-
-import qualified Data.Char as Char
-
-
-
-type XmlDoc = XmlDoc.T Position.T
-
-
-class TagParser.CharType char => CharSpace char where
-   isSpace :: char -> Bool
-
-instance CharSpace Char where
-   isSpace = Char.isSpace
-
-instance CharSpace HTMLChar.T where
-   isSpace c =
-      case c of
-         HTMLChar.Unicode chr -> Char.isSpace chr
-         HTMLChar.EntityRef "nbsp" -> True
-         _ -> False
-
-class StringSpace string where
-   isAllSpace :: string -> Bool
-
-instance CharSpace char => StringSpace [char] where
-   isAllSpace = all isSpace
-
-
-dropSpace :: StringSpace string =>
-   [PosTag.T name string] -> [PosTag.T name string]
-dropSpace =
-   dropWhile
-      (\tag ->
-          case PosTag.tag_ tag of
-             Tag.Text text -> isAllSpace text
-             _ -> False)
-
-withoutLeadingSpace :: (StringSpace string) =>
-   ([PosTag.T name string] -> (a, [PosTag.T name string])) ->
-   State [PosTag.T name string] a
-withoutLeadingSpace f =
-   modify dropSpace >> state f
-
-toXmlDocument ::
-   (Name.Tag name, Name.Attribute name, Ord name, StringSpace string) =>
-   [PosTag.T name string] -> XmlDoc name string
-toXmlDocument ts =
-   flip evalState ts $
-   do xml <- withoutLeadingSpace $ \ts0 ->
-         fromMaybe (Nothing, ts0) $
-         do (t,ts1) <- viewL ts0
-            (name, PI.Known attrs) <- Tag.maybeProcessing (PosTag.tag_ t)
-            guard (Name.match "xml" name)
-            return (Just attrs, ts1)
-      docType <- withoutLeadingSpace $ \ts0 ->
-         fromMaybe (Nothing, ts0) $
-         do (t,ts1) <- viewL ts0
-            (name, dtd) <- Tag.maybeSpecial (PosTag.tag_ t)
-            guard (Name.match TagH.doctypeString name)
-            return (Just dtd, ts1)
-      gets (XmlDoc.Cons xml docType . TreeTagSoup.toXmlTrees)
-
-
-example :: IO ()
-example =
-  print .
-  (toXmlDocument :: [PosTag.T NameLC.T String] -> XmlDoc NameLC.T String) .
-  TagParser.runSoupWithPositions
-    =<< readFile "/home/thielema/public_html/index.html"
diff --git a/src/Text/XML/WraXML/Document/Tagchup.hs b/src/Text/XML/WraXML/Document/Tagchup.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/XML/WraXML/Document/Tagchup.hs
@@ -0,0 +1,91 @@
+module Text.XML.WraXML.Document.Tagchup where
+
+import qualified Text.XML.WraXML.Tree.Tagchup as TreeTagchup
+import qualified Text.XML.WraXML.Document as XmlDoc
+-- import qualified Text.XML.WraXML.Tree     as XmlTree
+
+import qualified Text.HTML.Tagchup.Parser      as TagParser
+import qualified Text.HTML.Tagchup.Tag         as Tag
+import qualified Text.HTML.Tagchup.PositionTag as PosTag
+import qualified Text.XML.Basic.Position    as Position
+import qualified Text.HTML.Basic.Tag as TagH
+import qualified Text.HTML.Basic.Character    as HTMLChar
+
+import qualified Text.XML.Basic.Name.LowerCase as NameLC
+import qualified Text.XML.Basic.Name           as Name
+import qualified Text.XML.Basic.ProcessingInstruction as PI
+
+import Data.List.HT (viewL, )
+import Data.Maybe (fromMaybe, )
+import Control.Monad (guard, )
+
+import Control.Monad.Trans.State (State, state, evalState, modify, gets, )
+
+import qualified Data.Char as Char
+
+
+
+type XmlDoc = XmlDoc.T Position.T
+
+
+class TagParser.CharType char => CharSpace char where
+   isSpace :: char -> Bool
+
+instance CharSpace Char where
+   isSpace = Char.isSpace
+
+instance CharSpace HTMLChar.T where
+   isSpace c =
+      case c of
+         HTMLChar.Unicode chr -> Char.isSpace chr
+         HTMLChar.EntityRef "nbsp" -> True
+         _ -> False
+
+class StringSpace string where
+   isAllSpace :: string -> Bool
+
+instance CharSpace char => StringSpace [char] where
+   isAllSpace = all isSpace
+
+
+dropSpace :: StringSpace string =>
+   [PosTag.T name string] -> [PosTag.T name string]
+dropSpace =
+   dropWhile
+      (\tag ->
+          case PosTag.tag_ tag of
+             Tag.Text text -> isAllSpace text
+             _ -> False)
+
+withoutLeadingSpace :: (StringSpace string) =>
+   ([PosTag.T name string] -> (a, [PosTag.T name string])) ->
+   State [PosTag.T name string] a
+withoutLeadingSpace f =
+   modify dropSpace >> state f
+
+toXmlDocument ::
+   (Name.Tag name, Name.Attribute name, StringSpace string) =>
+   [PosTag.T name string] -> XmlDoc name string
+toXmlDocument ts =
+   flip evalState ts $
+   do xml <- withoutLeadingSpace $ \ts0 ->
+         fromMaybe (Nothing, ts0) $
+         do (t,ts1) <- viewL ts0
+            (name, PI.Known attrs) <- Tag.maybeProcessing (PosTag.tag_ t)
+            guard (Name.match "xml" name)
+            return (Just attrs, ts1)
+      docType <- withoutLeadingSpace $ \ts0 ->
+         fromMaybe (Nothing, ts0) $
+         do (t,ts1) <- viewL ts0
+            (name, dtd) <- Tag.maybeSpecial (PosTag.tag_ t)
+            guard (Name.match TagH.doctypeString name)
+            return (Just dtd, ts1)
+      gets (XmlDoc.Cons xml docType . TreeTagchup.toXmlTrees)
+
+
+example :: IO ()
+example =
+  print .
+  (toXmlDocument :: [PosTag.T NameLC.T String] -> XmlDoc NameLC.T String) .
+  TagParser.runSoupWithPositions
+    =<< readFile "/home/thielema/public_html/index.html"
diff --git a/src/Text/XML/WraXML/Element.hs b/src/Text/XML/WraXML/Element.hs
--- a/src/Text/XML/WraXML/Element.hs
+++ b/src/Text/XML/WraXML/Element.hs
@@ -1,7 +1,5 @@
 module Text.XML.WraXML.Element where
 
-import qualified Text.XML.WraXML.String  as XmlString
-
 import qualified Text.XML.Basic.Tag as Tag
 import qualified Text.XML.Basic.Attribute as Attr
 import qualified Text.XML.Basic.Name as Name
@@ -14,7 +12,7 @@
 import qualified Control.Applicative as App
 import           Data.Monoid (mconcat, )
 
-import qualified Text.XML.Basic.Format as ShowXML
+import qualified Text.XML.Basic.Format as Format
 import qualified Text.Show as Show
 
 
@@ -24,8 +22,14 @@
       attributes_ :: [Attr.T name str]
    } deriving (Show)
 
+type Filter name str = T name str -> T name str
 
 
+cons ::
+   (Name.Tag name, Name.Attribute name) =>
+   Tag.Name name -> [Attr.T name str] -> T name str
+cons = Cons
+
 name :: Accessor.T (T name str) (Tag.Name name)
 name = Accessor.fromSetGet (\n p -> p{name_ = n}) name_
 
@@ -51,7 +55,7 @@
 
 lift ::
    (Tag.Name name -> [Attr.T name str] -> (Tag.Name name, [Attr.T name str])) ->
-   (T name str -> T name str)
+   (Filter name str)
 lift f (Cons tagName attrs) =
    uncurry Cons (f tagName attrs)
 
@@ -61,26 +65,26 @@
    (Name.Tag name, Name.Attribute name) =>
    (Tag.Name name -> Bool) ->
    ([Attr.T name str] -> [Attr.T name str]) ->
-   (T name str -> T name str)
+   (Filter name str)
 processAttrs p f =
    lift (\tagName ->
       (,) tagName . if p tagName then f else id)
 
 processAttrValue ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    (Tag.Name name, Attr.Name name) ->
    (str -> str) ->
-   (T name str -> T name str)
+   (Filter name str)
 processAttrValue (tagName,attrName) f =
    processAttrs (tagName ==)
       (Attr.adjustOn (attrName ==) f)
 
 processAttrValueCond ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    (Tag.Name name, Attr.Name name) ->
    ([Attr.T name str] -> Bool) ->
    (str -> str) ->
-   (T name str -> T name str)
+   (Filter name str)
 processAttrValueCond (tagName,attrName) cond f =
    processAttrs (tagName ==)
       (\attrs -> Attr.adjustOn (attrName ==)
@@ -103,7 +107,7 @@
 
 -- | process the attribute list of a specific tag
 processAttrsA ::
-   (Name.Tag name, Name.Attribute name, Eq name, Applicative m) =>
+   (Name.Tag name, Name.Attribute name, Applicative m) =>
    (Tag.Name name -> Bool) ->
    ([Attr.T name str] -> m [Attr.T name str]) ->
    (T name str -> m (T name str))
@@ -113,7 +117,7 @@
       if p tagName then f else App.pure)
 
 processAttrValueA ::
-   (Name.Tag name, Name.Attribute name, Eq name, Applicative m) =>
+   (Name.Tag name, Name.Attribute name, Applicative m) =>
    (Tag.Name name, Attr.Name name) ->
    (str -> m str) ->
    (T name str -> m (T name str))
@@ -122,7 +126,7 @@
       (Attr.adjustOnA (attrName==) f)
 
 processAttrValueCondA ::
-   (Name.Tag name, Name.Attribute name, Eq name, Applicative m) =>
+   (Name.Tag name, Name.Attribute name, Applicative m) =>
    (Tag.Name name, Attr.Name name) ->
    ([Attr.T name str] -> Bool) ->
    (str -> m str) ->
@@ -134,7 +138,7 @@
          attrs)
 
 liftA ::
-   (Name.Tag name, Name.Attribute name, Eq name, Applicative m) =>
+   (Name.Tag name, Name.Attribute name, Applicative m) =>
    (Tag.Name name -> [Attr.T name str] ->
       m (Tag.Name name, [Attr.T name str])) ->
    (T name str -> m (T name str))
@@ -146,15 +150,15 @@
 -- * format
 
 format ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
-   (Tag.Name name -> Bool) -> ShowS -> T name XmlString.T -> [ShowS] -> ShowS
-format isCondensed trailingSlash (Cons tagName attrs) showSubTrees =
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   (Tag.Name name -> Bool) -> ShowS -> T name string -> [ShowS] -> ShowS
+format isCondensed trailingSlash (Cons tagName attrs) formatSubTrees =
    let t = Name.toString tagName
    in  if isCondensed tagName
-         then ShowXML.angle
+         then Format.angle
                (showString t . Attr.formatListBlankHead attrs
                  . trailingSlash)
-         else ShowXML.angle
+         else Format.angle
                (showString t . Attr.formatListBlankHead attrs)
-               . foldr (.) id showSubTrees
-               . ShowXML.angle (ShowXML.slash . showString t)
+               . foldr (.) id formatSubTrees
+               . Format.angle (Format.slash . showString t)
diff --git a/src/Text/XML/WraXML/Tree.hs b/src/Text/XML/WraXML/Tree.hs
--- a/src/Text/XML/WraXML/Tree.hs
+++ b/src/Text/XML/WraXML/Tree.hs
@@ -27,10 +27,7 @@
 import           Data.Maybe (mapMaybe, fromMaybe, )
 import           Data.Monoid (Monoid, mempty, mappend, mconcat, )
 
-import qualified Text.XML.Basic.Format as ShowXML
-import qualified Text.Show as Show
-
-import Prelude hiding (show, shows)
+import qualified Text.XML.Basic.Format as Format
 
 
 {- * data structures -}
@@ -69,23 +66,23 @@
    showsPrec prec x =
       showParen (prec>=10) $
       case x of
-         Text   _ str -> Show.showString "Text "    . Show.showsPrec 11 str
-         Comment  str -> Show.showString "Comment " . Show.showsPrec 11 str
-         CData    str -> Show.showString "CData "   . Show.showsPrec 11 str
+         Text   _ str -> showString "Text "    . showsPrec 11 str
+         Comment  str -> showString "Comment " . showsPrec 11 str
+         CData    str -> showString "CData "   . showsPrec 11 str
          PI target p  ->
---            Show.showString "ProcessingInstruction " .
-            Show.showString "PI " .
-            Show.showsPrec 11 target . Show.showString " " .
-            Show.showsPrec 11 p
+--            showString "ProcessingInstruction " .
+            showString "PI " .
+            showsPrec 11 target . showString " " .
+            showsPrec 11 p
          {- Maybe it is better to attach warnings to malicious tags
             instead of throwing them into the tag soup.
             But how to tell the position of the error then? -}
-         Warning  str -> Show.showString "Warning " . Show.showsPrec 11 str
+         Warning  str -> showString "Warning " . showsPrec 11 str
 
 
-{- * Name data type -}
-
 {-
+-- * Name data type
+
 A name can only consist of (7-bit) ASCII characters.
 It is used both for tag names and for attribute names.
 newtype Name = Name String
@@ -182,25 +179,6 @@
 
 {- * Conversions -}
 
-maybeTag :: T i name str -> Maybe (Elem.T name str, [T i name str])
-maybeTag (Cons (_,t)) =
-   case t of
-      Tree.Branch (Tag elm) subTrees ->
-           Just (elm, map wrap subTrees)
-      _ -> Nothing
-
-maybeText :: T i name str -> Maybe str
-maybeText (Cons (_,t)) =
-   case t of
-      Tree.Leaf l -> maybeTextLeaf l
-      _           -> Nothing
-
-maybeTextLeaf :: Leaf name str -> Maybe str
-maybeTextLeaf t =
-   case t of
-      Text _ s -> Just s
-      _        -> Nothing
-
 liftTrans :: (a -> b) -> (a -> [b])
 liftTrans f = (:[]) . f
 
@@ -262,13 +240,32 @@
 If the Tree is a Leaf, then return False.
 Otherwise return the result of the predicate.
 -}
-checkTreeTag :: (Elem.T name str -> Bool) -> (T i name str -> Bool)
-checkTreeTag p =
+checkTag :: (Elem.T name str -> Bool) -> (T i name str -> Bool)
+checkTag p =
    Tree.switch (flip const) (const . p . getElement) (const False)
     . unwrap
 
+maybeTag :: T i name str -> Maybe (Elem.T name str, [T i name str])
+maybeTag (Cons (_,t)) =
+   case t of
+      Tree.Branch (Tag elm) subTrees ->
+           Just (elm, map wrap subTrees)
+      _ -> Nothing
 
+maybeText :: T i name str -> Maybe str
+maybeText (Cons (_,t)) =
+   case t of
+      Tree.Leaf l -> maybeTextLeaf l
+      _           -> Nothing
 
+maybeTextLeaf :: Leaf name str -> Maybe str
+maybeTextLeaf t =
+   case t of
+      Text _ s -> Just s
+      _        -> Nothing
+
+
+
 {- * types of processors -}
 
 type Filter i name str = T i name str -> T i name str
@@ -303,7 +300,7 @@
 
 
 mapTag ::
-   (Elem.T name str -> Elem.T name str) ->
+   (Elem.Filter name str) ->
    (Filter i name str)
 mapTag f =
    lift $
@@ -324,7 +321,7 @@
 
 mapCond ::
    (Elem.T name str -> Bool) ->
-   (Elem.T name str -> Elem.T name str) ->
+   (Elem.Filter name str) ->
    (Leaf name str -> Leaf name str) ->
    (Filter i name str)
 mapCond descend elemF txtF =
@@ -422,7 +419,7 @@
 
 
 
-{- * monadic tree processors -}
+{- * applicative functor tree processors -}
 
 instance Foldable (T i name) where
    foldMap f =
@@ -475,6 +472,11 @@
 unescape :: T i name XmlString.T -> T i name String
 unescape = fmap XmlString.toUnicodeString
 
+{- |
+Use ASCII characters, XML entity references and character references
+for representing strings.
+That's not human readable, but portable.
+-}
 escape :: T i name String -> T i name XmlString.T
 escape = fmap XmlString.fromUnicodeString
 
@@ -484,7 +486,7 @@
 Decode characters like those from UTF-8 scheme.
 -}
 decodeSpecialChars ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    String -> T i name XmlString.T -> [T i name String]
 decodeSpecialChars enc tree =
    fromMaybe
@@ -492,7 +494,7 @@
       (maybeDecodeSpecialChars enc tree)
 
 maybeDecodeSpecialChars ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    String -> T i name XmlString.T -> Maybe [T i name String]
 maybeDecodeSpecialChars enc tree =
    fmap (flip decodeSpecialCharsDecoder tree) $
@@ -508,7 +510,7 @@
 Conversion errors are appended as warnings to the tree.
 -}
 decodeSpecialCharsDecoder ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    Unicode.DecodingFctEmbedErrors -> T i name XmlString.T -> [T i name String]
 decodeSpecialCharsDecoder decode =
    let xmlDecode =
@@ -541,7 +543,7 @@
        unwrap
 
 decodeAttrs ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    (XmlString.T -> XmlString.EmbeddedExceptions) ->
    [Attr.T name XmlString.T] -> Writer [String] [Attr.T name String]
 decodeAttrs xmlDecode =
@@ -550,7 +552,7 @@
          traverse  (decodeAttr xmlDecode (Attr.name_ attr)) attr)
 
 decodeAttr ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    (XmlString.T -> XmlString.EmbeddedExceptions) ->
    Attr.Name name -> XmlString.T -> Writer [String] String
 decodeAttr decode name =
@@ -567,41 +569,42 @@
 
 {- * Formatting -}
 
-
+{-
 show ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
+   (Name.Tag name, Name.Attribute name) =>
    T i name XmlString.T -> String
 show leaf = shows leaf ""
+-}
 
-showsMany ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
-   [T i name XmlString.T] -> ShowS
-showsMany = ShowXML.many shows
+formatMany ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   [T i name string] -> ShowS
+formatMany = Format.many format
 
 -- cf. src/Text/XML/HXT/DOM/XmlTreeFunctions.hs
-shows ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
-   T i name XmlString.T -> ShowS
-shows =
-   Tree.fold (flip const) showBranch showLeaf . unwrap
+format ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   T i name string -> ShowS
+format =
+   Tree.fold (flip const) formatBranch formatLeaf . unwrap
 
-showBranch ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
-   Branch name XmlString.T -> [ShowS] -> ShowS
-showBranch branch showSubTrees =
+formatBranch ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   Branch name string -> [ShowS] -> ShowS
+formatBranch branch formatSubTrees =
    case branch of
       Tag elm ->
          Elem.format
-            (\_tagName -> null showSubTrees)
-            ShowXML.slash
-            elm showSubTrees
+            (\_tagName -> null formatSubTrees)
+            Format.slash
+            elm formatSubTrees
 
-showLeaf ::
-   (Name.Tag name, Name.Attribute name, Eq name) =>
-   Leaf name XmlString.T -> ShowS
-showLeaf leaf =
+formatLeaf ::
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+   Leaf name string -> ShowS
+formatLeaf leaf =
    case leaf of
-      Text _ str -> ShowXML.run str
+      Text _ str -> Format.run str
       Comment c ->
          showString "<!--" . showString c . showString "-->"
       Warning e ->
@@ -609,8 +612,18 @@
       CData str ->
          showString "<![CDATA[" . showString str . showString "]]>"
       PI target p ->
-         ShowXML.angle $
-         ShowXML.quest .
-         ShowXML.name target .
-         ShowXML.run p .
-         ShowXML.quest
+         Format.angle $
+         Format.quest .
+         Format.name target .
+         Format.run p .
+         Format.quest
+
+instance
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+      Format.C (T i name string) where
+   run = format
+
+instance
+   (Name.Tag name, Name.Attribute name, Format.C string) =>
+      Format.C (Leaf name string) where
+   run = formatLeaf
diff --git a/src/Text/XML/WraXML/Tree/HXT.hs b/src/Text/XML/WraXML/Tree/HXT.hs
--- a/src/Text/XML/WraXML/Tree/HXT.hs
+++ b/src/Text/XML/WraXML/Tree/HXT.hs
@@ -1,9 +1,6 @@
 module Text.XML.WraXML.Tree.HXT
    (fromXmlTree, toXmlTree, lift, liftFilterToDocument,
-    tidyHTML, showHTML, fromHTMLString, fromHTMLStringMetaEncoding,
-    errorAnnFromHTMLStringMetaEncoding,
-    errorAnnFromHTMLStringOpt, ErrorMsg,
-    getMetaHTTPHeaders) where
+    checkTagName, ) where
 
 import qualified Text.XML.HXT.DOM.TypeDefs as HXT
 -- import qualified Text.XML.HXT.DOM.XmlTreeFunctions as HXTTreeFunc
@@ -13,7 +10,6 @@
    (Branch(Tag), Leaf(Text, PI, Comment, Warning, CData), )
 import qualified Text.XML.WraXML.Element as Elem
 
-import qualified Text.HTML.WraXML.Tree   as HTMLTree
 import qualified Text.XML.WraXML.Tree    as XmlTree
 import qualified Data.Tree.BranchLeafLabel as Tree
 
@@ -21,34 +17,20 @@
 import qualified Text.XML.WraXML.String.HXT as HXTString
 
 import qualified Text.XML.Basic.Attribute as Attr
-import qualified Text.XML.Basic.Name.LowerCase as NameLC
 import qualified Text.XML.Basic.Name as Name
 import qualified Text.XML.Basic.ProcessingInstruction as PI
 
 import qualified Text.XML.Basic.Character as XMLChar
-import qualified Text.XML.Basic.Format    as ShowXML
 
 -- needed for code copies from HXT at the of the file
-import Text.XML.HXT.DOM.XmlTree hiding (cmt)
-import Text.XML.HXT.DOM.XmlState
-import Text.XML.HXT.Parser.XmlParser  (parseXmlDocEncodingSpec)
-import Text.XML.HXT.Parser.XmlInput   (guessDocEncoding)
-import Text.XML.HXT.Parser.XmlOutput  (traceTree, traceSource, traceMsg)
-import Text.XML.HXT.Parser.HtmlParser (parseHtmlDoc)
-import Text.XML.HXT.Parser.HtmlParsec (isEmptyHtmlTag)
-import Text.XML.HXT.DOM.EditFilters   (escapeXmlDoc)
-import Text.XML.HXT.DOM.ShowXml       (xshow, {- showXmlTree, showQName, -})
+import Text.XML.HXT.DOM.XmlTree (QName, NTree, XNode, )
 import Text.XML.HXT.DOM.QualifiedName (qualifiedName)
-import Data.Tree.NTree.Filter         (liftMf)
 
-import Control.Monad (msum, )
-import Data.Maybe (fromMaybe, )
 
-
 {- * conversion from our XML tree to HXT tree -}
 
 fromXmlTree ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name XmlString.T -> HXT.XmlTree
 fromXmlTree x =
    case multiFromXmlTree x of
@@ -68,7 +50,7 @@
                (HXTString.fromXmlString $ Attr.value_ a))
 
 multiFromXmlTree ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name XmlString.T -> [HXT.XmlTree]
 multiFromXmlTree =
    Tree.fold
@@ -102,7 +84,7 @@
 {- * conversion from HXT tree to our XML tree -}
 
 toXmlTree, toXmlTree' ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    HXT.XmlTree -> XmlTree.T () name XmlString.T
 toXmlTree = XmlTree.mergeStrings . toXmlTree'
 
@@ -153,7 +135,7 @@
 {- * lift our XML filters to HXT filters -}
 
 lift ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.Filter () name XmlString.T -> (HXT.XmlTree -> HXT.XmlTree)
 lift f = fromXmlTree . f . toXmlTree
 
@@ -162,7 +144,7 @@
 Lift our XML filters to HXT document processors.
 -}
 liftFilterToDocument ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
       String  {- ^ Name of root tag for processing, e.g. "html".
                    That tag must be in the first level.
                    It is an unchecked run-time error
@@ -193,265 +175,4 @@
 but not using its XML tree structure for manipulations.
 This way I hope I can keep in sync with the main development path
 while not interfering with HXT's typing style.
--}
-
-
-
-{- |
-Tidy a piece of HTML code.
-&   ->   &amp;
-<   ->   &lt;
-unquoted tag attribute values: size=-1   ->   size="-1"
-insert omitted closing tags
--}
-tidyHTML :: String -> IO String
-tidyHTML input =
-   -- escapeXmlDoc replaces < by &lt; and so on
-   -- XmlParsec.substXmlEntities similar to escapeXmlDoc ?
-   fmap (($"") . showHTMLTrees . (escapeXmlDoc .> getChildren))
-        (fromHTMLString input)
-
-
-{- |
-Like 'Text.XML.HXT.DOM.XmlTreeFunctions.xshow'
-but it shows empty tags the HTML way.
-E.g. it emits @<br>@ instead of @<br\/>@,
-@<noscript><\/noscript>@ instead of @<noscript\/>@.
-Many browsers prefer that.
--}
-showHTML :: HXT.XmlTree -> String
-showHTML leaf = showHTMLTrees (HXTTree.getChildren leaf) ""
-
-showHTMLTrees	:: HXT.XmlTrees -> ShowS
-showHTMLTrees	= foldr (.) id . map showHTMLTree
-
-
--- cf. src/Text/XML/HXT/DOM/XmlTreeFunctions.hs
-showHTMLTree	:: HXT.XmlTree -> ShowS
-showHTMLTree leaf =
-   case leaf of
-      (NTree (XPi n al) _) ->
-         showString "<?"
-         .
-         showQName n
-         .
-         (foldr (.) id . map showPiAttr) al
-         .
-         showString "?>"
-           where
-             showPiAttr :: HXT.XmlTree -> String -> String
-             showPiAttr a@(NTree (XAttr an) cs) =
-	         if aName an == a_value
-	           then ShowXML.blank . showHTMLTrees cs
-	           else showHTMLTree a
-             showPiAttr _ = id
-      (NTree (XTag t al) cs) ->
-         if null cs && isEmptyHtmlTag (HXT.qualifiedName t)
-           then ShowXML.lt . showQName t . showHTMLTrees al . ShowXML.gt
-           else ShowXML.lt . showQName t . showHTMLTrees al . ShowXML.gt
-                 . showHTMLTrees cs
-                 . ShowXML.lt . ShowXML.slash . showQName t . ShowXML.gt
-      (NTree (XAttr an) cs) ->
-         ShowXML.blank . showQName an . ShowXML.eq . ShowXML.stringQuoted (showHTMLTrees cs "")
-      (NTree (XError l e) _) ->
-         showString "<!-- ERROR (" . showString (show l) . showString "):\n"
-          . showString e . showString "\n-->"
-      _ -> (xshow [leaf] ++) -- showXmlTree leaf
-
-
-showQName :: QName -> ShowS
-showQName = showString . qualifiedName
-
-
-
-{- |
-An input handler alternative
-to Text.XML.HXT.Parser.ProtocolHandlerFile.
-It returns the argument string as something
-that can be further processed by HXT functions.
--}
-getStringContents :: String -> XmlStateFilter a
-getStringContents contents =
-   return . replaceChildren (xtext contents)
-   .>>
-   {- We must attach some encoding info to the tree
-      which is processed by the HTML parser.
-      Using this encoding information
-      the HTML parser converts e.g. UTF-8 characters to Unicode characters.
-      Cf. Parser.XmlInput.getXmlContents -}
-   liftF parseXmlDocEncodingSpec
-   .>>
-   guessDocEncoding
-
-
-{- |
-Search for a META tag for the encoding of the HTML text.
--}
-findMetaEncoding :: String -> IO (Maybe String)
-findMetaEncoding str =
-   do htmlTrees <- xmlTreesFromHTMLString str
-      return (msum (map HTMLTree.findMetaEncoding (htmlTrees :: [XmlTree.T () NameLC.T String])))
-
-getMetaHTTPHeaders :: String -> IO [(String, String)]
-getMetaHTTPHeaders str =
-   do htmlTrees <- xmlTreesFromHTMLString str
-      return (concatMap HTMLTree.getMetaHTTPHeaders (htmlTrees :: [XmlTree.T () NameLC.T String]))
-
-xmlTreesFromHTMLString ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   String -> IO [XmlTree.T () name String]
-xmlTreesFromHTMLString str =
-   do hxtTree <- fromHTMLString str
-      -- it will hopefully be only one HTML tree
-      return $
-         map (XmlTree.unescape . toXmlTree)
-             (filter (checkTagName "html" . HXTTree.getNode)
-                     (HXTTree.getChildren hxtTree))
-
-
-{- |
-Guess the encoding from the META-HTTP-EQUIV attribute, if available.
-Otherwise fall back to ISO-Latin-1.
--}
-fromHTMLStringMetaEncoding :: String -> IO HXT.XmlTree
-fromHTMLStringMetaEncoding str =
-   do enc <- findMetaEncoding str
-      fromHTMLStringOpt [(a_encoding, fromMaybe isoLatin1 enc)] str
-
-{-
-With no encoding option given,
-utf8ToUnicode fails when trying to interpret ISO-Latin characters as UTF-8 characters
--}
-fromHTMLString :: String -> IO HXT.XmlTree
-fromHTMLString = fromHTMLStringOpt [(a_encoding, isoLatin1)]
-
-fromHTMLStringOpt :: Attributes -> String -> IO HXT.XmlTree
-fromHTMLStringOpt options input =
-   do (tree,_,_) <- errorAnnFromHTMLStringOpt options input
-      return tree
-
-type ErrorMsg = (Int,String)
-
-errorAnnFromHTMLStringMetaEncoding ::
-   String -> IO (HXT.XmlTree, [ErrorMsg], Int)
-errorAnnFromHTMLStringMetaEncoding str =
-   do enc <- findMetaEncoding str
-      errorAnnFromHTMLStringOpt [(a_encoding, fromMaybe isoLatin1 enc)] str
-
-{- |
-Adaption of Text.XML.HXT.Parser.MainFunctions.getXmlDocument
--}
-errorAnnFromHTMLStringOpt ::
-   Attributes -> String -> IO (HXT.XmlTree, [ErrorMsg], Int)
-errorAnnFromHTMLStringOpt options contents =
-   do
-      let options' =
-             (a_collect_errors, v_1) :	-- collect errors
-	     (a_issue_errors,   v_0) :	-- but don't issue
-	    				-- can be overwritten by supporting other values in options
-             options
-      (root:errs) <- run' $ parseDocument options' contents emptyRoot
-      let elvl = intValueOf a_status root
-      let errMsgs = map ((\(XError level msg) -> (level, msg)) . getNode) errs
-      return (root, errMsgs, elvl)
-
-
-
-{- |
-Adaption of Text.XML.HXT.Parser.MainFunctions.parseDocument
--}
-parseDocument :: Attributes -> String -> XmlStateFilter state
-parseDocument userOptions contents
-    = processDocument userOptions defaultOptions
-      ( traceMsg 1 "parseDocument: options added, start processing"
-	.>>
-	traceTree
-	.>>
-	getStringContents contents		-- get the content as text
-	.>>
-	parseHtmlDoc				-- parse everything as HTML
-	.>>
---        liftMf canonicalizeForXPath
---	.>>
-	traceMsg 1 "parseDocument: document processed"	-- trace output
-	.>>
-	traceSource
-	.>>
-	traceTree
-      )
-    where
-    defaultOptions
-	= [ ( a_parse_html,		v_1 )
-	  , ( a_validate,		v_1 )
-	  , ( a_issue_errors,		v_1 )
-	  , ( a_issue_warnings,		v_1 )
-	  , ( a_check_namespaces,	v_0 )
-	  , ( a_canonicalize,		v_1 )
-	  , ( a_preserve_comment,	v_0 )
-	  , ( a_remove_whitespace,	v_0 )
-	  ]
-
-
-{- |
-Copy of Text.XML.HXT.Parser.MainFunctions.addOptions add addDefaultOptions
--}
-addOptions	  :: Attributes -> XmlFilter
-addOptions
-    = seqF . map (uncurry addAttr)
-
-addDefaultOptions :: Attributes -> XmlFilter
-addDefaultOptions
-    = seqF . map (\ (n,v) -> addAttr n v `whenNot` hasAttr n)
-
-
-{- |
-Copy of Text.XML.HXT.Parser.MainFunctions.processDocument
--}
-processDocument	:: Attributes -> Attributes -> XmlStateFilter state -> XmlStateFilter state
-processDocument userOptions defaultOptions processFilter
-    = liftMf isRoot
-      .>>
-      liftMf (addOptions userOptions
-	      .>
-	      addOptions [(a_status, show c_ok)]
-	     )
-      .>>
-      liftMf (addDefaultOptions defaultOptions)
-      .>>
-      setSystemParams							-- store options in system state
-      .>>
-      choiceM
-      [ hasOption a_propagate_errors					-- error handling is set by calling environment
-		:-> thisM
-
-      , hasOption a_collect_errors
-	.>
-	hasOption a_issue_errors
-		:-> performAction (\ _ -> setSysErrorHandler (errorMsgLogging.>> errorMsgToStderr)	)
-
-      , hasOption a_collect_errors
-		:-> performAction (\ _ -> setSysErrorHandler errorMsgLogging	)
-
-      , hasOption a_issue_errors
-		:-> performAction (\ _ -> setSysErrorHandler errorMsgToStderr	)
-
-      , this
-		:-> performAction (\ _ -> setSysErrorHandler noneM		)
-      ]
-      .>>
-      processFilter
-      .>>
-      ( thisM
-        +++>>
-	( hasOption a_collect_errors
-          `guardsM`
-	  getErrorMsg
-	)
-      )
-
-
-{-
-putStr . xshow =<< run' (Text.XML.HXT.Parser.MainFunctions.parseDocument [(a_source,"lousy.html"), (a_parse_html,v_1)] emptyRoot)
-
-readFile "lousy.html" >>= tidy >>= putStr
 -}
diff --git a/src/Text/XML/WraXML/Tree/HaXml.hs b/src/Text/XML/WraXML/Tree/HaXml.hs
--- a/src/Text/XML/WraXML/Tree/HaXml.hs
+++ b/src/Text/XML/WraXML/Tree/HaXml.hs
@@ -26,7 +26,7 @@
 {- * conversion from our XML tree to HaXml tree -}
 
 fromXmlTree ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name XmlString.T -> HaXml.Content i
 fromXmlTree x =
    case multiFromXmlTree x of
@@ -34,7 +34,7 @@
       _   -> error "top branch can't be a string"
 
 multiFromXmlTree ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name XmlString.T -> [HaXml.Content i]
 multiFromXmlTree =
    Tree.fold
@@ -70,7 +70,7 @@
 {- * conversion from HaXml tree to our XML tree -}
 
 toXmlTree, toXmlTree' ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    HaXml.Content i -> XmlTree.T i name XmlString.T
 toXmlTree = XmlTree.mergeStrings . toXmlTree'
 
@@ -98,7 +98,7 @@
 {- * lift our XML filters to HaXml filters -}
 
 lift ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.Filter i name XmlString.T -> (HaXml.Content i -> HaXml.Content i)
 lift f = fromXmlTree . f . toXmlTree
 
@@ -118,7 +118,7 @@
         _                -> error "produced wrong output"
 
 liftFilterToDocument ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    FilePath -> XmlTree.Filter Posn name XmlString.T ->
       (HaXml.Document Posn -> HaXml.Document Posn)
 liftFilterToDocument file =
@@ -127,6 +127,6 @@
 
 
 processWith ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.Filter Posn name XmlString.T -> IO ()
 processWith = HaXml.processXmlWith . XmlTree.liftTrans . lift
diff --git a/src/Text/XML/WraXML/Tree/TagSoup.hs b/src/Text/XML/WraXML/Tree/TagSoup.hs
--- a/src/Text/XML/WraXML/Tree/TagSoup.hs
+++ b/src/Text/XML/WraXML/Tree/TagSoup.hs
@@ -72,7 +72,7 @@
 -}
 
 toXmlTreesString ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    [Tag] -> [XmlTree name String]
 toXmlTreesString =
    toXmlTreesAux .
@@ -83,7 +83,7 @@
 
 
 toXmlTreesAux ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    [PosTag] -> [XmlTree name String]
 toXmlTreesAux =
    fst . Parser.runParser (ParserU.manyLazy parseBranch)
@@ -94,7 +94,7 @@
 
 
 parseBranch ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    Parser i (XmlTree.T i name String)
 parseBranch =
    do (ti,t) <- Parser.next
@@ -119,7 +119,7 @@
                       "unexpected end of file") (Name.fromString name))
          TagClose name ->
             let makeWarning ::
-                   (Name.Tag name, Ord name) =>
+                   (Name.Tag name) =>
                    i -> TagH.Name name -> XmlTree.T i name String
                 makeWarning i n =
                    XmlTree.warningIndex i $
@@ -141,7 +141,7 @@
 
 
 parseSubTrees ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    XmlTree.T i name String -> TagH.Name name -> Parser i [XmlTree.T i name String]
 parseSubTrees warn name =
    ParserU.force $
@@ -156,7 +156,7 @@
 
 
 parseTerminator ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
+   (Name.Tag name, Name.Attribute name) =>
    TagH.Name name -> Parser i [XmlTree.T i name String]
 parseTerminator name =
    do c@(ci,ct) <- Parser.next
diff --git a/src/Text/XML/WraXML/Tree/TagSoupHT.hs b/src/Text/XML/WraXML/Tree/TagSoupHT.hs
deleted file mode 100644
--- a/src/Text/XML/WraXML/Tree/TagSoupHT.hs
+++ /dev/null
@@ -1,236 +0,0 @@
-{- |
-Very lazy HTML tree parser using TagSoup as lexer.
--}
-module Text.XML.WraXML.Tree.TagSoupHT (
-   toXmlTrees,
-   fromXmlTree,
-   fromElement, fromLeaf,
-   liftElementFilter, liftElementCheck,
-   example,
-   ) where
-
-import qualified Text.HTML.TagSoup.HT.Parser      as TagParser
-import qualified Text.HTML.TagSoup.HT.Tag         as Tag
-import qualified Text.HTML.TagSoup.HT.PositionTag as PosTag
-import qualified Text.HTML.TagSoup.HT.Tag.Match   as MatchTag
-
-import qualified Text.XML.WraXML.Element          as Elem
-import qualified Text.XML.WraXML.Tree             as XmlTree
-import qualified Data.Tree.BranchLeafLabel        as Tree
-
-import qualified Text.HTML.Basic.Tag as TagH
-
-import qualified Text.XML.Basic.Position    as Position
-import qualified Text.XML.Basic.Name.LowerCase as NameLC
-import qualified Text.XML.Basic.Name           as Name
-
--- import Control.Monad.Trans.State (evalState, put, get, gets, )
-import Control.Monad.Trans.Writer (runWriter, writer, )
-
-import Data.Monoid (Last(Last, getLast), )
-import Data.Maybe (fromMaybe, )
-import Data.Bool.HT (select, )
-
-import qualified Text.XML.WraXML.Tree.LazyParser as ParserU
-import qualified Text.ParserCombinators.PolyLazy as Parser
-
-import Control.Monad (liftM, )
-
-
--- we don't use XmlTree synonym in the exported functions for documentation purposes
-type XmlTree name string = XmlTree.T Position.T name string
-
-
-{-
--- FIXME: how to get rid of 'error' ?
-fromXmlTree' ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XmlTree.T Position.T name string -> [PosTag.T name string]
-fromXmlTree' =
-   flip evalState (error "position not initialised, yet") .
-   Tree.fold
-      (\pos x -> put pos >> x)
-      (\branch subTreesM ->
-          do pos <- get
-             subTrees <- sequence subTreesM
-             lastPos <- get
-             
-             let elm = XmlTree.getElement branch
-                 openTag =
-                    PosTag.cons pos $ fromElement elm
-                 closeTag =
-                    PosTag.cons lastPos $
-                    Tag.Close $ Elem.name_ elm
-             return $ openTag : concat subTrees ++ [closeTag])
-
-      (\leaf ->
-          gets (\pos -> [PosTag.cons pos $ fromLeaf leaf]))
-   .
-   XmlTree.unwrap
--}
-
-fromXmlTree ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XmlTree.T Position.T name string -> [PosTag.T name string]
-fromXmlTree =
-   fst . runWriter .
-   Tree.foldLabel
-      (\pos branch subTreesM ->
-          let (subTrees, lastSubPos) = runWriter $ sequence subTreesM
-              lastPos = fromMaybe pos $ getLast lastSubPos
-              elm = XmlTree.getElement branch
-              openTag =
-                 PosTag.cons pos $ fromElement elm
-              closeTag =
-                 PosTag.cons lastPos $
-                 Tag.Close $ Elem.name_ elm
-          in  writer (openTag : concat subTrees ++ [closeTag],
-                      Last $ Just lastPos))
-      (\pos leaf ->
-          writer $ flip (,) (Last $ Just pos) $
-          [PosTag.cons pos $ fromLeaf leaf])
-   .
-   XmlTree.unwrap
-
-fromElement ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   Elem.T name string -> Tag.T name string
-fromElement elm =
-   Tag.Open (Elem.name_ elm) (Elem.attributes_ elm)
-
-fromLeaf ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XmlTree.Leaf name string -> Tag.T name string
-fromLeaf leaf =
-   case leaf of
-      XmlTree.Text  _ text -> Tag.Text text
-      XmlTree.Comment text -> Tag.Comment text
-      XmlTree.CData   text -> Tag.Special TagH.cdata text
-      XmlTree.PI      name instr -> Tag.Processing name instr
-      XmlTree.Warning text -> Tag.Warning text
-
-
-liftElementFilter ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   (Elem.T name str -> Elem.T name str) ->
-   Tag.T name str -> Tag.T name str
-liftElementFilter f tag =
-   flip (maybe tag) (Tag.maybeOpen tag) $
-   fromElement . f . uncurry Elem.Cons
-
-liftElementCheck :: (Elem.T name string -> Bool) -> (Tag.T name string -> Bool)
-liftElementCheck f tag =
-   flip (maybe False) (Tag.maybeOpen tag) $
-   f . uncurry Elem.Cons
-
-
-
-{- |
-A TagSoup could represent multiple HTML trees,
-e.g. with some introducing comments.
--}
-toXmlTrees ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   [PosTag.T name string] -> [XmlTree.T Position.T name string]
-toXmlTrees =
-   fst . Parser.runParser (ParserU.manyLazy parseBranch)
-
-
-type Parser name string a = Parser.Parser (PosTag.T name string) a
-
-
-parseBranch ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   Parser name string (XmlTree name string)
-parseBranch =
-   do nt <- Parser.next
-      let ti = PosTag.position_ nt
-      case PosTag.tag_ nt of
-         Tag.Text text -> return (XmlTree.literalIndex ti text)
-         Tag.Open name attrs ->
-            liftM
-               (XmlTree.tagIndexAttr ti name attrs)
-               (parseSubTrees
-                  (XmlTree.warningIndex ti
-                      "unexpected end of file") name)
-         Tag.Close name ->
-            return $ XmlTree.warningIndex ti $
-            if TagH.isSloppy name
-              then "misplaced sloppy closing tag </" ++ Name.toString name ++ ">"
-              else "isolated closing tag </" ++ Name.toString name ++ ">"
-         Tag.Comment cmt ->
-            return (XmlTree.commentIndex ti cmt)
-         Tag.Warning msg ->
-            return (XmlTree.warningIndex ti msg)
-         Tag.Processing target p ->
-            return (XmlTree.processingIndex ti target p)
-         Tag.Special name str ->
-            return $
-            if Name.match TagH.cdataString name
-              then XmlTree.cdataIndex ti str
-              else XmlTree.warningIndex ti $
-                      "Special tag " ++ Name.toString name ++
-                      " not allowed within a HTML document"
-
-
-parseSubTrees ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   XmlTree name string -> TagH.Name name ->
-   Parser name string [XmlTree name string]
-parseSubTrees warn name =
-   ParserU.force $
-   if TagH.isEmpty name
-     then
-       (Parser.satisfy (MatchTag.close (name==) . PosTag.tag_) >> return [])
-         `Parser.onFail` return []
-     else
-       ParserU.manyFinallyAppend
-          (parseTerminator name)
-          warn parseBranch
-
-
-parseTerminator ::
-   (Name.Tag name, Name.Attribute name, Ord name) =>
-   TagH.Name name -> Parser name string [XmlTree name string]
-parseTerminator name =
-   do c <- Parser.next
-      let ci = PosTag.position_ c
-          retry warns = Parser.reparse [c] >> return warns
-      case PosTag.tag_ c of
-         Tag.Close closeName ->
-            flip select
-               ((TagH.isEmpty closeName,
-                    fail $ "the tag <" ++ Name.toString closeName ++ "> closes nothing.") :
-                (name `TagH.isInnerOf` closeName, retry []) :
-                (name==closeName, return []) :
-                (TagH.isSloppy name,
-                 retry [XmlTree.warningIndex ci $
-                           "sloppy tag <"
-                           ++ Name.toString name ++ "> closed by </"
-                           ++ Name.toString closeName ++ ">"]) :
-                (TagH.isSloppy closeName,
-                 fail $ "ignore sloppy closing tag </" ++ Name.toString name ++ ">") :
-                [])
-               (return [XmlTree.warningIndex ci $
-                            "open tag <" ++ Name.toString name ++
-                            "> and close tag </" ++ Name.toString closeName ++
-                            "> do not match"])
-         Tag.Open openName _ ->
-            if openName `TagH.closes` name
-              then retry []
-              else fail $
-                      "open tag <" ++ Name.toString openName ++
-                      "> does not close tag <" ++ Name.toString name ++ ">"
-         _ -> fail $ "not a termination of a tag"
-
-
-example ::
-   [XmlTree NameLC.T String]
-example =
-   toXmlTrees $
-   TagParser.runSoupWithPositions $
---   "<html><head>blub<meta/></head><br><body>bla</body></html>"
---   "<html><head>blub<meta/></head><br><body>bla<UL><li>1.<li>2.</OL><TABLE border=1></TABLE></body></html>"
---   "<html><head><meta>too much</meta>blub<meta/></head><br><body>bla<UL><li>1.<li>2.</UL><TABLE border=1></TABLE></bo"++undefined++"dy></html>"
---    "<b><font>test</b></font>"
-    "<html><b><font>test</b></font></html>"
diff --git a/src/Text/XML/WraXML/Tree/Tagchup.hs b/src/Text/XML/WraXML/Tree/Tagchup.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/XML/WraXML/Tree/Tagchup.hs
@@ -0,0 +1,236 @@
+{- |
+Very lazy HTML tree parser using TagSoup as lexer.
+-}
+module Text.XML.WraXML.Tree.Tagchup (
+   toXmlTrees,
+   fromXmlTree,
+   fromElement, fromLeaf,
+   liftElementFilter, liftElementCheck,
+   example,
+   ) where
+
+import qualified Text.HTML.Tagchup.Parser      as TagParser
+import qualified Text.HTML.Tagchup.Tag         as Tag
+import qualified Text.HTML.Tagchup.PositionTag as PosTag
+import qualified Text.HTML.Tagchup.Tag.Match   as MatchTag
+
+import qualified Text.XML.WraXML.Element          as Elem
+import qualified Text.XML.WraXML.Tree             as XmlTree
+import qualified Data.Tree.BranchLeafLabel        as Tree
+
+import qualified Text.HTML.Basic.Tag as TagH
+
+import qualified Text.XML.Basic.Position    as Position
+import qualified Text.XML.Basic.Name.LowerCase as NameLC
+import qualified Text.XML.Basic.Name           as Name
+
+-- import Control.Monad.Trans.State (evalState, put, get, gets, )
+import Control.Monad.Trans.Writer (runWriter, writer, )
+
+import Data.Monoid (Last(Last, getLast), )
+import Data.Maybe (fromMaybe, )
+import Data.Bool.HT (select, )
+
+import qualified Text.XML.WraXML.Tree.LazyParser as ParserU
+import qualified Text.ParserCombinators.PolyLazy as Parser
+
+import Control.Monad (liftM, )
+
+
+-- we don't use XmlTree synonym in the exported functions for documentation purposes
+type XmlTree name string = XmlTree.T Position.T name string
+
+
+{-
+-- FIXME: how to get rid of 'error' ?
+fromXmlTree' ::
+   (Name.Tag name, Name.Attribute name) =>
+   XmlTree.T Position.T name string -> [PosTag.T name string]
+fromXmlTree' =
+   flip evalState (error "position not initialised, yet") .
+   Tree.fold
+      (\pos x -> put pos >> x)
+      (\branch subTreesM ->
+          do pos <- get
+             subTrees <- sequence subTreesM
+             lastPos <- get
+             
+             let elm = XmlTree.getElement branch
+                 openTag =
+                    PosTag.cons pos $ fromElement elm
+                 closeTag =
+                    PosTag.cons lastPos $
+                    Tag.Close $ Elem.name_ elm
+             return $ openTag : concat subTrees ++ [closeTag])
+
+      (\leaf ->
+          gets (\pos -> [PosTag.cons pos $ fromLeaf leaf]))
+   .
+   XmlTree.unwrap
+-}
+
+fromXmlTree ::
+   (Name.Tag name, Name.Attribute name) =>
+   XmlTree.T Position.T name string -> [PosTag.T name string]
+fromXmlTree =
+   fst . runWriter .
+   Tree.foldLabel
+      (\pos branch subTreesM ->
+          let (subTrees, lastSubPos) = runWriter $ sequence subTreesM
+              lastPos = fromMaybe pos $ getLast lastSubPos
+              elm = XmlTree.getElement branch
+              openTag =
+                 PosTag.cons pos $ fromElement elm
+              closeTag =
+                 PosTag.cons lastPos $
+                 Tag.Close $ Elem.name_ elm
+          in  writer (openTag : concat subTrees ++ [closeTag],
+                      Last $ Just lastPos))
+      (\pos leaf ->
+          writer $ flip (,) (Last $ Just pos) $
+          [PosTag.cons pos $ fromLeaf leaf])
+   .
+   XmlTree.unwrap
+
+fromElement ::
+   (Name.Tag name, Name.Attribute name) =>
+   Elem.T name string -> Tag.T name string
+fromElement elm =
+   Tag.Open (Elem.name_ elm) (Elem.attributes_ elm)
+
+fromLeaf ::
+   (Name.Tag name, Name.Attribute name) =>
+   XmlTree.Leaf name string -> Tag.T name string
+fromLeaf leaf =
+   case leaf of
+      XmlTree.Text  _ text -> Tag.Text text
+      XmlTree.Comment text -> Tag.Comment text
+      XmlTree.CData   text -> Tag.Special TagH.cdata text
+      XmlTree.PI      name instr -> Tag.Processing name instr
+      XmlTree.Warning text -> Tag.Warning text
+
+
+liftElementFilter ::
+   (Name.Tag name, Name.Attribute name) =>
+   (Elem.T name str -> Elem.T name str) ->
+   Tag.T name str -> Tag.T name str
+liftElementFilter f tag =
+   flip (maybe tag) (Tag.maybeOpen tag) $
+   fromElement . f . uncurry Elem.Cons
+
+liftElementCheck :: (Elem.T name string -> Bool) -> (Tag.T name string -> Bool)
+liftElementCheck f tag =
+   flip (maybe False) (Tag.maybeOpen tag) $
+   f . uncurry Elem.Cons
+
+
+
+{- |
+A TagSoup could represent multiple HTML trees,
+e.g. with some introducing comments.
+-}
+toXmlTrees ::
+   (Name.Tag name, Name.Attribute name) =>
+   [PosTag.T name string] -> [XmlTree.T Position.T name string]
+toXmlTrees =
+   fst . Parser.runParser (ParserU.manyLazy parseBranch)
+
+
+type Parser name string a = Parser.Parser (PosTag.T name string) a
+
+
+parseBranch ::
+   (Name.Tag name, Name.Attribute name) =>
+   Parser name string (XmlTree name string)
+parseBranch =
+   do nt <- Parser.next
+      let ti = PosTag.position_ nt
+      case PosTag.tag_ nt of
+         Tag.Text text -> return (XmlTree.literalIndex ti text)
+         Tag.Open name attrs ->
+            liftM
+               (XmlTree.tagIndexAttr ti name attrs)
+               (parseSubTrees
+                  (XmlTree.warningIndex ti
+                      "unexpected end of file") name)
+         Tag.Close name ->
+            return $ XmlTree.warningIndex ti $
+            if TagH.isSloppy name
+              then "misplaced sloppy closing tag </" ++ Name.toString name ++ ">"
+              else "isolated closing tag </" ++ Name.toString name ++ ">"
+         Tag.Comment cmt ->
+            return (XmlTree.commentIndex ti cmt)
+         Tag.Warning msg ->
+            return (XmlTree.warningIndex ti msg)
+         Tag.Processing target p ->
+            return (XmlTree.processingIndex ti target p)
+         Tag.Special name str ->
+            return $
+            if Name.match TagH.cdataString name
+              then XmlTree.cdataIndex ti str
+              else XmlTree.warningIndex ti $
+                      "Special tag " ++ Name.toString name ++
+                      " not allowed within a HTML document"
+
+
+parseSubTrees ::
+   (Name.Tag name, Name.Attribute name) =>
+   XmlTree name string -> TagH.Name name ->
+   Parser name string [XmlTree name string]
+parseSubTrees warn name =
+   ParserU.force $
+   if TagH.isEmpty name
+     then
+       (Parser.satisfy (MatchTag.close (name==) . PosTag.tag_) >> return [])
+         `Parser.onFail` return []
+     else
+       ParserU.manyFinallyAppend
+          (parseTerminator name)
+          warn parseBranch
+
+
+parseTerminator ::
+   (Name.Tag name, Name.Attribute name) =>
+   TagH.Name name -> Parser name string [XmlTree name string]
+parseTerminator name =
+   do c <- Parser.next
+      let ci = PosTag.position_ c
+          retry warns = Parser.reparse [c] >> return warns
+      case PosTag.tag_ c of
+         Tag.Close closeName ->
+            flip select
+               ((TagH.isEmpty closeName,
+                    fail $ "the tag <" ++ Name.toString closeName ++ "> closes nothing.") :
+                (name `TagH.isInnerOf` closeName, retry []) :
+                (name==closeName, return []) :
+                (TagH.isSloppy name,
+                 retry [XmlTree.warningIndex ci $
+                           "sloppy tag <"
+                           ++ Name.toString name ++ "> closed by </"
+                           ++ Name.toString closeName ++ ">"]) :
+                (TagH.isSloppy closeName,
+                 fail $ "ignore sloppy closing tag </" ++ Name.toString name ++ ">") :
+                [])
+               (return [XmlTree.warningIndex ci $
+                            "open tag <" ++ Name.toString name ++
+                            "> and close tag </" ++ Name.toString closeName ++
+                            "> do not match"])
+         Tag.Open openName _ ->
+            if openName `TagH.closes` name
+              then retry []
+              else fail $
+                      "open tag <" ++ Name.toString openName ++
+                      "> does not close tag <" ++ Name.toString name ++ ">"
+         _ -> fail $ "not a termination of a tag"
+
+
+example ::
+   [XmlTree NameLC.T String]
+example =
+   toXmlTrees $
+   TagParser.runSoupWithPositions $
+--   "<html><head>blub<meta/></head><br><body>bla</body></html>"
+--   "<html><head>blub<meta/></head><br><body>bla<UL><li>1.<li>2.</OL><TABLE border=1></TABLE></body></html>"
+--   "<html><head><meta>too much</meta>blub<meta/></head><br><body>bla<UL><li>1.<li>2.</UL><TABLE border=1></TABLE></bo"++undefined++"dy></html>"
+--    "<b><font>test</b></font>"
+    "<html><b><font>test</b></font></html>"
diff --git a/wraxml.cabal b/wraxml.cabal
--- a/wraxml.cabal
+++ b/wraxml.cabal
@@ -1,5 +1,5 @@
 Name:           wraxml
-Version:        0.3
+Version:        0.4
 License:        GPL
 License-File:   LICENSE
 Author:         Henning Thielemann <haskell@henning-thielemann.de>
@@ -9,8 +9,8 @@
 Build-Depends:
   polyparse >=1.1,
   tagsoup >=0.6 && <0.7,
-  tagsoup-ht >=0.3 && <0.4,
-  xml-basic >=0.0.1 && <0.1,
+  tagchup >=0.3 && <0.4,
+  xml-basic >=0.1 && <0.2,
   HaXml >=1.19.4, hxt >=8.1.0 && <9,
   hxt-filter >=8.1.1 && <9,
   transformers >=0.1 && <0.2,
@@ -63,6 +63,7 @@
   Text.HTML.WraXML.Document
   Text.HTML.WraXML.Table
   Text.HTML.WraXML.Tree
+  Text.HTML.WraXML.Tree.HXT
   Text.HTML.WraXML.String
   Text.HTML.WraXML.Entity
   Text.XML.WraXML.Position.HaXml
@@ -74,11 +75,11 @@
   Text.XML.WraXML.Tree.HaXml
   Text.XML.WraXML.Tree.HXT
   Text.XML.WraXML.Tree.TagSoup
-  Text.XML.WraXML.Tree.TagSoupHT
+  Text.XML.WraXML.Tree.Tagchup
   Text.XML.WraXML.Tree.Literal
   Text.XML.WraXML.Document
   Text.XML.WraXML.Document.TagSoup
-  Text.XML.WraXML.Document.TagSoupHT
+  Text.XML.WraXML.Document.Tagchup
 Other-Modules:
   Text.XML.WraXML.Utility
   Text.XML.WraXML.Tree.LazyParser
