diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Tony Day (c) 2023
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Tony Day nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/app/diff.hs b/app/diff.hs
new file mode 100644
--- /dev/null
+++ b/app/diff.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wno-unused-top-binds #-}
+
+module Main (main) where
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.Foldable
+import Data.Function
+import Data.Maybe
+import Data.String.Interpolate
+import Data.TreeDiff
+import MarkupParse
+import MarkupParse.Patch
+import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty.Golden.Advanced (goldenTest)
+import Prelude
+
+main :: IO ()
+main =
+  defaultMain $
+    testGroup
+      "tests"
+      [ goldenTests
+      ]
+
+goldenTests :: TestTree
+goldenTests =
+  testGroup
+    "examples"
+    ( testExample
+        <$> [ (Xml, "other/line.svg"),
+              (Html, "other/ex1.html"),
+              (Html, "other/Parsing - Wikipedia.html")
+            ]
+    )
+
+testExample :: (Standard, FilePath) -> TestTree
+testExample (s, fp) =
+  goldenTest
+    fp
+    (getMarkupFile s fp)
+    (isoMarkdownMarkup s <$> getMarkupFile s fp)
+    (\expected actual -> pure (show . ansiWlEditExpr <$> patch expected actual))
+    (\_ -> pure ())
+
+getMarkupFile :: Standard -> FilePath -> IO Markup
+getMarkupFile s fp = do
+  bs <- BS.readFile fp
+  pure $ resultError $ markup s bs
+
+-- round trip markdown >>> markup
+isoMarkdownMarkup :: Standard -> Markup -> Markup
+isoMarkdownMarkup s m = m & markdown Compact & markup s & resultError
+
+-- patch testing
+printPatchExamples :: IO ()
+printPatchExamples = traverse_ (printPatchExample m0) patchExamples
+
+printPatchExample :: ByteString -> (String, ByteString) -> IO ()
+printPatchExample m (s, m') = do
+  print s
+  case show . ansiWlEditExpr <$> patch (resultError $ markup Html m) (resultError $ markup Html m') of
+    Nothing -> putStrLn ("no changes" :: String)
+    Just x -> putStrLn x
+
+patchExamples :: [(String, ByteString)]
+patchExamples =
+  [ ("change an attribute name", m1'),
+    ("change an attribute value", m1),
+    ("delete an attribute", m2),
+    ("insert an attribute", m3),
+    ("change a tag", m4),
+    ("change a markup leaf", m5),
+    ("delete a leaf", m6),
+    ("insert a leaf", m7),
+    ("insert attribute", m8),
+    ("modify content", m9),
+    ("deep leaf insertion", m10)
+  ]
+
+m0 :: ByteString
+m0 = [i|<top class="a" b="c"><leaf></leaf>text</top>|]
+
+-- Changing class
+m1 :: ByteString
+m1 = [i|<top class="b" b="c"><leaf></leaf>text</top>|]
+
+m1' :: ByteString
+m1' = [i|<top classx="a" b="c"><leaf></leaf>text</top>|]
+
+-- deleting an attribute
+m2 :: ByteString
+m2 = [i|<top class="a"><leaf></leaf>text</top>|]
+
+-- inserting an attribute
+m3 :: ByteString
+m3 = [i|<top class="a" b="c" d="e"><leaf></leaf>text</top>|]
+
+-- changing a tag
+m4 :: ByteString
+m4 = [i|<newtop class="a" b="c"><leaf></leaf>text</newtop>|]
+
+-- changing a leaf
+m5 :: ByteString
+m5 = [i|<top class="a" b="c"><newleaf></newleaf>text</top>|]
+
+-- deleting a leaf
+m6 :: ByteString
+m6 = [i|<top class="a" b="c">text</top>|]
+
+-- inserting a leaf
+m7 :: ByteString
+m7 = [i|<top class="a" b="c"><newleaf></newleaf><leaf></leaf>text</top>|]
+
+-- inserting Attributes
+m8 :: ByteString
+m8 = [i|<top class="a" b="c"><leaf class="a" b="c"></leaf>text</top>|]
+
+-- modifying content
+m9 :: ByteString
+m9 = [i|<top class="a" b="c"><leaf></leaf>textual content</top>|]
+
+-- inserting a leaf deeper down
+m10 :: ByteString
+m10 = [i|<top class="a" b="c"><leaf><newdeepleaf></newdeepleaf></leaf>text</top>|]
diff --git a/app/speed.hs b/app/speed.hs
new file mode 100644
--- /dev/null
+++ b/app/speed.hs
@@ -0,0 +1,204 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+
+-- | basic measurement and callibration
+module Main where
+
+import Data.ByteString qualified as B
+import Data.Text.IO qualified as Text
+import FlatParse.Basic (byteStringOf, char, satisfy, skipMany)
+import FlatParse.Basic qualified as FP
+import MarkupParse
+import MarkupParse.FlatParse
+import Options.Applicative
+import Perf
+import Text.HTML.Parser qualified as HP
+import Text.HTML.Tree qualified as HP
+import Prelude
+
+data RunType = RunDefault | RunReduced | RunMarkup | RunWhitespace | RunWrappedQ | RunIsa | RunByteStringOf deriving (Eq, Show)
+
+data SpeedOptions = SpeedOptions
+  { speedReportOptions :: ReportOptions,
+    speedRunType :: RunType,
+    speedFile :: FilePath,
+    speedSnippet :: B.ByteString
+  }
+  deriving (Eq, Show)
+
+parseRun :: Parser RunType
+parseRun =
+  flag' RunDefault (long "default" <> help "run default performance test")
+    <|> flag' RunMarkup (long "markup" <> short 'm' <> help "run markup performance test")
+    <|> flag' RunWhitespace (long "whitespace" <> help "run whitespace parsing test")
+    <|> flag' RunWrappedQ (long "wrappedQ" <> help "run wrappedQ parsing test")
+    <|> flag' RunReduced (long "reduced" <> help "run with reduced result sizes")
+    <|> flag' RunByteStringOf (long "bytestringof" <> help "test bytestringof")
+    <|> flag' RunIsa (long "isa" <> help "test isa")
+    <|> pure RunDefault
+
+speedOptions :: Parser SpeedOptions
+speedOptions =
+  SpeedOptions
+    <$> parseReportOptions
+    <*> parseRun
+    <*> strOption (value "other/line.svg" <> long "file" <> short 'f' <> help "file to test")
+    <*> strOption (value "'wrapped'" <> long "snippet" <> help "snippet to parse")
+
+speedInfo :: ParserInfo SpeedOptions
+speedInfo =
+  info
+    (speedOptions <**> helper)
+    (fullDesc <> progDesc "markup-parse benchmarking" <> header "speed tests")
+
+main :: IO ()
+main = do
+  o <- execParser speedInfo
+  let rep = speedReportOptions o
+  let r = speedRunType o
+  let f = speedFile o
+  let snip = speedSnippet o
+
+  case r of
+    RunDefault -> do
+      bs <- B.readFile f
+      t <- Text.readFile f
+
+      reportMainWith rep (show r) $ do
+        ts' <- ffap "html-parse tokens" HP.parseTokens t
+        _ <- ffap "html-parse tree" (either undefined id . HP.tokensToForest) ts'
+        tsHtml <-
+          resultError
+            <$> ffap "tokenize" (tokenize Xml) bs
+        _ <-
+          resultError
+            <$> ffap "gather" (gather Xml) tsHtml
+        m <-
+          resultError
+            <$> ffap "markup" (markup Xml) bs
+        _ <- ffap "normalize" normalize m
+        _ <- ffap "markdown" (markdown Compact) m
+        pure ()
+    RunMarkup -> do
+      bs <- B.readFile f
+      reportMainWith rep (show r) $ do
+        fap "markup" (length . markupTree . markup_ Xml) bs
+    RunWhitespace -> do
+      reportMainWith rep (show r) (wsFap " \n\nx")
+    RunWrappedQ -> do
+      reportMainWith rep (show r) (fapWrappedQ snip)
+    RunIsa -> do
+      reportMainWith rep (show r) fapIsa
+    RunByteStringOf -> do
+      reportMainWith rep (show r) fapBSOf
+    RunReduced -> do
+      bs <- B.readFile f
+      t <- Text.readFile f
+      let ts' = HP.parseTokens t
+      let ts = tokenize_ Xml bs
+      let m = markup_ Xml bs
+      reportMainWith rep (show r) $ do
+        _ <- ffap "html-parse tokens" (length . HP.parseTokens) t
+        _ <- ffap "html-parse tree" (either undefined length . HP.tokensToForest) ts'
+        _ <- ffap "tokenize" (length . tokenize Xml) bs
+        _ <- ffap "gather" (length . gather_ Xml) ts
+        _ <- ffap "markup" (length . markupTree . markup_ Xml) bs
+        _ <- ffap "normalize" normalize m
+        _ <- ffap "markdown" (markdown Compact) m
+        pure ()
+
+-- | Consume whitespace.
+wsSwitch_ :: FP.Parser e ()
+wsSwitch_ =
+  $( FP.switch
+       [|
+         case _ of
+           " " -> wsSwitch_
+           "\n" -> wsSwitch_
+           "\t" -> wsSwitch_
+           "\r" -> wsSwitch_
+           "\f" -> wsSwitch_
+           _ -> pure ()
+         |]
+   )
+
+-- | consume whitespace
+wsSatisfy_ :: FP.Parser e ()
+wsSatisfy_ = FP.skipMany (FP.satisfy isWhitespace)
+
+-- | consume whitespace
+wsFusedSatisfy_ :: FP.Parser e ()
+wsFusedSatisfy_ = FP.skipMany (FP.fusedSatisfy isWhitespace (const False) (const False) (const False)) >> pure ()
+
+-- | consume whitespace
+wsSatisfyAscii_ :: FP.Parser e ()
+wsSatisfyAscii_ = FP.skipMany (FP.satisfyAscii isWhitespace) >> pure ()
+
+wsFap :: B.ByteString -> PerfT IO [[Double]] ()
+wsFap bs = do
+  fap "wsFusedSatisfy_" (FP.runParser wsFusedSatisfy_) bs
+  fap "ws" (FP.runParser ws) bs
+  fap "wss" (FP.runParser wss) bs
+  fap "ws_" (FP.runParser ws_) bs
+  fap "wsSwitch_" (FP.runParser wsSwitch_) bs
+  fap "wsSatisfy_" (FP.runParser wsSatisfy_) bs
+  fap "wsSatisfyAscii_" (FP.runParser wsSatisfyAscii_) bs
+  pure ()
+
+fapWrappedQ :: B.ByteString -> PerfT IO [[Double]] ()
+fapWrappedQ bs = do
+  fap "wrappedQ" (FP.runParser wrappedQ) bs
+  fap "wrappedQSatisfy" (FP.runParser wrappedQSatisfy) bs
+  fap "wrappedQSkipSatisfy" (FP.runParser wrappedQSkipSatisfy) bs
+  fap "wrappedQNotA" (FP.runParser wrappedQNotA) bs
+  fap "wrappedQCandidate" (FP.runParser wrappedQCandidate) bs
+  pure ()
+
+fapIsa :: PerfT IO [[Double]] ()
+fapIsa = do
+  fap "isa isAttrName" (FP.runParser (isa isAttrName)) "name"
+  fap "attrName" (FP.runParser attrName) "name"
+  pure ()
+
+fapBSOf :: PerfT IO [[Double]] ()
+fapBSOf = do
+  fap "byteStringOf" (FP.runParser (byteStringOf (attrs Html))) " a=\"a\" b=b c>"
+  fap "byteStringOf'" (FP.runParser (byteStringOf (attrs Html))) " a=\"a\" b=b c>"
+  pure ()
+
+isAttrName :: Char -> Bool
+isAttrName x =
+  not $
+    isWhitespace x
+      || (x == '/')
+      || (x == '>')
+      || (x == '=')
+
+attrName :: FP.Parser e B.ByteString
+attrName = byteStringOf $ some (satisfy isAttrName)
+
+wrappedQSatisfy :: FP.Parser e B.ByteString
+wrappedQSatisfy =
+  ($(char '"') *> (byteStringOf $ many (satisfy (/= '"'))) <* $(char '"'))
+    <|> ($(char '\'') *> (byteStringOf $ many (satisfy (/= '\''))) <* $(char '\''))
+
+wrappedQSkipSatisfy :: FP.Parser e B.ByteString
+wrappedQSkipSatisfy =
+  ($(char '"') *> (byteStringOf $ skipMany (satisfy (/= '"'))) <* $(char '"'))
+    <|> ($(char '\'') *> (byteStringOf $ skipMany (satisfy (/= '\''))) <* $(char '\''))
+
+wrappedQNotA :: FP.Parser e B.ByteString
+wrappedQNotA =
+  ($(char '"') *> nota '"' <* $(char '"'))
+    <|> ($(char '\'') *> nota '\'' <* $(char '\''))
+
+wrappedQCandidate :: FP.Parser e B.ByteString
+wrappedQCandidate =
+  wrappedSQ' <|> wrappedDQ'
+
+wrappedSQ' :: FP.Parser b B.ByteString
+wrappedSQ' = $(char '\'') *> nota '\'' <* $(char '\'')
+
+wrappedDQ' :: FP.Parser b B.ByteString
+wrappedDQ' = $(char '"') *> nota '"' <* $(char '"')
diff --git a/markup-parse.cabal b/markup-parse.cabal
new file mode 100644
--- /dev/null
+++ b/markup-parse.cabal
@@ -0,0 +1,145 @@
+cabal-version: 3.0
+name: markup-parse
+version: 0.0.0.1
+license: BSD-3-Clause
+license-file: LICENSE
+copyright: Copyright, Tony Day, 2023-
+category: project
+author: Tony Day
+maintainer: tonyday567@gmail.com
+homepage: https://github.com/tonyday567/markup-parse#readme
+bug-reports: https://github.com/tonyday567/markup-parse/issues
+synopsis: A markup parser.
+description:
+    A markup parser and printer, from and to strict bytestrings, optimised for speed.
+build-type: Simple
+tested-with: GHC == 9.6.2
+
+source-repository head
+    type: git
+    location: https://github.com/tonyday567/markup-parse
+
+common ghc-options-exe-stanza
+    ghc-options:
+        -fforce-recomp
+        -funbox-strict-fields
+        -rtsopts
+        -threaded
+
+common ghc-options-stanza
+    ghc-options:
+        -Wall
+        -Wcompat
+        -Wincomplete-record-updates
+        -Wincomplete-uni-patterns
+        -Wredundant-constraints
+
+common ghc2021-stanza
+    if impl ( ghc >= 9.2 )
+        default-language: GHC2021
+
+    if impl ( ghc < 9.2 )
+        default-language: Haskell2010
+        default-extensions:
+            BangPatterns
+            BinaryLiterals
+            ConstrainedClassMethods
+            ConstraintKinds
+            DeriveDataTypeable
+            DeriveFoldable
+            DeriveFunctor
+            DeriveGeneric
+            DeriveLift
+            DeriveTraversable
+            DoAndIfThenElse
+            EmptyCase
+            EmptyDataDecls
+            EmptyDataDeriving
+            ExistentialQuantification
+            ExplicitForAll
+            FlexibleContexts
+            FlexibleInstances
+            ForeignFunctionInterface
+            GADTSyntax
+            GeneralisedNewtypeDeriving
+            HexFloatLiterals
+            ImplicitPrelude
+            InstanceSigs
+            KindSignatures
+            MonomorphismRestriction
+            MultiParamTypeClasses
+            NamedFieldPuns
+            NamedWildCards
+            NumericUnderscores
+            PatternGuards
+            PolyKinds
+            PostfixOperators
+            RankNTypes
+            RelaxedPolyRec
+            ScopedTypeVariables
+            StandaloneDeriving
+            StarIsType
+            TraditionalRecordSyntax
+            TupleSections
+            TypeApplications
+            TypeOperators
+            TypeSynonymInstances
+
+    if impl ( ghc < 9.2 ) && impl ( ghc >= 8.10 )
+        default-extensions:
+            ImportQualifiedPost
+            StandaloneKindSignatures
+
+library
+    import: ghc-options-stanza
+    import: ghc2021-stanza
+    hs-source-dirs: src
+    build-depends:
+        , base               >=4.7 && <5
+        , bytestring         >=0.11.3 && <0.13
+        , containers         >=0.6 && <0.7
+        , deepseq            >=1.4.4 && <1.6
+        , flatparse          >=0.3.5 && <0.6
+        , string-interpolate >=0.3 && <0.4
+        , tasty              >=1.2 && <1.5
+        , tasty-golden       >=2.3.1.1 && <2.4
+        , these              >=1.1 && <1.3
+        , tree-diff          >=0.3 && <0.4
+    exposed-modules:
+        MarkupParse
+        MarkupParse.FlatParse
+        MarkupParse.Patch
+
+test-suite markup-parse-diff
+    import: ghc-options-exe-stanza
+    import: ghc-options-stanza
+    import: ghc2021-stanza
+    main-is: diff.hs
+    hs-source-dirs: app
+    build-depends:
+        , base                 >=4.7 && <5
+        , bytestring           >=0.11.3 && <0.13
+        , markup-parse
+        , string-interpolate   >=0.3 && <0.4
+        , tasty                >=1.2 && <1.5
+        , tasty-golden         >=2.3.1.1 && <2.4
+        , tree-diff            >=0.3 && <0.4
+    type: exitcode-stdio-1.0
+
+benchmark markup-parse-speed
+    import: ghc-options-exe-stanza
+    import: ghc-options-stanza
+    import: ghc2021-stanza
+    main-is: speed.hs
+    hs-source-dirs: app
+    build-depends:
+        , base                 >=4.7 && <5
+        , bytestring           >=0.11.3 && <0.13
+        , flatparse            >=0.3.5 && <0.6
+        , html-parse           >=0.2 && <0.3
+        , markup-parse
+        , optparse-applicative >=0.17 && <0.19
+        , perf                 >=0.12 && <0.13
+        , text                 >=1.2 && <2.1
+    ghc-options: -O2
+    type: exitcode-stdio-1.0
diff --git a/src/MarkupParse.hs b/src/MarkupParse.hs
new file mode 100644
--- /dev/null
+++ b/src/MarkupParse.hs
@@ -0,0 +1,792 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- | A 'Markup' parser and printer of strict bytestrings. 'Markup' is a representation of data such as HTML, SVG or XML but the parsing is sub-standard.
+module MarkupParse
+  ( -- $usage
+
+    -- * Markup
+    Markup (..),
+    Standard (..),
+    markup,
+    markup_,
+    RenderStyle (..),
+    markdown,
+    normalize,
+    wellFormed,
+    isWellFormed,
+
+    -- * Warnings
+    MarkupWarning (..),
+    Result,
+    resultError,
+    resultEither,
+    resultMaybe,
+
+    -- * Token components
+    TagName,
+    name,
+    selfClosers,
+    AttrName,
+    AttrValue,
+    Attr (..),
+    attrs,
+
+    -- * Tokens
+    Token (..),
+    tokenize,
+    tokenize_,
+    token,
+    detokenize,
+    gather,
+    gather_,
+    degather,
+    degather_,
+
+    -- * XML specific Parsers
+    xmlVersionInfo,
+    xmlEncodingDecl,
+    xmlStandalone,
+    xmlVersionNum,
+    xmlEncName,
+    xmlYesNo,
+  )
+where
+
+import Control.Category ((>>>))
+import Control.DeepSeq
+import Control.Monad
+import Data.Bifunctor
+import Data.Bool
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 qualified as B
+import Data.Char hiding (isDigit)
+import Data.Foldable
+import Data.Function
+import Data.List qualified as List
+import Data.Map.Strict qualified as Map
+import Data.Maybe
+import Data.String.Interpolate
+import Data.These
+import Data.Tree
+import Data.TreeDiff
+import FlatParse.Basic hiding (Result, cut, take)
+import GHC.Generics
+import MarkupParse.FlatParse
+import Prelude hiding (replicate)
+
+-- $setup
+-- >>> :set -XTemplateHaskell
+-- >>> :set -XQuasiQuotes
+-- >>> :set -XOverloadedStrings
+-- >>> import MarkupParse
+-- >>> import MarkupParse.Patch
+-- >>> import MarkupParse.FlatParse
+-- >>> import FlatParse.Basic
+-- >>> import Data.String.Interpolate
+-- >>> import Data.ByteString.Char8 qualified as B
+-- >>> import Data.Tree
+
+-- $usage
+--
+-- > import MarkupParse
+-- > import Data.ByteString qualified as B
+-- >
+-- > bs <- B.readFile "other/line.svg"
+-- > m = markup_ bs
+--
+-- @'markdown' . ''markup_'@ is an approximate round trip from 'ByteString' to 'Markup' back to ByteString'. The underscores represent versions of main functions that throw an exception on warnings encountered along the way.
+--
+-- At a lower level, a round trip pipeline might look something like:
+--
+-- > :t tokenize Html >=> gather Html >>> fmap (Markup Html >>> normalize) >=> degather >>> fmap (fmap (detokenize Html) >>> mconcat)
+-- > ByteString -> These [MarkupWarning] ByteString
+--
+-- From left to right:
+--
+-- - 'tokenize' converts a 'ByteString' to a 'Token' list,
+--
+-- - 'gather' takes the tokens and gathers them into 'Tree's of tokens
+--
+-- - this is then wrapped into the 'Markup' data type.
+--
+-- - 'normalize' concatenates content, and normalizes attributes,
+--
+-- - 'degather' turns the markup tree back into a token list. Finally,
+--
+-- - 'detokenize' turns a token back into a bytestring.
+--
+-- Along the way, the kleisi fishies and compose forward usage accumulates any warnings via the 'These' monad instance.
+
+-- | From a parsing pov, Html & Xml (& Svg) are close enough that they share a lot of parsing logic, so that parsing and printing just need some tweaking.
+--
+-- The xml parsing logic is based on the XML productions found in https://www.w3.org/TR/xml/
+--
+-- The html parsing was based on a reading of <https://hackage.haskell.org/package/html-parse html-parse>, but ignores the various '\x00' to '\xfffd' & eof directives that form part of the html standards.
+data Standard = Html | Xml deriving (Eq, Show, Ord, Generic, NFData)
+
+instance ToExpr Standard
+
+-- | A 'Tree' list of markup 'Token's
+--
+-- >>> markup Html "<foo class=\"bar\">baz</foo>"
+-- That (Markup {standard = Html, markupTree = [Node {rootLabel = StartTag "foo" [Attr "class" "bar"], subForest = [Node {rootLabel = Content "baz", subForest = []}]}]})
+data Markup = Markup {standard :: Standard, markupTree :: [Tree Token]} deriving (Show, Eq, Ord, Generic, NFData)
+
+instance ToExpr Markup
+
+-- | markup-parse generally tries to continue on parse errors, and return what has/can still be parsed, together with any warnings.
+data MarkupWarning
+  = -- | A tag ending with "/>" that is not an element of 'selfClosers' (Html only).
+    BadEmptyElemTag
+  | -- | A tag ending with "/>" that has children. Cannot happen in the parsing phase.
+    SelfCloserWithChildren
+  | -- | Only a 'StartTag' can have child tokens.
+    LeafWithChildren
+  | -- | A CloseTag with a different name to the currently open StartTag.
+    TagMismatch TagName TagName
+  | -- | An EndTag with no corresponding StartTag.
+    UnmatchedEndTag
+  | -- | An EndTag with corresponding StartTag.
+    UnclosedTag
+  | -- | An EndTag should never appear in 'Markup'
+    EndTagInTree
+  | -- | Empty Content, Comment, Decl or Doctype
+    EmptyContent
+  | MarkupParser ParserWarning
+  deriving (Eq, Show, Ord, Generic, NFData)
+
+showWarnings :: [MarkupWarning] -> String
+showWarnings = List.nub >>> fmap show >>> unlines
+
+-- | The structure of many returning functions.
+--
+-- A common computation pipeline is to take advantage of the 'These' Monad instance eg
+--
+-- > markup s bs = bs & (tokenize s >=> gather s) & second (Markup s)
+type Result a = These [MarkupWarning] a
+
+-- | Convert any warnings to an 'error'
+--
+-- >>> resultError $ (tokenize Html) "<foo"
+-- *** Exception: MarkupParser (ParserLeftover "<foo")
+-- ...
+resultError :: Result a -> a
+resultError = these (showWarnings >>> error) id (\xs a -> bool (error (showWarnings xs)) a (xs == []))
+
+-- | Returns Left on any warnings
+--
+-- >>> resultEither $ (tokenize Html) "<foo><baz"
+-- Left [MarkupParser (ParserLeftover "<baz")]
+resultEither :: Result a -> Either [MarkupWarning] a
+resultEither = these Left Right (\xs a -> bool (Left xs) (Right a) (xs == []))
+
+-- | Returns results if any, ignoring warnings.
+--
+-- >>> resultMaybe $ (tokenize Html) "<foo><baz"
+-- Just [StartTag "foo" []]
+resultMaybe :: Result a -> Maybe a
+resultMaybe = these (const Nothing) Just (\_ a -> Just a)
+
+-- | Convert bytestrings to 'Markup'
+--
+-- >>> markup Html "<foo><br></foo><baz"
+-- These [MarkupParser (ParserLeftover "<baz")] (Markup {standard = Html, markupTree = [Node {rootLabel = StartTag "foo" [], subForest = [Node {rootLabel = StartTag "br" [], subForest = []}]}]})
+markup :: Standard -> ByteString -> These [MarkupWarning] Markup
+markup s bs = bs & (tokenize s >=> gather s) & second (Markup s)
+
+-- | markup but errors on warnings.
+markup_ :: Standard -> ByteString -> Markup
+markup_ s bs = markup s bs & resultError
+
+-- | concatenate sequential content, and normalize attributes; unwording class values and removing duplicate attributes (taking last).
+--
+-- >>> B.putStr $ markdown Compact $ normalize (markup_ Xml [i|<foo class="a" class="b" bar="first" bar="last"/>|])
+-- <foo bar="last" class="a b"/>
+normalize :: Markup -> Markup
+normalize (Markup s trees) = Markup s (normContentTrees $ fmap (fmap normTokenAttrs) trees)
+
+-- | Are the trees in the markup well-formed?
+isWellFormed :: Markup -> Bool
+isWellFormed = (== []) . wellFormed
+
+-- | Check for well-formedness and rerturn warnings encountered.
+--
+-- >>> wellFormed $ Markup Html [Node (Comment "") [], Node (EndTag "foo") [], Node (EmptyElemTag "foo" []) [Node (Content "bar") []], Node (EmptyElemTag "foo" []) []]
+-- [EmptyContent,EndTagInTree,LeafWithChildren,BadEmptyElemTag]
+wellFormed :: Markup -> [MarkupWarning]
+wellFormed (Markup s trees) = List.nub $ mconcat (foldTree checkNode <$> trees)
+  where
+    checkNode (StartTag _ _) xs = mconcat xs
+    checkNode (EmptyElemTag n _) [] =
+      bool [] [BadEmptyElemTag] (not (n `elem` selfClosers) && s == Html)
+    checkNode (EndTag _) [] = [EndTagInTree]
+    checkNode (Content bs) [] = bool [] [EmptyContent] (bs == "")
+    checkNode (Comment bs) [] = bool [] [EmptyContent] (bs == "")
+    checkNode (Decl bs) [] = bool [] [EmptyContent] (bs == "")
+    checkNode (Doctype bs) [] = bool [] [EmptyContent] (bs == "")
+    checkNode _ _ = [LeafWithChildren]
+
+-- | Name of token
+type TagName = ByteString
+
+-- | A Markup token
+--
+-- >>> runParser_ (many (token Html)) [i|<foo>content</foo>|]
+-- [StartTag "foo" [],Content "content",EndTag "foo"]
+--
+-- >>> runParser_ (token Xml) [i|<foo/>|]
+-- EmptyElemTag "foo" []
+--
+-- >>> runParser_ (token Html) "<!-- Comment -->"
+-- Comment " Comment "
+--
+-- >>> runParser_ (token Xml) [i|<?xml version="1.0" encoding="UTF-8"?>|]
+-- Decl "xml version=\"1.0\" encoding=\"UTF-8\""
+--
+-- >>> runParser_ (token Html) "<!DOCTYPE html>"
+-- Doctype "DOCTYPE html"
+--
+-- >>> runParser_ (token Xml) "<!DOCTYPE foo [ declarations ]>"
+-- Doctype "DOCTYPE foo [ declarations ]"
+--
+-- >>> runParser (token Html) [i|<foo a="a" b="b" c=c check>|]
+-- OK (StartTag "foo" [Attr "a" "a",Attr "b" "b",Attr "c" "c",Attr "check" ""]) ""
+--
+-- >>> runParser (token Xml) [i|<foo a="a" b="b" c=c check>|]
+-- Fail
+data Token
+  = -- | A start tag. https://developer.mozilla.org/en-US/docs/Glossary/Tag
+    StartTag !TagName ![Attr]
+  | -- | An empty element tag. Optional for XML and kind of not allowed in HTML.
+    EmptyElemTag !TagName ![Attr]
+  | -- | A closing tag.
+    EndTag !TagName
+  | -- | The content between tags.
+    Content !ByteString
+  | -- | Contents of a comment.
+    Comment !ByteString
+  | -- | Contents of a declaration
+    Decl !ByteString
+  | -- | Contents of a doctype declaration.
+    Doctype !ByteString
+  deriving (Show, Ord, Eq, Generic)
+
+instance NFData Token
+
+instance ToExpr Token
+
+-- | A flatparse 'Token' parser.
+--
+-- >>> runParser (token Html) "<foo>content</foo>"
+-- OK (StartTag "foo" []) "content</foo>"
+token :: Standard -> Parser String Token
+token Html = tokenHtml
+token Xml = tokenXml
+
+-- | Parse a bytestring into tokens
+--
+-- >>> tokenize Html [i|<foo>content</foo>|]
+-- That [StartTag "foo" [],Content "content",EndTag "foo"]
+tokenize :: Standard -> ByteString -> These [MarkupWarning] [Token]
+tokenize s bs = first ((: []) . MarkupParser) $ runParserWarn (many (token s)) bs
+
+-- | tokenize but errors on warnings.
+tokenize_ :: Standard -> ByteString -> [Token]
+tokenize_ s bs = tokenize s bs & resultError
+
+-- | Html tags that self-close
+selfClosers :: [TagName]
+selfClosers =
+  [ "area",
+    "base",
+    "br",
+    "col",
+    "embed",
+    "hr",
+    "img",
+    "input",
+    "link",
+    "meta",
+    "param",
+    "source",
+    "track",
+    "wbr"
+  ]
+
+-- | Name of an attribute.
+type AttrName = ByteString
+
+-- | Value of an attribute. "" is equivalent to true with respect to boolean attributes.
+type AttrValue = ByteString
+
+-- | An attribute of a tag
+--
+-- In parsing, boolean attributes, which are not required to have a value in HTML,
+-- will be set a value of "", which is ok. But this will then be rendered.
+--
+-- >>> detokenize Html <$> tokenize_ Html [i|<input checked>|]
+-- ["<input checked=\"\">"]
+data Attr = Attr !AttrName !AttrValue
+  deriving (Generic, Show, Eq, Ord)
+
+instance NFData Attr
+
+instance ToExpr Attr
+
+normTokenAttrs :: Token -> Token
+normTokenAttrs (StartTag n as) = StartTag n (normAttrs as)
+normTokenAttrs (EmptyElemTag n as) = EmptyElemTag n (normAttrs as)
+normTokenAttrs x = x
+
+-- | normalize an attribution list, removing duplicate AttrNames, and space concatenating class values.
+normAttrs :: [Attr] -> [Attr]
+normAttrs as =
+  uncurry Attr
+    <$> ( Map.toList $
+            foldl'
+              ( \s (Attr n v) ->
+                  Map.insertWithKey
+                    ( \k new old ->
+                        case k of
+                          "class" -> old <> " " <> new
+                          _ -> new
+                    )
+                    n
+                    v
+                    s
+              )
+              Map.empty
+              as
+        )
+
+-- | render attributes
+renderAttrs :: [Attr] -> ByteString
+renderAttrs = B.unwords . fmap renderAttr
+
+-- | render an attribute
+--
+-- Does not attempt to escape double quotes.
+renderAttr :: Attr -> ByteString
+renderAttr (Attr k v) = [i|#{k}="#{v}"|]
+
+commentClose :: Parser e ()
+commentClose = $(string "-->")
+
+charNotMinus :: Parser e ByteString
+charNotMinus = byteStringOf $ satisfy (/= '-')
+
+minusPlusChar :: Parser e ByteString
+minusPlusChar = byteStringOf ($(char '-') *> charNotMinus)
+
+comment :: Parser e Token
+comment = Comment <$> byteStringOf (many (charNotMinus <|> minusPlusChar)) <* commentClose
+
+content :: Parser e Token
+content = Content <$> byteStringOf (some (satisfy (/= '<')))
+
+-- | bytestring representation of 'Token'.
+--
+-- >>> detokenize Html (StartTag "foo" [])
+-- "<foo>"
+detokenize :: Standard -> Token -> ByteString
+detokenize s = \case
+  (StartTag n []) -> [i|<#{n}>|]
+  (StartTag n as) -> [i|<#{n} #{renderAttrs as}>|]
+  (EmptyElemTag n as) ->
+    bool
+      [i|<#{n} #{renderAttrs as}/>|]
+      [i|<#{n} #{renderAttrs as} />|]
+      (s == Html)
+  (EndTag n) -> [i|</#{n}>|]
+  (Content t) -> t
+  (Comment t) -> [i|<!--#{t}-->|]
+  (Doctype t) -> [i|<!#{t}>|]
+  (Decl t) -> bool [i|<?#{t}?>|] [i|<!#{t}!>|] (s == Html)
+
+-- | Indented 0 puts newlines in between the tags.
+data RenderStyle = Compact | Indented Int deriving (Eq, Show, Generic)
+
+indentChildren :: RenderStyle -> [ByteString] -> [ByteString]
+indentChildren Compact = id
+indentChildren (Indented x) =
+  fmap (B.replicate x ' ' <>)
+
+finalConcat :: RenderStyle -> [ByteString] -> ByteString
+finalConcat Compact = mconcat
+finalConcat (Indented _) =
+  B.intercalate (B.singleton '\n')
+    . filter (/= "")
+
+-- | Convert 'Markup' to bytestrings
+--
+-- >>> B.putStr $ markdown (Indented 4) (markup_ Html [i|<foo><br></foo>|])
+-- <foo>
+--     <br>
+-- </foo>
+markdown :: RenderStyle -> Markup -> ByteString
+markdown r (Markup std tree) =
+  finalConcat r $ mconcat $ foldTree (renderBranch r std) <$> normContentTrees tree
+
+-- note that renderBranch adds in EndTags for StartTags when needed
+renderBranch :: RenderStyle -> Standard -> Token -> [[ByteString]] -> [ByteString]
+renderBranch r std s@(StartTag n _) children
+  | n `elem` selfClosers && std == Html =
+      [detokenize std s] <> indentChildren r (mconcat children)
+  | otherwise =
+      [detokenize std s] <> indentChildren r (mconcat children) <> [detokenize std (EndTag n)]
+renderBranch r std x children =
+  -- ignoring that this should be an error
+  [detokenize std x] <> indentChildren r (mconcat children)
+
+normContentTrees :: [Tree Token] -> [Tree Token]
+normContentTrees trees = foldTree (\x xs -> Node x (filter ((/= Content "") . rootLabel) $ concatContent xs)) <$> concatContent trees
+
+concatContent :: [Tree Token] -> [Tree Token]
+concatContent = \case
+  ((Node (Content t) _) : (Node (Content t') _) : ts) -> concatContent $ Node (Content (t <> t')) [] : ts
+  (t : ts) -> t : concatContent ts
+  [] -> []
+
+-- | Gather together token trees from a token list, placing child elements in nodes and removing EndTags.
+--
+-- >>> gather Html =<< tokenize Html "<foo class=\"bar\">baz</foo>"
+-- That [Node {rootLabel = StartTag "foo" [Attr "class" "bar"], subForest = [Node {rootLabel = Content "baz", subForest = []}]}]
+gather :: Standard -> [Token] -> These [MarkupWarning] [Tree Token]
+gather s ts =
+  case (finalSibs, finalParents, warnings) of
+    (sibs, [], []) -> That (reverse sibs)
+    ([], [], xs) -> This xs
+    (sibs, ps, xs) ->
+      These (xs <> [UnclosedTag]) (reverse $ foldl' (\ss' (p, ss) -> Node p (reverse ss') : ss) sibs ps)
+  where
+    (Cursor finalSibs finalParents, warnings) =
+      foldl' (\(c, xs) t -> incCursor s t c & second (maybeToList >>> (<> xs))) (Cursor [] [], []) ts
+
+-- | gather but errors on warnings.
+gather_ :: Standard -> [Token] -> [Tree Token]
+gather_ s ts = gather s ts & resultError
+
+incCursor :: Standard -> Token -> Cursor -> (Cursor, Maybe MarkupWarning)
+-- Only StartTags are ever pushed on to the parent list, here:
+incCursor Xml t@(StartTag _ _) (Cursor ss ps) = (Cursor [] ((t, ss) : ps), Nothing)
+incCursor Html t@(StartTag n _) (Cursor ss ps) =
+  (bool (Cursor [] ((t, ss) : ps)) (Cursor (Node t [] : ss) ps) (n `elem` selfClosers), Nothing)
+incCursor Xml t@(EmptyElemTag _ _) (Cursor ss ps) = (Cursor (Node t [] : ss) ps, Nothing)
+incCursor Html t@(EmptyElemTag n _) (Cursor ss ps) =
+  ( Cursor (Node t [] : ss) ps,
+    bool (Just BadEmptyElemTag) Nothing (n `elem` selfClosers)
+  )
+incCursor _ (EndTag n) (Cursor ss ((p@(StartTag n' _), ss') : ps)) =
+  ( Cursor (Node p (reverse ss) : ss') ps,
+    bool (Just (TagMismatch n n')) Nothing (n == n')
+  )
+-- Non-StartTag on parent list
+incCursor _ (EndTag _) (Cursor ss ((p, ss') : ps)) =
+  ( Cursor (Node p (reverse ss) : ss') ps,
+    Just LeafWithChildren
+  )
+incCursor _ (EndTag _) (Cursor ss []) =
+  ( Cursor ss [],
+    Just UnmatchedEndTag
+  )
+incCursor _ t (Cursor ss ps) = (Cursor (Node t [] : ss) ps, Nothing)
+
+data Cursor = Cursor
+  { -- siblings, not (yet) part of another element
+    _sibs :: [Tree Token],
+    -- open elements and their siblings.
+    _stack :: [(Token, [Tree Token])]
+  }
+
+-- | Convert a markup into a token list, adding end tags.
+--
+-- >>> degather =<< markup Html "<foo class=\"bar\">baz</foo>"
+-- That [StartTag "foo" [Attr "class" "bar"],Content "baz",EndTag "foo"]
+degather :: Markup -> These [MarkupWarning] [Token]
+degather (Markup s tree) = rconcats $ foldTree (addCloseTags s) <$> tree
+
+-- | degather but errors on warning
+degather_ :: Markup -> [Token]
+degather_ m = degather m & resultError
+
+rconcats :: [Result [a]] -> Result [a]
+rconcats rs = case bimap mconcat mconcat $ partitionHereThere rs of
+  ([], xs) -> That xs
+  (es, []) -> This es
+  (es, xs) -> These es xs
+
+addCloseTags :: Standard -> Token -> [These [MarkupWarning] [Token]] -> These [MarkupWarning] [Token]
+addCloseTags std s@(StartTag n _) children
+  | children /= [] && n `elem` selfClosers && std == Html =
+      These [SelfCloserWithChildren] [s] <> rconcats children
+  | n `elem` selfClosers && std == Html =
+      That [s] <> rconcats children
+  | otherwise =
+      That [s] <> rconcats children <> That [EndTag n]
+addCloseTags _ x xs = case xs of
+  [] -> That [x]
+  cs -> These [LeafWithChildren] [x] <> rconcats cs
+
+tokenXml :: Parser e Token
+tokenXml =
+  $( switch
+       [|
+         case _ of
+           "<!--" -> comment
+           "<!" -> doctypeXml
+           "</" -> endTagXml
+           "<?" -> declXml
+           "<" -> startTagsXml
+           _ -> content
+         |]
+   )
+
+-- [4]
+nameStartChar :: Parser e Char
+nameStartChar = fusedSatisfy isLatinLetter isNameStartChar isNameStartChar isNameStartChar
+
+isNameStartChar :: Char -> Bool
+isNameStartChar x =
+  (x >= 'a' && x <= 'z')
+    || (x >= 'A' && x <= 'Z')
+    || (x == ':')
+    || (x == '_')
+    || (x >= '\xC0' && x <= '\xD6')
+    || (x >= '\xD8' && x <= '\xF6')
+    || (x >= '\xF8' && x <= '\x2FF')
+    || (x >= '\x370' && x <= '\x37D')
+    || (x >= '\x37F' && x <= '\x1FFF')
+    || (x >= '\x200C' && x <= '\x200D')
+    || (x >= '\x2070' && x <= '\x218F')
+    || (x >= '\x2C00' && x <= '\x2FEF')
+    || (x >= '\x3001' && x <= '\xD7FF')
+    || (x >= '\xF900' && x <= '\xFDCF')
+    || (x >= '\xFDF0' && x <= '\xFFFD')
+    || (x >= '\x10000' && x <= '\xEFFFF')
+
+-- [4a]
+nameChar :: Parser e Char
+nameChar = fusedSatisfy isNameCharAscii isNameCharExt isNameCharExt isNameCharExt
+
+isNameCharAscii :: Char -> Bool
+isNameCharAscii x =
+  (x >= 'a' && x <= 'z')
+    || (x >= 'A' && x <= 'Z')
+    || (x >= '0' && x <= '9')
+    || (x == ':')
+    || (x == '_')
+    || (x == '-')
+    || (x == '.')
+
+isNameCharExt :: Char -> Bool
+isNameCharExt x =
+  (x >= 'a' && x <= 'z')
+    || (x >= 'A' && x <= 'Z')
+    || (x >= '0' && x <= '9')
+    || (x == ':')
+    || (x == '_')
+    || (x == '-')
+    || (x == '.')
+    || (x == '\xB7')
+    || (x >= '\xC0' && x <= '\xD6')
+    || (x >= '\xD8' && x <= '\xF6')
+    || (x >= '\xF8' && x <= '\x2FF')
+    || (x >= '\x300' && x <= '\x36F')
+    || (x >= '\x370' && x <= '\x37D')
+    || (x >= '\x37F' && x <= '\x1FFF')
+    || (x >= '\x200C' && x <= '\x200D')
+    || (x >= '\x203F' && x <= '\x2040')
+    || (x >= '\x2070' && x <= '\x218F')
+    || (x >= '\x2C00' && x <= '\x2FEF')
+    || (x >= '\x3001' && x <= '\xD7FF')
+    || (x >= '\xF900' && x <= '\xFDCF')
+    || (x >= '\xFDF0' && x <= '\xFFFD')
+    || (x >= '\x10000' && x <= '\xEFFFF')
+
+-- | name string according to xml production rule [5]
+nameXml :: Parser e ByteString
+nameXml = byteStringOf (nameStartChar >> many nameChar)
+
+-- | XML declaration as per production rule [23]
+declXml :: Parser e Token
+declXml =
+  Decl
+    <$> byteStringOf
+      ( $(string "xml")
+          >> xmlVersionInfo
+          >> optional xmlEncodingDecl
+          >> optional xmlStandalone
+          >> ws_
+      )
+    <* $(string "?>")
+
+-- | xml production [24]
+xmlVersionInfo :: Parser e ByteString
+xmlVersionInfo = byteStringOf $ ws_ >> $(string "version") >> eq >> wrappedQNoGuard xmlVersionNum
+
+-- | xml production [26]
+xmlVersionNum :: Parser e ByteString
+xmlVersionNum =
+  byteStringOf ($(string "1.") >> some (satisfy isDigit))
+
+-- | Doctype declaration as per production rule [28]
+doctypeXml :: Parser e Token
+doctypeXml =
+  Doctype
+    <$> byteStringOf
+      ( $(string "DOCTYPE")
+          >> ws_
+          >> nameXml
+          >>
+          -- optional (ws_ >> xmlExternalID) >>
+          ws_
+          >> optional bracketedSB
+          >> ws_
+      )
+    <* $(char '>')
+
+-- | Xml production [32]
+xmlStandalone :: Parser e ByteString
+xmlStandalone =
+  byteStringOf $
+    ws_ *> $(string "standalone") *> eq *> xmlYesNo
+
+-- | Xml yes/no
+xmlYesNo :: Parser e ByteString
+xmlYesNo = wrappedQNoGuard (byteStringOf $ $(string "yes") <|> $(string "no"))
+
+-- | xml production [80]
+xmlEncodingDecl :: Parser e ByteString
+xmlEncodingDecl = ws_ *> $(string "encoding") *> eq *> wrappedQNoGuard xmlEncName
+
+-- | xml production [81]
+xmlEncName :: Parser e ByteString
+xmlEncName = byteStringOf (satisfyAscii isLatinLetter >> many (satisfyAscii (\x -> isLatinLetter x || isDigit x || elem x ("._-" :: [Char]))))
+
+-- | open xml tag as per xml production rule [40]
+--  self-closing xml tag as per [44]
+startTagsXml :: Parser e Token
+startTagsXml = do
+  !n <- nameXml
+  !as <- many (ws_ *> attrXml)
+  _ <- ws_
+  $( switch
+       [|
+         case _ of
+           "/>" -> pure (EmptyElemTag n as)
+           ">" -> pure (StartTag n as)
+         |]
+   )
+
+attrXml :: Parser e Attr
+attrXml = Attr <$> (nameXml <* eq) <*> wrappedQ
+
+-- | closing tag as per [42]
+endTagXml :: Parser e Token
+endTagXml = EndTag <$> (nameXml <* ws_ <* $(char '>'))
+
+-- | Parse a single 'Token'.
+tokenHtml :: Parser e Token
+tokenHtml =
+  $( switch
+       [|
+         case _ of
+           "<!--" -> comment
+           "<!" -> doctypeHtml
+           "</" -> endTagHtml
+           "<?" -> bogusCommentHtml
+           "<" -> startTagsHtml
+           _ -> content
+         |]
+   )
+
+bogusCommentHtml :: Parser e Token
+bogusCommentHtml = Comment <$> byteStringOf (some (satisfy (/= '<')))
+
+doctypeHtml :: Parser e Token
+doctypeHtml =
+  Doctype
+    <$> byteStringOf
+      ( $(string "DOCTYPE")
+          >> ws_
+          >> nameHtml
+          >> ws_
+      )
+    <* $(char '>')
+
+startTagsHtml :: Parser e Token
+startTagsHtml = do
+  n <- nameHtml
+  as <- attrs Html
+  _ <- ws_
+  $( switch
+       [|
+         case _ of
+           "/>" -> pure (EmptyElemTag n as)
+           ">" -> pure (StartTag n as)
+         |]
+   )
+
+endTagHtml :: Parser e Token
+endTagHtml = EndTag <$> nameHtml <* ws_ <* $(char '>')
+
+-- | Parse a tag name. Each standard is slightly different.
+name :: Standard -> Parser e ByteString
+name Html = nameHtml
+name Xml = nameXml
+
+nameHtml :: Parser e ByteString
+nameHtml = do
+  byteStringOf (nameStartCharHtml >> many (satisfy isNameChar))
+
+nameStartCharHtml :: Parser e Char
+nameStartCharHtml = satisfyAscii isLatinLetter
+
+isNameChar :: Char -> Bool
+isNameChar x =
+  not
+    ( isWhitespace x
+        || (x == '/')
+        || (x == '<')
+        || (x == '>')
+    )
+
+attrHtml :: Parser e Attr
+attrHtml =
+  (Attr <$> (attrName <* eq) <*> (wrappedQ <|> attrBooleanName))
+    <|> ((`Attr` mempty) <$> attrBooleanName)
+
+attrBooleanName :: Parser e ByteString
+attrBooleanName = byteStringOf $ some (satisfy isBooleanAttrName)
+
+-- | Parse an 'Attr'
+attr :: Standard -> Parser a Attr
+attr Html = attrHtml
+attr Xml = attrXml
+
+-- | Parse attributions
+attrs :: Standard -> Parser a [Attr]
+attrs s = many (ws_ *> attr s) <* ws_
+
+attrName :: Parser e ByteString
+attrName = isa isAttrName
+
+isAttrName :: Char -> Bool
+isAttrName x =
+  not $
+    isWhitespace x
+      || (x == '/')
+      || (x == '>')
+      || (x == '=')
+
+isBooleanAttrName :: Char -> Bool
+isBooleanAttrName x =
+  not $
+    isWhitespace x
+      || (x == '/')
+      || (x == '>')
diff --git a/src/MarkupParse/FlatParse.hs b/src/MarkupParse/FlatParse.hs
new file mode 100644
--- /dev/null
+++ b/src/MarkupParse/FlatParse.hs
@@ -0,0 +1,344 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Various flatparse helpers and combinators.
+module MarkupParse.FlatParse
+  ( -- * parsing
+    ParserWarning (..),
+    runParserMaybe,
+    runParserEither,
+    runParserWarn,
+    runParser_,
+
+    -- * parsers
+    isWhitespace,
+    ws_,
+    ws,
+    wss,
+    nota,
+    isa,
+    sq,
+    dq,
+    wrappedDq,
+    wrappedSq,
+    wrappedQ,
+    wrappedQNoGuard,
+    eq,
+    sep,
+    bracketed,
+    bracketedSB,
+    wrapped,
+    int,
+    double,
+    signed,
+    byteStringOf',
+  )
+where
+
+import Control.DeepSeq
+import Data.Bool
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 qualified as B
+import Data.Char hiding (isDigit)
+import Data.These
+import FlatParse.Basic hiding (cut, take)
+import GHC.Exts
+import GHC.Generics (Generic)
+import Prelude hiding (replicate)
+
+-- $setup
+-- >>> :set -XTemplateHaskell
+-- >>> import MarkupParse.FlatParse
+-- >>> import FlatParse.Basic
+
+-- | run a Parser, throwing away leftovers. Nothing on 'Fail' or 'Err'.
+--
+-- >>> runParserMaybe ws "x"
+-- Nothing
+--
+-- >>> runParserMaybe ws " x"
+-- Just ' '
+runParserMaybe :: Parser e a -> ByteString -> Maybe a
+runParserMaybe p b = case runParser p b of
+  OK r _ -> Just r
+  Fail -> Nothing
+  Err _ -> Nothing
+
+-- | run a Parser, throwing away leftovers. Returns Left on 'Fail' or 'Err'.
+--
+-- >>> runParserEither ws " x"
+-- Right ' '
+runParserEither :: Parser String a -> ByteString -> Either String a
+runParserEither p bs = case runParser p bs of
+  Err e -> Left e
+  OK a _ -> Right a
+  Fail -> Left "uncaught parse error"
+
+-- | Warnings covering leftovers, 'Err's and 'Fail'
+--
+-- >>> runParserWarn ws " x"
+-- These (ParserLeftover "x") ' '
+--
+-- >>> runParserWarn ws "x"
+-- This ParserUncaught
+--
+-- >>> runParserWarn (ws `cut` "no whitespace") "x"
+-- This (ParserError "no whitespace")
+data ParserWarning = ParserLeftover ByteString | ParserError String | ParserUncaught deriving (Eq, Show, Ord, Generic, NFData)
+
+-- | Run parser, returning leftovers and errors as 'ParserWarning's.
+--
+-- >>> runParserWarn ws " "
+-- That ' '
+--
+-- >>> runParserWarn ws "x"
+-- This ParserUncaught
+--
+-- >>> runParserWarn ws " x"
+-- These (ParserLeftover "x") ' '
+runParserWarn :: Parser String a -> ByteString -> These ParserWarning a
+runParserWarn p bs = case runParser p bs of
+  Err e -> This (ParserError e)
+  OK a "" -> That a
+  OK a x -> These (ParserLeftover $ B.take 200 x) a
+  Fail -> This ParserUncaught
+
+-- | Run parser, discards leftovers & throws an error on failure.
+--
+-- >>> runParser_ ws " "
+-- ' '
+--
+-- >>> runParser_ ws "x"
+-- *** Exception: uncaught parse error
+-- ...
+runParser_ :: Parser String a -> ByteString -> a
+runParser_ p bs = case runParser p bs of
+  Err e -> error e
+  OK a _ -> a
+  Fail -> error "uncaught parse error"
+
+-- | Consume whitespace.
+--
+-- >>> runParser ws_ " \nx"
+-- OK () "x"
+--
+-- >>> runParser ws_ "x"
+-- OK () "x"
+ws_ :: Parser e ()
+ws_ =
+  $( switch
+       [|
+         case _ of
+           " " -> ws_
+           "\n" -> ws_
+           "\t" -> ws_
+           "\r" -> ws_
+           "\f" -> ws_
+           _ -> pure ()
+         |]
+   )
+{-# INLINE ws_ #-}
+
+-- | \\n \\t \\f \\r and space
+isWhitespace :: Char -> Bool
+isWhitespace ' ' = True -- \x20 space
+isWhitespace '\x0a' = True -- \n linefeed
+isWhitespace '\x09' = True -- \t tab
+isWhitespace '\x0c' = True -- \f formfeed
+isWhitespace '\x0d' = True -- \r carriage return
+isWhitespace _ = False
+{-# INLINE isWhitespace #-}
+
+-- | single whitespace
+--
+-- >>> runParser ws " \nx"
+-- OK ' ' "\nx"
+ws :: Parser e Char
+ws = satisfy isWhitespace
+
+-- | multiple whitespace
+--
+-- >>> runParser wss " \nx"
+-- OK " \n" "x"
+--
+-- >>> runParser wss "x"
+-- Fail
+wss :: Parser e ByteString
+wss = byteStringOf $ some ws
+
+-- | single quote
+--
+-- >>> runParserMaybe sq "'"
+-- Just ()
+sq :: ParserT st e ()
+sq = $(char '\'')
+
+-- | double quote
+--
+-- >>> runParserMaybe dq "\""
+-- Just ()
+dq :: ParserT st e ()
+dq = $(char '"')
+
+-- | Parse whilst not a specific character
+--
+-- >>> runParser (nota 'x') "abcxyz"
+-- OK "abc" "xyz"
+nota :: Char -> Parser e ByteString
+nota c = withSpan (skipMany (satisfy (/= c))) (\() s -> unsafeSpanToByteString s)
+{-# INLINE nota #-}
+
+-- | Parse whilst satisfying a predicate.
+--
+-- >>> runParser (isa (=='x')) "xxxabc"
+-- OK "xxx" "abc"
+isa :: (Char -> Bool) -> Parser e ByteString
+isa p = withSpan (skipMany (satisfy p)) (\() s -> unsafeSpanToByteString s)
+{-# INLINE isa #-}
+
+-- | 'byteStringOf' but using withSpan internally. Doesn't seems faster...
+byteStringOf' :: Parser e a -> Parser e ByteString
+byteStringOf' p = withSpan p (\_ s -> unsafeSpanToByteString s)
+{-# INLINE byteStringOf' #-}
+
+-- | A single-quoted string.
+wrappedSq :: Parser b ByteString
+wrappedSq = $(char '\'') *> nota '\'' <* $(char '\'')
+{-# INLINE wrappedSq #-}
+
+-- | A double-quoted string.
+wrappedDq :: Parser b ByteString
+wrappedDq = $(char '"') *> nota '"' <* $(char '"')
+{-# INLINE wrappedDq #-}
+
+-- | A single-quoted or double-quoted string.
+--
+-- >>> runParserMaybe wrappedQ "\"quoted\""
+-- Just "quoted"
+--
+-- >>> runParserMaybe wrappedQ "'quoted'"
+-- Just "quoted"
+wrappedQ :: Parser e ByteString
+wrappedQ =
+  wrappedDq
+    <|> wrappedSq
+{-# INLINE wrappedQ #-}
+
+-- | A single-quoted or double-quoted wrapped parser.
+--
+-- >>> runParser (wrappedQNoGuard (many $ satisfy (/= '"'))) "\"name\""
+-- OK "name" ""
+--
+-- Will consume quotes if the underlying parser does.
+--
+-- >>> runParser (wrappedQNoGuard (many anyChar)) "\"name\""
+-- Fail
+wrappedQNoGuard :: Parser e a -> Parser e a
+wrappedQNoGuard p = wrapped dq p <|> wrapped sq p
+
+-- | xml production [25]
+--
+-- >>> runParserMaybe eq " = "
+-- Just ()
+--
+-- >>> runParserMaybe eq "="
+-- Just ()
+eq :: Parser e ()
+eq = ws_ *> $(char '=') <* ws_
+{-# INLINE eq #-}
+
+-- | some with a separator
+--
+-- >>> runParser (sep ws (many (satisfy (/= ' ')))) "a b c"
+-- OK ["a","b","c"] ""
+sep :: Parser e s -> Parser e a -> Parser e [a]
+sep s p = (:) <$> p <*> many (s *> p)
+
+-- | parser bracketed by two other parsers
+--
+-- >>> runParser (bracketed ($(char '[')) ($(char ']')) (many (satisfy (/= ']')))) "[bracketed]"
+-- OK "bracketed" ""
+bracketed :: Parser e b -> Parser e b -> Parser e a -> Parser e a
+bracketed o c p = o *> p <* c
+{-# INLINE bracketed #-}
+
+-- | Bracketed by square brackets.
+--
+-- >>> runParser bracketedSB "[bracketed]"
+-- OK "bracketed" ""
+bracketedSB :: Parser e [Char]
+bracketedSB = bracketed $(char '[') $(char ']') (many (satisfy (/= ']')))
+
+-- | parser wrapped by another parser
+--
+-- >>> runParser (wrapped ($(char '"')) (many (satisfy (/= '"')))) "\"wrapped\""
+-- OK "wrapped" ""
+wrapped :: Parser e () -> Parser e a -> Parser e a
+wrapped x p = bracketed x x p
+{-# INLINE wrapped #-}
+
+-- | A single digit
+--
+-- runParserMaybe digit "5"
+-- Just 5
+digit :: Parser e Int
+digit = (\c -> ord c - ord '0') <$> satisfyAscii isDigit
+
+-- | (unsigned) Int parser
+--
+-- >>> runParserMaybe int "567"
+-- Just 567
+int :: Parser e Int
+int = do
+  (place, n) <- chainr (\n (!place, !acc) -> (place * 10, acc + place * n)) digit (pure (1, 0))
+  case place of
+    1 -> empty
+    _ -> pure n
+
+digits :: Parser e (Int, Int)
+digits = chainr (\n (!place, !acc) -> (place * 10, acc + place * n)) digit (pure (1, 0))
+
+-- |
+-- >>> runParser double "1.234x"
+-- OK 1.234 "x"
+--
+-- >>> runParser double "."
+-- Fail
+--
+-- >>> runParser double "123"
+-- OK 123.0 ""
+--
+-- >>> runParser double ".123"
+-- OK 0.123 ""
+--
+-- >>> runParser double "123."
+-- OK 123.0 ""
+double :: Parser e Double
+double = do
+  (placel, nl) <- digits
+  withOption
+    ($(char '.') *> digits)
+    ( \(placer, nr) ->
+        case (placel, placer) of
+          (1, 1) -> empty
+          _ -> pure $ fromIntegral nl + fromIntegral nr / fromIntegral placer
+    )
+    ( case placel of
+        1 -> empty
+        _ -> pure $ fromIntegral nl
+    )
+
+minus :: Parser e ()
+minus = $(char '-')
+
+-- |
+-- >>> runParser (signed double) "-1.234x"
+-- OK (-1.234) "x"
+signed :: (Num b) => Parser e b -> Parser e b
+signed p = do
+  m <- optional minus
+  case m of
+    Nothing -> p
+    Just () -> negate <$> p
diff --git a/src/MarkupParse/Patch.hs b/src/MarkupParse/Patch.hs
new file mode 100644
--- /dev/null
+++ b/src/MarkupParse/Patch.hs
@@ -0,0 +1,94 @@
+-- | A patch function for <https://hackage.haskell.org/package/tree-diff tree-diff>.
+module MarkupParse.Patch
+  ( patch,
+    goldenPatch,
+  )
+where
+
+import Data.Foldable
+import Data.Maybe
+import Data.TreeDiff
+import Data.TreeDiff.OMap qualified as O
+import GHC.Exts
+import Test.Tasty (TestTree)
+import Test.Tasty.Golden.Advanced (goldenTest)
+import Prelude
+
+-- $setup
+-- >>> :set -XOverloadedStrings
+-- >>> import Data.TreeDiff
+-- >>> import MarkupParse.Patch
+
+-- | compare a markup file with a round-trip transformation.
+goldenPatch :: (ToExpr a) => (FilePath -> IO a) -> (a -> a) -> FilePath -> TestTree
+goldenPatch f testf fp =
+  goldenTest
+    fp
+    (f fp)
+    (testf <$> f fp)
+    (\expected actual -> pure (show . ansiWlEditExpr <$> patch expected actual))
+    (\_ -> pure ())
+
+isUnchangedList :: [Edit EditExpr] -> Bool
+isUnchangedList xs = all isCpy xs && all isUnchangedExpr (mapMaybe cpy xs)
+
+isCpy :: Edit a -> Bool
+isCpy (Cpy _) = True
+isCpy _ = False
+
+cpy :: Edit a -> Maybe a
+cpy (Cpy a) = Just a
+cpy _ = Nothing
+
+isUnchangedEdit :: Edit EditExpr -> Bool
+isUnchangedEdit (Cpy e) = isUnchangedExpr e
+isUnchangedEdit _ = False
+
+isUnchangedExpr :: EditExpr -> Bool
+isUnchangedExpr e = isUnchangedList $ getList e
+
+getList :: EditExpr -> [Edit EditExpr]
+getList (EditApp _ xs) = xs
+getList (EditRec _ m) = snd <$> O.toList m
+getList (EditLst xs) = xs
+getList (EditExp _) = []
+
+filterChangedExprs :: EditExpr -> Maybe EditExpr
+filterChangedExprs (EditApp n xs) =
+  case filter (not . isUnchangedEdit) (filterChangedEdits xs) of
+    [] -> Nothing
+    xs' -> Just $ EditApp n xs'
+filterChangedExprs (EditRec n m) =
+  case filterChangedEditMap (O.fromList $ filter (not . isUnchangedEdit . snd) (O.toList m)) of
+    Nothing -> Nothing
+    Just m' -> Just (EditRec n m')
+filterChangedExprs (EditLst xs) =
+  case filter (not . isUnchangedEdit) (filterChangedEdits xs) of
+    [] -> Nothing
+    xs' -> Just (EditLst xs')
+filterChangedExprs (EditExp _) = Nothing
+
+filterChangedEdit :: Edit EditExpr -> Maybe (Edit EditExpr)
+filterChangedEdit (Cpy a) = Cpy <$> filterChangedExprs a
+filterChangedEdit x = Just x
+
+filterChangedEdit' :: (f, Edit EditExpr) -> Maybe (f, Edit EditExpr)
+filterChangedEdit' (f, e) = (f,) <$> filterChangedEdit e
+
+filterChangedEdits :: [Edit EditExpr] -> [Edit EditExpr]
+filterChangedEdits xs = mapMaybe filterChangedEdit xs
+
+filterChangedEditMap :: O.OMap FieldName (Edit EditExpr) -> Maybe (O.OMap FieldName (Edit EditExpr))
+filterChangedEditMap m = case xs' of
+  [] -> Nothing
+  xs'' -> Just $ O.fromList xs''
+  where
+    xs = O.toList m
+    xs' = mapMaybe filterChangedEdit' xs
+
+-- | 'ediff' with unchanged sections filtered out
+--
+-- >>> show $ ansiWlEditExpr <$> patch [1, 2, 3, 5] [0, 1, 2, 4, 6]
+-- "Just [+0, -3, +4, -5, +6]"
+patch :: (ToExpr a) => a -> a -> Maybe (Edit EditExpr)
+patch m m' = filterChangedEdit $ ediff m m'