packages feed

zenacy-html (empty) → 2.0.0

raw patch · 39 files changed

+16002/−0 lines, 39 filesdep +HUnitdep +basedep +bytestringsetup-changed

Dependencies added: HUnit, base, bytestring, containers, criterion, data-default, dlist, extra, mtl, pretty-show, raw-strings-qq, safe, safe-exceptions, test-framework, test-framework-hunit, text, transformers, vector, word8, zenacy-html

Files

+ CHANGES.md view
@@ -0,0 +1,9 @@+# Change Log++## 2.0.0++* Initial FOSS release++## 1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 Michael Williams++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,241 @@+# Zenacy HTML [![Hackage version](https://img.shields.io/hackage/v/zenacy-html.svg?label=Hackage)](https://hackage.haskell.org/package/zenacy-html) [![Stackage version](https://www.stackage.org/package/zenacy-html/badge/nightly?label=Stackage)](https://www.stackage.org/package/zenacy-html) [![Linux build status](https://img.shields.io/travis/mlcfp/zenacy-html/master.svg?label=Linux%20build)](https://travis-ci.org/mlcfp/zenacy-html)++Zenacy HTML is an HTML parsing and processing library that implements the+WHATWG HTML parsing standard.  The standard is described as a state machine+that this library implements exactly as spelled out including all the error+handling, recovery, and conformance checks that makes it robust in handling+any HTML pulled from the web.  In addition to parsing, the library provides+many processing features to help extract information from web pages or+rewrite them and render the modified results.++## Introduction++The Zenacy HTML parser is an implementation of the HTML parsing standard+defined by the WHATWG.++https://html.spec.whatwg.org/multipage/parsing.html++The standard defines a parsing state machine, so it is very prescriptive+on how HTML is handled including many edge cases and error recovery.+This library aims to follow the standard closely in such a way to match the+code back to the standard and make future updates straightforward.++One of the main uses an a HTML parser is for extracting information from+the web.  Having a parser that can handle all the nuances of poorly+formatted HTML helps to make this extraction as robust as possible.+This was a key motivation in deciding to implement a parser in this fashion.+Additionally, the standard describes the algorithms needed to produce the+correct document structure.  Applications that are sensitive to the+document structure, such as extracting and rewriting large portions of+a web page, may benefit from Zenacy HTML.++The library provides a wide variety of features including:++* A fully standard compliant HTML parser+* HTML Fragment parsing+* Document rendering+* A zipper type for document traversal+* An iterator type for document walking+* Various functions for processing aspects of HTML+* Lightweight queries for rewriting++## Parsing++The library is designed to be imported unqualified.++```haskell+import Zenacy.HTML+```++The `htmlParseEasy` function can be used to parse an HTML document string+and return the document model.++```haskell+htmlParseEasy "<div>HelloWorld</div>"+```++Note that some of the missing elements where automatically added to+the document structure as required by the standard.++```haskell+HTMLDocument ""+  [ HTMLElement "html" HTMLNamespaceHTML []+    [ HTMLElement "head" HTMLNamespaceHTML [] []+    , HTMLElement "body" HTMLNamespaceHTML []+      [ HTMLElement "div" HTMLNamespaceHTML []+        [ HTMLText "HelloWorld" ] ] ] ]+```++The parsed result can also be rendered using `htmlRender`.++```haskell+htmlRender $ htmlParseEasy "<div>HelloWorld</div>"+```++The resulting rendered document appears like so.++```html+<html><head></head><body><div>HelloWorld</div></body></html>+```++## Rewriting++This example illustrates a function that converts span elements to divs.++```haskell+rewrite :: Text -> Text+rewrite = htmlRender . htmlMapElem f . fromJust . htmlDocHtml . htmlParseEasy+  where+    f x+      | htmlElemHasName "span" x = htmlElemRename "div" x+      | otherwise = x++rewrite "<span>Hello</span><span>World</span>"+```++Running the above gives the modified document.++```html+<html><head></head><body><div>Hello</div><div>World</div></body></html>+```++## Extraction++The next example shows one way to find all the hyperlinks in a document.+This solution recurses over the document elements while ignoring fragments+and templates.++```haskell+extract :: Text -> [Text]+extract = go . htmlParseEasy+  where+    go = \case+      HTMLDocument n c ->+        concatMap go c+      e @ (HTMLElement "a" s a c) ->+        case htmlElemAttrFind (htmlAttrHasName "href") e of+          Just (HTMLAttr n v s) ->+            v : concatMap go c+          Nothing ->+            concatMap go c+      HTMLElement n s a c ->+        concatMap go c+      _otherwise ->+        []++extract "<a href=\"https://example1.com\"></a><a href=\"https://example2.com\"></a>"+```++The extract function will give the following list.++```haskell+[ "https://example1.com"+, "https://example2.com"+]+```++## Queries++The library includes a basic query facility implemented as a thin wrapper+around an `HTMLZipper`.  Queries match patterns in HTML structures and can+be used to extract information or update documents.  As a first example,+consider the following HTML.++```html+<p>+  <span id="x" class="y z"></span>+  <br>+  <a href="bbb">AAA</a>+  <img>+</p>+```++The HTML can be parsed as normal.  Note though the additional step of+whitespace removal, which is often important in documents that include+indentation such as above.++```haskell+fromJust . htmlSpaceRemove . fromJust . htmlDocBody . htmlParseEasy+```++Now a query function can be defined.  This function expects to be given+a `body` element whose first child is a `p` element whose first child+has an id of `x` whose second sibling is an anchor element.  If all of+those conditions are met, the the text contents of the anchor is returned.++```haskell+query :: HTMLNode -> Maybe Text+query = htmlQueryExec $ do+  htmlQueryName "body"+  htmlQueryFirst+  htmlQueryName "p"+  htmlQueryFirst+  htmlQueryId "x"+  htmlQueryNext+  htmlQueryNext+  htmlQueryName "a"+  a <- htmlQueryNode+  htmlQuerySucc $+    fromMaybe "" $ htmlElemText a+```++Running the query on the parsed document will give the result.++```haskell+Just "AAA"+```++Queries can also be used to modifiy documents.  In the next example, let's+say we would like to find any `img` that is the only content in a `div` and+replace the `div` with a link.  The document could look as follows.++```html+<section><div><img src="aaa"></div></section>+<section><div><img src="bbb"></div></section>+<section><div><img src="ccc"></div></section>+```++A query function can be defined to match the desired pattern and return the+modified element.++```haskell+query2 :: HTMLNode -> HTMLNode+query2 = htmlQueryTry $ do+  htmlQueryName "div"+  htmlQueryOnly "img"+  a <- htmlQueryNode+  let Just b = htmlElemGetAttr "src" a+  htmlQuerySucc $+    htmlElem "a" [ htmlAttr "href" b ]+      [ htmlText b ]+```++The query can then be applied to the entire document using `htmlMapElem`.++```haskell+htmlMapElem query2+```++Rendering the mapped query with give the updated content.++```html+<section><a href="aaa">aaa</a></section>+<section><a href="bbb">bbb</a></section>+<section><a href="ccc">ccc</a></section>+```++## Samples++The unit tests include the above samples as well as many other example+usages of the library.++## Origin++Zenacy HTML was originally developed for Zenacy Reader Technologies LLC+starting around 2015 and used in a web reading SaaS for a few years.+The need to understand and handle the wide variety and sublties of HTML+found on the web lead to the development of library that closely followed+the standard.  The library was tweaked and optimized a bit and though+there is room for more improvements the result worked quite well in+production (a lot of credit goes to the GHC team and Haskell community+for providing such great, fast functional programming tools).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main where++import Zenacy.HTML+import Control.Monad+import Data.Default+  ( Default(..)+  )+import qualified Data.Text as T+  ( unpack+  )+import qualified Data.Text.IO as T+  ( readFile+  )+import System.Environment+  ( getArgs+  )++-- | Application main.+main :: IO ()+main = getArgs >>= \case+  (x:[]) ->+    validate x+  _otherwise ->+    pure ()++validate :: FilePath -> IO ()+validate x = do+  a <- T.readFile x+  let p = htmlParse def { htmlOptionLogErrors = True }+  case p a of+    Left (HTMLError {..}) -> do+      putStrLn $ T.unpack htmlErrorText+    Right (HTMLResult {..}) -> do+      if | null htmlResultErrors ->+             putStrLn "no warnings"+         | otherwise -> do+             forM_ htmlResultErrors+               ( putStrLn+               . T.unpack+               . htmlErrorText+               )
+ bench/BenchMain.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Char+import Zenacy.HTML.Internal.Lexer+import Zenacy.HTML.Internal.Token+import Criterion.Main+import Control.Monad+import Control.Monad.ST+import Data.ByteString+  ( ByteString+  )+import qualified Data.ByteString as S+import Data.Default+  ( Default(..)+  )+import Text.RawString.QQ++main :: IO ()+main = do+  putStrLn $ "data size: " ++ show (S.length (htmlBuild 1000) `div` 1024) ++ "KB"+  defaultMain+    [ env setupEnv $ \ ~x -> bgroup "a"+      [ bench "1" $ whnf countTokens x+      ]+    ]++setupEnv = do+  pure $ htmlBuild 1000++countTokens :: ByteString -> Int+countTokens s =+  runST $ do+    Right x <- lexerNew def { lexerOptionInput = s }+    go x 0+  where+    go x a = do+      lexerNext x+      n <- tokenCount (lexerToken x)+      if n == 0+         then pure a+         else do+           eof <- tokenHasEOF (lexerToken x)+           if eof+              then pure $ a + n+              else go x $ a + n++htmlData = [r|<html><body><a href="https://example.com">sjdkhfljksdhfjshdlkjfhsdjkhfljskdhlfjshldjkfhsd</a></body></html>|]++htmlBuild x = S.concat $ take x $ repeat htmlData
+ src/Zenacy/HTML.hs view
@@ -0,0 +1,238 @@+-- | Zenacy HTML is an HTML parsing and processing library that implements the+-- WHATWG HTML parsing standard.  The standard is described as a state machine+-- that this library implements exactly as spelled out including all the error+-- handling, recovery, and conformance checks that makes it robust in handling+-- any HTML pulled from the web.  In addition to parsing, the library provides+-- many processing features to help extract information from web pages or+-- rewrite them and render the modified results.+module Zenacy.HTML+  ( +  -- * Introduction+  -- $intro++  -- * Parsing+  -- $parse++  -- * Rewriting+  -- $rewrite++  -- * Extraction+  -- $extract++  -- * Queries+  -- $query++  -- * Samples+  -- $samples++  -- * Origin+  -- $history++  module X+  ) where++import Zenacy.HTML.Internal.HTML as X+import Zenacy.HTML.Internal.Filter as X+import Zenacy.HTML.Internal.Image as X+import Zenacy.HTML.Internal.Oper as X+import Zenacy.HTML.Internal.Query as X+import Zenacy.HTML.Internal.Render as X+import Zenacy.HTML.Internal.Zip as X++-- $intro+--+-- The Zenacy HTML parser is an implementation of the HTML parsing standard+-- defined by the WHATWG.+--+-- https://html.spec.whatwg.org/multipage/parsing.html+--+-- The standard defines a parsing state machine, so it is very prescriptive+-- on how HTML is handled including many edge cases and error recovery.+-- This library aims to follow the standard closely in such a way to match the+-- code back to the standard and make future updates straightforward.+--+-- One of the main uses an a HTML parser is for extracting information from+-- the web.  Having a parser that can handle all the nuances of poorly+-- formatted HTML helps to make this extraction as robust as possible.+-- This was a key motivation in deciding to implement a parser in this fashion.+-- Additionally, the standard describes the algorithms needed to produce the+-- correct document structure.  Applications that are sensitive to the+-- document structure, such as extracting and rewriting large portions of+-- a web page, may benefit from Zenacy HTML.+--+-- The library provides a wide variety of features including:+--+-- * A fully standard compliant HTML parser+-- * HTML Fragment parsing+-- * Document rendering+-- * A zipper type for document traversal+-- * An iterator type for document walking+-- * Various functions for processing aspects of HTML+-- * Lightweight queries for rewriting+--+-- $parse+--+-- The library is designed to be imported unqualified.+--+-- > import Zenacy.HTML+--+-- The `htmlParseEasy` function can be used to parse an HTML document string+-- and return the document model.+--+-- > htmlParseEasy "<div>HelloWorld</div>"+--+-- Note that some of the missing elements where automatically added to+-- the document structure as required by the standard.+--+-- > HTMLDocument ""+-- >   [ HTMLElement "html" HTMLNamespaceHTML []+-- >     [ HTMLElement "head" HTMLNamespaceHTML [] []+-- >     , HTMLElement "body" HTMLNamespaceHTML []+-- >       [ HTMLElement "div" HTMLNamespaceHTML []+-- >         [ HTMLText "HelloWorld" ] ] ] ]+--+-- The parsed result can also be rendered using `htmlRender`.+--+-- > htmlRender $ htmlParseEasy "<div>HelloWorld</div>"+--+-- The resulting rendered document appears like so.+--+-- > <html><head></head><body><div>HelloWorld</div></body></html>+--+-- $rewrite+--+-- This example illustrates a function that converts span elements to divs.+-- +-- > rewrite :: Text -> Text+-- > rewrite = htmlRender . htmlMapElem f . fromJust . htmlDocHtml . htmlParseEasy+-- >   where+-- >     f x+-- >       | htmlElemHasName "span" x = htmlElemRename "div" x+-- >       | otherwise = x+-- >+-- > rewrite "<span>Hello</span><span>World</span>"+--+-- Running the above gives the modified document.+--+-- > <html><head></head><body><div>Hello</div><div>World</div></body></html>+--+-- $extract+--+-- The next example shows one way to find all the hyperlinks in a document.+-- This solution recurses over the document elements while ignoring fragments+-- and templates.+--+-- > extract :: Text -> [Text]+-- > extract = go . htmlParseEasy+-- >   where+-- >     go = \case+-- >       HTMLDocument n c ->+-- >         concatMap go c+-- >       e @ (HTMLElement "a" s a c) ->+-- >         case htmlElemAttrFind (htmlAttrHasName "href") e of+-- >           Just (HTMLAttr n v s) ->+-- >             v : concatMap go c+-- >           Nothing ->+-- >             concatMap go c+-- >       HTMLElement n s a c ->+-- >         concatMap go c+-- >       _otherwise ->+-- >         []+-- >+-- > extract "<a href=\"https://example1.com\"></a><a href=\"https://example2.com\"></a>"+--+-- The extract function will give the following list.+--+-- > [ "https://example1.com"+-- > , "https://example2.com"+-- > ]+--+-- $query+--+-- The library includes a basic query facility implemented as a thin wrapper+-- around an `HTMLZipper`.  Queries match patterns in HTML structures and can+-- be used to extract information or update documents.  As a first example,+-- consider the following HTML.+--+-- > <p>+-- >   <span id="x" class="y z"></span>+-- >   <br>+-- >   <a href="bbb">AAA</a>+-- >   <img>+-- > </p>+--+-- The HTML can be parsed as normal.  Note though the additional step of+-- whitespace removal, which is often important in documents that include+-- indentation such as above.+--+-- > fromJust . htmlSpaceRemove . fromJust . htmlDocBody . htmlParseEasy+--+-- Now a query function can be defined.  This function expects to be given+-- a @body@ element whose first child is a @p@ element whose first child+-- has an id of @x@ whose second sibling is an anchor element.  If all of+-- those conditions are met, the the text contents of the anchor is returned.+--+-- > query :: HTMLNode -> Maybe Text+-- > query = htmlQueryExec $ do+-- >   htmlQueryName "body"+-- >   htmlQueryFirst+-- >   htmlQueryName "p"+-- >   htmlQueryFirst+-- >   htmlQueryId "x"+-- >   htmlQueryNext+-- >   htmlQueryNext+-- >   htmlQueryName "a"+-- >   a <- htmlQueryNode+-- >   htmlQuerySucc $+-- >     fromMaybe "" $ htmlElemText a+--+-- Running the query on the parsed document will give the result.+--+-- > Just "AAA"+--+-- Queries can also be used to modifiy documents.  In the next example, let's+-- say we would like to find any @img@ that is the only content in a @div@ and+-- replace the @div@ with a link.  The document could look as follows.+-- +-- > <section><div><img src="aaa"></div></section>+-- > <section><div><img src="bbb"></div></section>+-- > <section><div><img src="ccc"></div></section>+--+-- A query function can be defined to match the desired pattern and return the+-- modified element.+--+-- > query2 :: HTMLNode -> HTMLNode+-- > query2 = htmlQueryTry $ do+-- >   htmlQueryName "div"+-- >   htmlQueryOnly "img"+-- >   a <- htmlQueryNode+-- >   let Just b = htmlElemGetAttr "src" a+-- >   htmlQuerySucc $+-- >     htmlElem "a" [ htmlAttr "href" b ]+-- >       [ htmlText b ]+--+-- The query can then be applied to the entire document using `htmlMapElem`.+--+-- > htmlMapElem query2+--+-- Rendering the mapped query with give the updated content.+--+-- > <section><a href="aaa">aaa</a></section>+-- > <section><a href="bbb">bbb</a></section>+-- > <section><a href="ccc">ccc</a></section>+--+-- $samples+--+-- The unit tests include the above samples as well as many other example+-- usages of the library.+--+-- $history+--+-- Zenacy HTML was originally developed for Zenacy Reader Technologies LLC+-- starting around 2015 and used in a web reading SaaS for a few years.+-- The need to understand and handle the wide variety and sublties of HTML+-- found on the web lead to the development of library that closely followed+-- the standard.  The library was tweaked and optimized a bit and though+-- there is room for more improvements the result worked quite well in+-- production (a lot of credit goes to the GHC team and Haskell community+-- for providing such great, fast functional programming tools).
+ src/Zenacy/HTML/Internal/BS.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Convenience wrappers and utilities for byte strings.+module Zenacy.HTML.Internal.BS+  ( BS+  -- * Word functions.+  , bsEmpty+  , bsOnly+  , bsLen+  , bsPack+  , bsUnpack+  , bsConcat+  , bsIndex+  , bsElemIndex+  , bsLower+  , bsPrefixCI+  , bsPart+  , bsLast+  , bsTake+  , bsDrop+  , bsUncons+  -- * Character functions.+  , bcPack+  , bcUnpack+  ) where++import Zenacy.HTML.Internal.Char+import Data.ByteString+  ( ByteString+  )+import qualified Data.ByteString as S+  ( concat+  , drop+  , elemIndex+  , empty+  , isPrefixOf+  , index+  , last+  , length+  , map+  , pack+  , singleton+  , take+  , uncons+  , unpack+  )+import qualified Data.ByteString.Char8 as C+  ( pack+  , unpack+  )+import Data.Word+  ( Word8+  )++-- | A type abbreviation for a byte string.+type BS = ByteString++-- | An empty byte string.+bsEmpty :: BS+bsEmpty = S.empty+{-# INLINE bsEmpty #-}++-- | A byte string with only one character.+bsOnly :: Word8 -> BS+bsOnly = S.singleton+{-# INLINE bsOnly #-}++-- | Gets the length of a byte string.+bsLen :: BS -> Int+bsLen = S.length+{-# INLINE bsLen #-}++-- | Converts a list of characters to a byte string.+bsPack :: [Word8] -> BS+bsPack = S.pack+{-# INLINE bsPack #-}++-- | Converts a byte string to a list of characters.+bsUnpack :: BS -> [Word8]+bsUnpack = S.unpack+{-# INLINE bsUnpack #-}++-- | Concatenates byte strings into one.+bsConcat :: [BS] -> BS+bsConcat = S.concat+{-# INLINE bsConcat #-}++-- | Gets the character at an index in a byte string.+bsIndex :: BS -> Int -> Word8+bsIndex = S.index+{-# INLINE bsIndex #-}++-- | Gets the index of a character in a byte string.+bsElemIndex :: Word8 -> BS -> Maybe Int+bsElemIndex = S.elemIndex+{-# INLINE bsElemIndex #-}++-- | Converts a bytestring to lowercase.+bsLower :: BS -> BS+bsLower = S.map chrToLower++-- | Determines if a bytestring is a case-insensitive prefix of another.+bsPrefixCI :: BS -> BS -> Bool+bsPrefixCI x y = bsLower x `S.isPrefixOf` bsLower y++-- | Selects a substring for a byte string.+bsPart :: Int -> Int -> BS -> BS+bsPart offset len = S.take len . S.drop offset++-- | Returns the last word of a bytestring.+bsLast :: BS -> Maybe Word8+bsLast x+  | bsLen x > 0 = Just $ S.last x+  | otherwise = Nothing++-- | Takes characters from a byte string.+bsTake :: Int -> BS -> BS+bsTake = S.take+{-# INLINE bsTake #-}++-- | Drops characters from a byte string.+bsDrop :: Int -> BS -> BS+bsDrop = S.drop+{-# INLINE bsDrop #-}++-- | Removes a character from the end of a byte string.+bsUncons :: BS -> Maybe (Word8, BS)+bsUncons = S.uncons+{-# INLINE bsUncons #-}++-- | Converts a string to a byte string.+bcPack :: String -> BS+bcPack = C.pack+{-# INLINE bcPack #-}++-- | Converts a bytestring to a string.+bcUnpack :: BS -> String+bcUnpack = C.unpack+{-# INLINE bcUnpack #-}
+ src/Zenacy/HTML/Internal/Buffer.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines an buffer type.+module Zenacy.HTML.Internal.Buffer+  ( Buffer(..)+  , bufferNew+  , bufferCapacity+  , bufferSize+  , bufferReset+  , bufferAppend+  , bufferApply+  , bufferTake+  , bufferContains+  , bufferPack+  , bufferString+  ) where++import Zenacy.HTML.Internal.BS+-- import Foreign+--   ( castPtr+--   , withForeignPtr+--   )+import Control.Monad.ST+  ( ST+  )+import Data.STRef+  ( STRef+  , newSTRef+  , readSTRef+  , writeSTRef+  )+import qualified Data.DList as D+  ( empty+  , snoc+  , toList+  )+-- import Data.Vector.Storable.Mutable+import qualified Data.Vector.Unboxed as U+  ( freeze+  , slice+  , toList+  )+import Data.Vector.Unboxed.Mutable+  ( MVector+  )+import qualified Data.Vector.Unboxed.Mutable as U+-- import qualified Data.Vector.Storable.Mutable as U+  ( new+  , length+  , read+  , write+  , grow+  -- , unsafeToForeignPtr0+  )+import Data.Word+  ( Word8+  )+-- import System.IO.Unsafe+--   ( unsafePerformIO+--   )++-- | A type of buffer used to hold bytes.+data Buffer s = Buffer+  { bfCntl :: MVector s Int+  , bfData :: MVector s Word8+  }++-- | Makes a new buffer.+bufferNew :: ST s (STRef s (Buffer s))+bufferNew = do+  c <- U.new 1+  d <- U.new 100+  r <- newSTRef (Buffer c d)+  bufferReset r+  pure r++-- | Gets the capacity of the buffer.+bufferCapacity :: STRef s (Buffer s) -> ST s (Int, Int)+bufferCapacity r = do+  Buffer{..} <- readSTRef r+  pure (U.length bfCntl, U.length bfData)++-- | Gets the size of the buffer.+bufferSize :: STRef s (Buffer s) -> ST s Int+bufferSize r = do+  Buffer{..} <- readSTRef r+  U.read bfCntl 0++-- | Resets a buffer.+bufferReset :: STRef s (Buffer s) -> ST s ()+bufferReset r = do+  Buffer{..} <- readSTRef r+  U.write bfCntl 0 0++-- | Appends a word to a buffer.+bufferAppend :: Word8 -> STRef s (Buffer s) -> ST s ()+bufferAppend word r = do+  Buffer{..} <- readSTRef r+  i <- U.read bfCntl 0+  d <- if i + 1 < U.length bfData+       then pure bfData+       else do+         v <- U.grow bfData $ U.length bfData+         writeSTRef r $ Buffer bfCntl v+         pure v+  U.write d i word+  U.write bfCntl 0 (i + 1)++-- | Applies an action to each word in the buffer.+bufferApply :: (Word8 -> ST s ()) -> STRef s (Buffer s) -> ST s ()+bufferApply f r = do+  Buffer{..} <- readSTRef r+  n <- U.read bfCntl 0+  let go i+        | i < n =+            U.read bfData i >>= f >> go (i + 1)+        | otherwise =+            pure ()+  go 0++-- | Takes elements from the front of the buffer.+bufferTake :: Int -> STRef s (Buffer s) -> ST s [Word8]+bufferTake x r = do+  Buffer{..} <- readSTRef r+  n <- min x <$> U.read bfCntl 0+  let go i y+        | i < n = do+            a <- U.read bfData i+            go (i + 1) $ D.snoc y a+        | otherwise =+            pure $ D.toList y+  go 0 D.empty++-- | Determines if a buffer has the specified contents.+bufferContains :: [Word8] -> STRef s (Buffer s) -> ST s Bool+bufferContains x r = do+  n <- bufferSize r+  if n /= length x+     then pure False+     else do+       a <- bufferTake n r+       pure $ x == a++-- | Packs a buffer into a byte string.+bufferPack :: STRef s (Buffer s) -> ST s BS+bufferPack r = do+  Buffer{..} <- readSTRef r+  n <- U.read bfCntl 0+  bufferString bfData n++-- | Converts a storable vector to a byte string.+bufferString :: MVector s Word8 -> Int -> ST s BS+bufferString v n =+  U.freeze v >>= pure . bsPack . U.toList . U.slice 0 n+  -- pure $ unsafePerformIO $ do+  --   let (f, _) = U.unsafeToForeignPtr0 v+  --   withForeignPtr f $ \p ->+  --     S.packCStringLen (castPtr p, n)
+ src/Zenacy/HTML/Internal/Char.hs view
@@ -0,0 +1,240 @@+-- | Functions for identifying and manipulating character codes.+module Zenacy.HTML.Internal.Char+  ( ctow+  , chrWord8+  , chrUTF8+  , chrSurrogate+  , chrScalar+  , chrNonCharacter+  , chrASCIIDigit+  , chrASCIIUpperHexDigit+  , chrASCIILowerHexDigit+  , chrASCIIHexDigit+  , chrASCIIUpperAlpha+  , chrASCIILowerAlpha+  , chrASCIIAlpha+  , chrASCIIAlphanumeric+  , chrWhitespace+  , chrC0Control+  , chrControl+  , chrToUpper+  , chrToLower+  , chrAmpersand+  , chrEOF+  , chrExclamation+  , chrGreater+  , chrLess+  , chrQuestion+  , chrSolidus+  , chrTab+  , chrLF+  , chrFF+  , chrCR+  , chrSpace+  , chrEqual+  , chrQuote+  , chrApostrophe+  , chrGrave+  , chrNumberSign+  , chrHyphen+  , chrBracketRight+  , chrSemicolon+  , chrUpperX+  , chrLowerX+  ) where++import qualified Data.ByteString as S+  ( unpack+  )+import Data.Char+  ( chr+  , ord+  )+import qualified Data.Text as Text+  ( singleton+  )+import qualified Data.Text.Encoding as Text+  ( encodeUtf8+  )+import Data.Word8++-- | Converts a character to a Word8.+ctow :: Char -> Word8+ctow x = fromIntegral (ord x)++-- | Determines if a character code is in the range of a Word8.+chrWord8 :: Int -> Bool+chrWord8 x = x >= 0 && x <= 0xFF++-- | Decodes a UTF8 unicode character.+chrUTF8 :: Int -> [Word8]+chrUTF8 = S.unpack . Text.encodeUtf8 . Text.singleton . chr++-- | Determines if a character code is a surrogate.+chrSurrogate :: Int -> Bool+chrSurrogate x = x >= 0xD800 && x <= 0xDFFF++-- | Determines if a character code is a scalar.+chrScalar :: Int -> Bool+chrScalar = not . chrSurrogate++-- | Determines if a code is a not a character code.+chrNonCharacter :: Int -> Bool+chrNonCharacter x =+  (x >= 0xFDD0 && x <= 0xFDEF) ||+  any (==x)+    [ 0xFFFE, 0xFFFF, 0x1FFFE, 0x1FFFF+    , 0x2FFFE, 0x2FFFF, 0x3FFFE, 0x3FFFF+    , 0x4FFFE, 0x4FFFF, 0x5FFFE, 0x5FFFF+    , 0x6FFFE, 0x6FFFF, 0x7FFFE, 0x7FFFF+    , 0x8FFFE, 0x8FFFF, 0x9FFFE, 0x9FFFF+    , 0xAFFFE, 0xAFFFF, 0xBFFFE, 0xBFFFF+    , 0xCFFFE, 0xCFFFF, 0xDFFFE, 0xDFFFF+    , 0xEFFFE, 0xEFFFF, 0xFFFFE, 0xFFFFF+    , 0x10FFFE, 0x10FFFF+    ]++-- | Determines if a character is an ASCII digit.+chrASCIIDigit :: Word8 -> Bool+chrASCIIDigit x = x >= 0x30 && x <= 0x39++-- | Determines if a character is an ASCII uppercase hex digit.+chrASCIIUpperHexDigit :: Word8 -> Bool+chrASCIIUpperHexDigit x = chrASCIIDigit x || (x >= 0x41 && x <= 0x46)++-- | Determines if a character is an ASCII lowercase hex digit.+chrASCIILowerHexDigit :: Word8 -> Bool+chrASCIILowerHexDigit x = chrASCIIDigit x || (x >= 0x61 && x <= 0x66)++-- | Determines if a character is an ASCII hex digit (any case).+chrASCIIHexDigit :: Word8 -> Bool+chrASCIIHexDigit x = chrASCIIUpperHexDigit x || chrASCIILowerHexDigit x++-- | Determines if a character is an ASCII uppercase alpha character.+chrASCIIUpperAlpha :: Word8 -> Bool+chrASCIIUpperAlpha x = x >= 0x41 && x <= 0x5A++-- | Determines if a character is an ASCII lowercase alpha character.+chrASCIILowerAlpha :: Word8 -> Bool+chrASCIILowerAlpha x = x >= 0x61 && x <= 0x7A++-- | Determines if a character is an ASCII alpha character (any case).+chrASCIIAlpha :: Word8 -> Bool+chrASCIIAlpha x = chrASCIIUpperAlpha x || chrASCIILowerAlpha x++-- | Determines if a character is an ASCII alphanumeric character (any case).+chrASCIIAlphanumeric :: Word8 -> Bool+chrASCIIAlphanumeric x = chrASCIIDigit x || chrASCIIAlpha x++-- | Determines if a character is a whitespace character.+chrWhitespace :: Word8 -> Bool+chrWhitespace x =+  x == chrTab ||+  x == chrLF ||+  x == chrFF ||+  x == chrCR ||+  x == chrSpace++-- | Determines if a character is a C0 control character.+chrC0Control :: Word8 -> Bool+chrC0Control x = x >= 0x00 && x <= 0x1F++-- | Determines if a character is a control character.+chrControl :: Word8 -> Bool+chrControl x = chrC0Control x || (x >= 0x7F && x <= 0x9F)++-- | Converts a character to uppercase.+chrToUpper :: Word8 -> Word8+chrToUpper = toUpper++-- | Converts a character to lowercase.+chrToLower :: Word8 -> Word8+chrToLower = toLower++-- | Character code for ampersand.+chrAmpersand :: Word8+chrAmpersand = _ampersand++-- | Character code for EOF.+chrEOF :: Word8+chrEOF = _nul++-- | Character code for exclamation.+chrExclamation :: Word8+chrExclamation = _exclam++-- | Character code for greater.+chrGreater :: Word8+chrGreater = _greater++-- | Character code for less.+chrLess :: Word8+chrLess = _less++-- | Character code for question.+chrQuestion :: Word8+chrQuestion = _question++-- | Character code for solidus (slash).+chrSolidus :: Word8+chrSolidus = _slash++-- | Character code for tab.+chrTab :: Word8+chrTab = _tab++-- | Character code for line feed.+chrLF :: Word8+chrLF = _lf++-- | Character code for form feed.+chrFF :: Word8+chrFF = _np++-- | Character code for carraige return.+chrCR :: Word8+chrCR = _cr++-- | Character code for space.+chrSpace :: Word8+chrSpace = _space++-- | Character code for equal.+chrEqual :: Word8+chrEqual = _equal++-- | Character code for quote.+chrQuote :: Word8+chrQuote = _quotedbl++-- | Character code for apostrophe.+chrApostrophe :: Word8+chrApostrophe = _quotesingle++-- | Character code for grave.+chrGrave :: Word8+chrGrave = _grave++-- | Character code for number sign.+chrNumberSign :: Word8+chrNumberSign = _numbersign++-- | Character code for hyphen.+chrHyphen :: Word8+chrHyphen = _hyphen++-- | Character code for right bracket.+chrBracketRight :: Word8+chrBracketRight = _bracketright++-- | Character code for semicolon.+chrSemicolon :: Word8+chrSemicolon = _semicolon++-- | Character code for upper x.+chrUpperX :: Word8+chrUpperX = 0x58++-- | Character code for lower x.+chrLowerX :: Word8+chrLowerX = 0x78
+ src/Zenacy/HTML/Internal/Core.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines core functions that augment the prelude.+module Zenacy.HTML.Internal.Core+  ( updateSTRef+  , rref+  , wref+  , uref+  , findSucc+  , insertBefore+  , removeFirst+  , textExtract+  , textBlank+  , textReadDec+  ) where++import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( breakOn+  , drop+  , length+  , null+  , replicate+  , singleton+  , unpack+  )+import Control.Monad.ST+  ( ST+  )+import Data.STRef+  ( STRef+  , readSTRef+  , writeSTRef+  )+import qualified Numeric as N+  ( readDec+  )++-- | Updates an STRef by applying a function to its value.+updateSTRef :: STRef s a -> (a -> a) -> ST s ()+updateSTRef r f = readSTRef r >>= writeSTRef r . f+{-# INLINE updateSTRef #-}++-- | Abbreviation for reading an STRef.+rref :: STRef s a -> ST s a+rref = readSTRef+{-# INLINE rref #-}++-- | Abbreviation for writing an STRef.+wref :: STRef s a -> a -> ST s ()+wref = writeSTRef+{-# INLINE wref #-}++-- | Abbreviation for updating an STRef.+uref :: STRef s a -> (a -> a) -> ST s ()+uref = updateSTRef+{-# INLINE uref #-}++-- | Finds the element in a list that is the succeessor of the element+--   matching a predicate.+findSucc :: (a -> Bool) -> [a] -> Maybe a+findSucc p [] = Nothing+findSucc p (y:x:xs) = if p y then Just x else findSucc p (x:xs)+findSucc p (x:xs) = findSucc p xs++-- | Inserts an element in a list before the element satisfied by a predicate.+insertBefore :: (a -> Bool) -> a -> [a] -> [a]+insertBefore f _ [] = []+insertBefore f x (y:ys) = if f y then x : y : ys else y : insertBefore f x ys++-- | Removes the first item from a list that satisfies a predicate.+removeFirst :: (a -> Bool) -> [a] -> [a]+removeFirst p [] = []+removeFirst p (x:xs) = if p x then xs else x : removeFirst p xs++-- | Extracts a range of text bewteen two delimiters.+textExtract :: Text -> Text -> Text -> Maybe Text+textExtract d0 d1 t+  | T.null b = Nothing+  | T.null y = Nothing+  | T.null x = Nothing+  | otherwise = Just x+  where+    (a,b) = T.breakOn d0 t+    (x,y) = T.breakOn d1 $ T.drop (T.length d0) b++-- | Returns a blank text of the specified length.+textBlank :: Int -> Text+textBlank x = T.replicate x (T.singleton ' ')++-- | Converts a decimal string to a integer.+textReadDec :: Text -> Maybe Int+textReadDec x =+  case N.readDec (T.unpack x) of+    [(a,_)]    -> Just a+    _otherwise -> Nothing
+ src/Zenacy/HTML/Internal/DOM.hs view
@@ -0,0 +1,721 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns #-}++-- | Defines the HTML DOM types and functions.+module Zenacy.HTML.Internal.DOM+  ( DOM(..)+  , DOMNode(..)+  , DOMAttr(..)+  , DOMType(..)+  , DOMQuirks(..)+  , DOMPos(..)+  , DOMID+  , DOMMap+  , domAttrMake+  , domDefaultDocument+  , domDefaultDoctype+  , domDefaultFragment+  , domDefaultElement+  , domDefaultTemplate+  , domDefaultText+  , domDefaultComment+  , domDefaultType+  , domMakeTypeHTML+  , domMakeTypeMathML+  , domMakeTypeSVG+  , domPos+  , domNull+  , domRoot+  , domRootPos+  , domDocument+  , domQuirksSet+  , domQuirksGet+  , domNewID+  , domGetNode+  , domPutNode+  , domInsert+  , domInsertNew+  , domAppend+  , domAppendNew+  , domElementHasAttr+  , domElementFindAttr+  , domElementAttrValue+  , domAttrMerge+  , domMatch+  , domLastChild+  , domMapID+  , domFindParent+  , domSetParent+  , domMapChild+  , domRemoveChild+  , domRemoveChildren+  , domMove+  , domMoveChildren+  , domChildren+  , domHasChild+  , domNodeID+  , domNodeParent+  , domNodeIsHTML+  , domNodeIsSVG+  , domNodeIsMathML+  , domNodeIsDocument+  , domNodeIsFragment+  , domNodeIsElement+  , domNodeIsTemplate+  , domNodeIsHtmlElement+  , domNodeIsText+  , domNodeElementName+  , domNodeElementNamespace+  , domNodeType+  , domTypesHTML+  , domTypesMathML+  , domTypesSVG+  , domRender+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.Types+import Data.Foldable+  ( toList+  )+import Data.List+  ( find+  )+import Data.Maybe+  ( fromJust+  , listToMaybe+  , isJust+  , mapMaybe+  )+import Data.Monoid+  ( (<>)+  )+import Data.Word+  ( Word8+  )+import Data.Default+  ( Default(..)+  )+import Data.IntMap+  ( IntMap+  )+import qualified Data.IntMap as IntMap+  ( singleton+  , lookup+  , insert+  , keys+  )+import Data.Sequence+  ( Seq(..)+  , ViewL(..)+  , ViewR(..)+  , (<|)+  , (|>)+  , (><)+  )+import qualified Data.Sequence as Seq+  ( breakl+  , empty+  , filter+  , viewl+  , viewr+  )++-- | DOM represents an HTML document while being parsed.+data DOM = DOM+  { domNodes  :: !DOMMap+  , domNextID :: !DOMID+  } deriving (Eq, Ord, Show)++-- | Defines an ID for a node in a document.+type DOMID = Int++-- | Defines a mapping between node references and nodes.+type DOMMap = IntMap DOMNode++-- | Node is the model type for an HTML document.+data DOMNode+  = DOMDocument+    { domDocumentID          :: DOMID+    , domDocumentParent      :: DOMID+    , domDocumentName        :: BS+    , domDocumentChildren    :: Seq DOMID+    , domDocumentQuirksMode  :: DOMQuirks+    }+  | DOMDoctype+    { domDoctypeID           :: DOMID+    , domDoctypeParent       :: DOMID+    , domDoctypeName         :: BS+    , domDoctypePublicID     :: Maybe BS+    , domDoctypeSystemID     :: Maybe BS+    }+  | DOMFragment+    { domFragmentID          :: DOMID+    , domFragmentParent      :: DOMID+    , domFragmentName        :: BS+    , domFragmentChildren    :: Seq DOMID+    }+  | DOMElement+    { domElementID           :: DOMID+    , domElementParent       :: DOMID+    , domElementName         :: BS+    , domElementNamespace    :: HTMLNamespace+    , domElementAttributes   :: Seq DOMAttr+    , domElementChildren     :: Seq DOMID+    }+  | DOMTemplate+    { domTemplateID          :: DOMID+    , domTemplateParent      :: DOMID+    , domTemplateNamespace   :: HTMLNamespace+    , domTemplateAttributes  :: Seq DOMAttr+    , domTemplateContents    :: DOMID+    }+  | DOMText+    { domTextID              :: DOMID+    , domTextParent          :: DOMID+    , domTextData            :: BS+    }+  | DOMComment+    { domCommentID           :: DOMID+    , domCommentParent       :: DOMID+    , domCommentData         :: BS+    }+    deriving (Eq, Ord, Show)++-- | An HTML element attribute type.+data DOMAttr = DOMAttr+  { domAttrName      :: BS+  , domAttrVal       :: BS+  , domAttrNamespace :: HTMLAttrNamespace+  } deriving (Eq, Ord, Show)+++-- | Identifies the type of an element.+data DOMType = DOMType+  { domTypeName      :: BS+  , domTypeNamespace :: HTMLNamespace+  } deriving (Eq, Ord, Show)++-- | Indentifies the quirks mode.+data DOMQuirks+  = DOMQuirksNone+  | DOMQuirksMode+  | DOMQuirksLimited+    deriving (Eq, Ord, Show)++-- | Defines a position in the DOM.+data DOMPos = DOMPos+  { domPosParent :: DOMID+  , domPosChild  :: Maybe DOMID+  } deriving (Eq, Ord, Show)++-- | Defines a default DOM.+instance Default DOM where+  def = DOM+    { domNodes = IntMap.singleton domRoot domDefaultDocument+    , domNextID = domRoot + 1+    }++-- | Defines a default attribute.+instance Default DOMAttr where+  def = DOMAttr+    { domAttrName      = bsEmpty+    , domAttrVal       = bsEmpty+    , domAttrNamespace = def+    }++-- | Makes an attribute.+domAttrMake :: BS -> BS -> DOMAttr+domAttrMake n v = DOMAttr n v def++-- | Defines a default document.+domDefaultDocument :: DOMNode+domDefaultDocument =+  DOMDocument+  { domDocumentID         = domNull+  , domDocumentName       = bsEmpty+  , domDocumentChildren   = Seq.empty+  , domDocumentQuirksMode = DOMQuirksNone+  , domDocumentParent     = domNull+  }++-- | Defines a default document type.+domDefaultDoctype :: DOMNode+domDefaultDoctype =+  DOMDoctype+  { domDoctypeID       = domNull+  , domDoctypeName     = bsEmpty+  , domDoctypePublicID = Nothing+  , domDoctypeSystemID = Nothing+  , domDoctypeParent   = domNull+  }++-- | Defines a default document fragment.+domDefaultFragment :: DOMNode+domDefaultFragment =+  DOMFragment+  { domFragmentID       = domNull+  , domFragmentName     = bsEmpty+  , domFragmentChildren = Seq.empty+  , domFragmentParent   = domNull+  }++-- | Defines a default element.+domDefaultElement :: DOMNode+domDefaultElement =+  DOMElement+  { domElementID         = domNull+  , domElementName       = bsEmpty+  , domElementNamespace  = HTMLNamespaceHTML+  , domElementAttributes = Seq.empty+  , domElementChildren   = Seq.empty+  , domElementParent     = domNull+  }++-- | Defines a default template.+domDefaultTemplate :: DOMNode+domDefaultTemplate =+  DOMTemplate+  { domTemplateID         = domNull+  , domTemplateNamespace  = HTMLNamespaceHTML+  , domTemplateAttributes = Seq.empty+  , domTemplateContents   = domNull+  , domTemplateParent     = domNull+  }++-- | Defines a default text.+domDefaultText :: DOMNode+domDefaultText =+  DOMText+  { domTextID     = domNull+  , domTextData   = bsEmpty+  , domTextParent = domNull+  }++-- | Defines a default comment.+domDefaultComment :: DOMNode+domDefaultComment =+  DOMComment+  { domCommentID     = domNull+  , domCommentData   = bsEmpty+  , domCommentParent = domNull+  }++-- | Defines a default type.+domDefaultType :: DOMType+domDefaultType = domMakeTypeHTML bsEmpty++-- | Makes a new HTML element type.+domMakeTypeHTML :: BS -> DOMType+domMakeTypeHTML = flip DOMType HTMLNamespaceHTML++-- | Makes a new MathML element type.+domMakeTypeMathML :: BS -> DOMType+domMakeTypeMathML = flip DOMType HTMLNamespaceMathML++-- | Makes a new SVG element type.+domMakeTypeSVG :: BS -> DOMType+domMakeTypeSVG = flip DOMType HTMLNamespaceSVG++-- | Makes a new position.+domPos :: DOMID -> DOMPos+domPos x = DOMPos x Nothing++-- | The null node ID.+domNull :: DOMID+domNull = 0++-- | The root document node ID.+domRoot :: DOMID+domRoot = 1++-- | Defines an appending position in a document node.+domRootPos :: DOMPos+domRootPos = domPos domRoot++-- | Gets the document node for a DOM.+domDocument :: DOM -> DOMNode+domDocument d = fromJust $ IntMap.lookup domRoot $ domNodes d++-- | Sets the quirks mode for a document.+domQuirksSet :: DOMQuirks -> DOM -> DOM+domQuirksSet x d = domPutNode domRoot y' d+  where+    y = domDocument d+    y' = y { domDocumentQuirksMode = x }++-- | Gets the quirks mode for a document.+domQuirksGet :: DOM -> DOMQuirks+domQuirksGet = domDocumentQuirksMode . domDocument++-- | Adds a new node to a DOM.+domNewID :: DOM -> DOMNode -> (DOM, DOMID)+domNewID d n = (d', i)+  where+    i = domNextID d+    n' = domSetID n i+    d' = d { domNodes = IntMap.insert i n' $ domNodes d+           , domNextID = i + 1+           }++-- | Sets the ID for a node.+domSetID :: DOMNode -> DOMID -> DOMNode+domSetID x y =+  case x of+    DOMDocument{} -> x { domDocumentID = y }+    DOMDoctype{}  -> x { domDoctypeID = y }+    DOMFragment{} -> x { domFragmentID = y }+    DOMElement{}  -> x { domElementID = y }+    DOMTemplate{} -> x { domTemplateID = y }+    DOMText{}     -> x { domTextID = y }+    DOMComment{}  -> x { domCommentID = y }++-- | Gets a node for a node ID.+domGetNode :: DOM -> DOMID -> Maybe DOMNode+domGetNode d x = IntMap.lookup x $ domNodes d++-- | Updates a node in the DOM.+domPutNode :: DOMID -> DOMNode -> DOM -> DOM+domPutNode x n d = d { domNodes = IntMap.insert x n $ domNodes d }++-- | Inserts a node at a position.+domInsert :: DOMPos -> DOMID -> DOM -> DOM+domInsert p@(DOMPos r c) x d =+  case domGetNode d r of+    Just n@(DOMDocument { domDocumentChildren = a }) ->+      f $ n { domDocumentChildren = g a }+    Just n@(DOMElement { domElementChildren = a }) ->+      f $ n { domElementChildren = g a }+    Just n@(DOMFragment { domFragmentChildren = a }) ->+      f $ n { domFragmentChildren = g a }+    Just n@(DOMTemplate { domTemplateContents = a }) ->+      domInsert (DOMPos a c) x d+    _otherwise -> d+  where+    f a = domSetParent x r (domPutNode r a d)+    g = domInsertChild p x++-- | Inserts a node at a position.+domInsertNew :: DOMPos -> DOMNode -> DOM -> (DOM, DOMID)+domInsertNew p x d =+  (domInsert p i d', i)+  where+    (d', i) = domNewID d x++-- | Inserts a child in a list of children.+domInsertChild :: DOMPos -> DOMID -> Seq DOMID -> Seq DOMID+domInsertChild (DOMPos _ Nothing) x = (|> x)+domInsertChild (DOMPos _ (Just a)) x = seqInsertBefore (==a) x++-- | Appends a node ID to a node.+domAppend :: DOMID -> DOMID -> DOM -> DOM+domAppend x y d =+  case domGetNode d x of+    Just (DOMDocument i p n c q) ->+      f $ DOMDocument i p n (c |> y) q+    Just (DOMElement i p n s a c) ->+      f $ DOMElement i p n s a (c |> y)+    Just (DOMFragment i p n c) ->+      f $ DOMFragment i p n (c |> y)+    Just (DOMTemplate _ _ _ _ c) ->+      domAppend c y d+    _otherwise -> d+  where+    f a = domSetParent y x (domPutNode x a d)++-- | Appends a node to a node.+domAppendNew :: DOMID -> DOMNode -> DOM -> DOM+domAppendNew x y d = domAppend x i d'+  where (d', i) = domNewID d y++-- | Finds an attribute for an element.+domElementFindAttr :: DOMNode -> BS -> Maybe DOMAttr+domElementFindAttr node name = case node of+  DOMElement{..} -> f domElementAttributes+  DOMTemplate{..} -> f domTemplateAttributes+  _otherwise -> Nothing+  where+    f = seqFind (\DOMAttr{..} -> domAttrName == name)++-- | Gets the last element in a sequence if it exists.+seqLast :: Seq a -> Maybe a+seqLast (Seq.viewr -> EmptyR) = Nothing+seqLast (Seq.viewr -> _ :> a) = Just a+seqLast _ = Nothing++-- | Finds an element in a sequence.+seqFind :: (a -> Bool) -> Seq a -> Maybe a+seqFind f x = go x+  where+    go (Seq.viewl -> EmptyL) = Nothing+    go (Seq.viewl -> a :< b) = if f a then Just a else go b+    go _ = Nothing++-- | Inserts an element into a sequence before the element satisfying a predicate.+seqInsertBefore :: (a -> Bool) -> a -> Seq a -> Seq a+seqInsertBefore f x y =+  (a |> x) <> b+  where+    (a, b) = Seq.breakl f y++-- | Finds an attribute value for an element.+domElementAttrValue :: DOMNode -> BS -> Maybe BS+domElementAttrValue x n = domAttrVal <$> domElementFindAttr x n++-- | Determines if a node has a named attribute.+domElementHasAttr  :: DOMNode -> BS -> Bool+domElementHasAttr x = isJust . domElementFindAttr x++-- | Merges attributes into an existing node.+domAttrMerge :: DOMID -> Seq DOMAttr -> DOM -> DOM+domAttrMerge x y d =+  case domGetNode d x of+    Just n@(DOMElement { domElementAttributes = a }) ->+      domPutNode x (n { domElementAttributes = a <> f n y }) d+    Just n@(DOMTemplate { domTemplateAttributes = a }) ->+      domPutNode x (n { domTemplateAttributes = a <> f n y }) d+    _otherwise -> d+  where+    f n = Seq.filter (not . domElementHasAttr n . domAttrName)++-- | Detmermines if two elements match.+domMatch :: DOM -> DOMID -> DOMID -> Bool+domMatch d i j =+  case (domGetNode d i, domGetNode d j) of+    (Just (DOMElement _ _ n1 s1 a1 _), Just (DOMElement _ _ n2 s2 a2 _)) ->+      n1 == n2 && s1 == s2 && a1 == a1+    (Just (DOMTemplate _ _ s1 a1 _ ), Just (DOMTemplate _ _ s2 a2 _)) ->+      s1 == s2 && a1 == a1+    _otherwise ->+      False++-- | Returns the last child of a node if it exists.+domLastChild :: DOM -> DOMID -> Maybe DOMID+domLastChild d x =+  domGetNode d x >>= \case+    DOMDocument{..} -> seqLast domDocumentChildren+    DOMFragment{..} -> seqLast domFragmentChildren+    DOMElement{..}  -> seqLast domElementChildren+    DOMTemplate{..} -> domLastChild d domTemplateContents+    _otherwise -> Nothing++-- | Converts a list of node IDs to nodes.+domMapID :: DOM -> [DOMID] -> [DOMNode]+domMapID d = mapMaybe $ domGetNode d++-- | Finds the parent node for a node.+domFindParent :: DOM -> DOMID -> Maybe DOMID+domFindParent d x = find (domHasChild d x) $ IntMap.keys $ domNodes d++-- | Sets the parent for a node.+domSetParent :: DOMID -> DOMID -> DOM -> DOM+domSetParent x y d =+  case domGetNode d x of+    Just a -> case a of+      DOMDocument{} -> f a { domDocumentParent = y }+      DOMDoctype{}  -> f a { domDoctypeParent = y }+      DOMFragment{} -> f a { domFragmentParent = y }+      DOMElement{}  -> f a { domElementParent = y }+      DOMTemplate{} -> f a { domTemplateParent = y }+      DOMText{}     -> f a { domTextParent = y }+      DOMComment{}  -> f a { domCommentParent = y }+    Nothing -> d+  where+    f z = domPutNode x z d++-- | Maps a function over children of a node.+domMapChild :: DOMID -> (Seq DOMID -> Seq DOMID)-> DOM -> DOM+domMapChild x f d =+  case domGetNode d x of+    Just a -> case a of+      DOMDocument { domDocumentChildren = c } ->+        domPutNode x a { domDocumentChildren = f c } d+      DOMFragment { domFragmentChildren = c } ->+        domPutNode x a { domFragmentChildren = f c } d+      DOMElement { domElementChildren = c } ->+        domPutNode x a { domElementChildren = f c } d+      DOMTemplate { domTemplateContents = c } ->+        domMapChild c f d+      _otherwise -> d+    Nothing -> d++-- | Removes a child from a node.+domRemoveChild :: DOMID -> DOMID -> DOM -> DOM+domRemoveChild parent child = domMapChild parent $ Seq.filter (/=child)++-- | Removes all the children from a node.+domRemoveChildren :: DOMID -> DOM -> DOM+domRemoveChildren x = domMapChild x $ const Seq.empty++-- | Moves a node to another parent.+domMove :: DOMID -> DOMID -> DOM -> DOM+domMove x newParent d =+  case domGetNode d x of+    Just a ->+      let d' = domRemoveChild (domNodeParent a) x d+      in domAppend newParent x d'+    Nothing -> d++-- | Moves the children of a node to another node.+domMoveChildren :: DOMID -> DOMID -> DOM -> DOM+domMoveChildren x y d =+  foldl (\d' c -> domAppend y c d') (domRemoveChildren x d) $ domChildren d x++-- | Gets the children of a node.+domChildren :: DOM -> DOMID -> Seq DOMID+domChildren d x =+  case domGetNode d x of+    Just (DOMDocument{..}) -> domDocumentChildren+    Just (DOMFragment{..}) -> domFragmentChildren+    Just (DOMElement{..})  -> domElementChildren+    Just (DOMTemplate{..}) -> domChildren d domTemplateContents+    _otherwise             -> Seq.empty++-- | Determines if a node has a specific child.+domHasChild :: DOM -> DOMID -> DOMID -> Bool+domHasChild d x z = z `elem` domChildren d x++-- | Gets the id for a node.+domNodeID :: DOMNode -> DOMID+domNodeID = \case+  DOMDocument{..} -> domDocumentID+  DOMDoctype{..}  -> domDoctypeID+  DOMFragment{..} -> domFragmentID+  DOMElement{..}  -> domElementID+  DOMTemplate{..} -> domTemplateID+  DOMText{..}     -> domTextID+  DOMComment{..}  -> domCommentID++-- | Gets the parent for a node.+domNodeParent :: DOMNode -> DOMID+domNodeParent = \case+  DOMDocument{..} -> domDocumentParent+  DOMDoctype{..}  -> domDoctypeParent+  DOMFragment{..} -> domFragmentParent+  DOMElement{..}  -> domElementParent+  DOMTemplate{..} -> domTemplateParent+  DOMText{..}     -> domTextParent+  DOMComment{..}  -> domCommentParent++-- | Detmermines if a node is in the HTML namespace.+domNodeIsHTML :: DOMNode -> Bool+domNodeIsHTML = \case+  DOMElement{..}  -> domElementNamespace == HTMLNamespaceHTML+  DOMTemplate{..} -> domTemplateNamespace == HTMLNamespaceHTML+  _otherwise      -> False++-- | Detmermines if a node is in the SVG namespace.+domNodeIsSVG :: DOMNode -> Bool+domNodeIsSVG = \case+  DOMElement{..}  -> domElementNamespace == HTMLNamespaceSVG+  DOMTemplate{..} -> domTemplateNamespace == HTMLNamespaceSVG+  _otherwise      -> False++-- | Detmermines if a node is in the MathML namespace.+domNodeIsMathML :: DOMNode -> Bool+domNodeIsMathML = \case+  DOMElement{..}  -> domElementNamespace == HTMLNamespaceMathML+  DOMTemplate{..} -> domTemplateNamespace == HTMLNamespaceMathML+  _otherwise      -> False++-- | Detmermines if a node is a document node.+domNodeIsDocument :: DOMNode -> Bool+domNodeIsDocument DOMDocument{} = True+domNodeIsDocument _ = False++-- | Detmermines if a node is a document fragment node.+domNodeIsFragment :: DOMNode -> Bool+domNodeIsFragment DOMFragment{} = True+domNodeIsFragment _ = False++-- | Detmermines if a node is an element node.+domNodeIsElement :: DOMNode -> Bool+domNodeIsElement DOMElement{} = True+domNodeIsElement _ = False++-- | Detmermines if a node is a template node.+domNodeIsTemplate :: DOMNode -> Bool+domNodeIsTemplate DOMTemplate{} = True+domNodeIsTemplate _ = False++-- | Detmermines if a node is an HTML element node.+domNodeIsHtmlElement :: DOMNode -> Bool+domNodeIsHtmlElement x = domNodeIsElement x && domNodeIsHTML x++-- | Detmermines if a node is a text node.+domNodeIsText :: DOMNode -> Bool+domNodeIsText DOMText{} = True+domNodeIsText _ = False++-- | Gets the name for an element node.+domNodeElementName :: DOMNode -> BS+domNodeElementName DOMElement{..} = domElementName+domNodeElementName DOMTemplate{} = "template"+domNodeElementName _ = ""++-- | Gets the name for an element node.+domNodeElementNamespace :: DOMNode -> HTMLNamespace+domNodeElementNamespace DOMElement{..} = domElementNamespace+domNodeElementNamespace DOMTemplate{..} = domTemplateNamespace+domNodeElementNamespace _ = HTMLNamespaceHTML++-- | Gets the type for an element node.+domNodeType :: DOMNode -> DOMType+domNodeType x = DOMType (domNodeElementName x) (domNodeElementNamespace x)++-- | Gets a list of HTML types for element names.+domTypesHTML :: [BS] -> [DOMType]+domTypesHTML = map domMakeTypeHTML++-- | Gets a list of MathML types for element names.+domTypesMathML :: [BS] -> [DOMType]+domTypesMathML = map domMakeTypeMathML++-- | Gets a list of SVG types for element names.+domTypesSVG :: [BS] -> [DOMType]+domTypesSVG = map domMakeTypeSVG++-- | Renders the DOM.+domRender :: DOM -> BS+domRender d = domRenderIndent d 0 domRoot++-- | Renders the DOM with indentaion.+domRenderIndent :: DOM -> Int -> DOMID -> BS+domRenderIndent d x y =+  case fromJust (domGetNode d y) of+    DOMDocument{..} ->+      bsConcat $ map (domRenderIndent d x) $ toList domDocumentChildren+    DOMDoctype{} ->+      bsEmpty+    DOMFragment{..} ->+      bsConcat $ map (domRenderIndent d x) $ toList domFragmentChildren+    DOMElement{..} ->+      bsConcat+        [ indent+        , domElementName+        , "\n"+        , bsConcat $ map (domRenderIndent d $ x + 1) $ toList domElementChildren+        ]+    DOMTemplate{..} ->+      bsConcat+        [ indent+        , "template"+        , "\n"+        , domRenderIndent d (x + 1) domTemplateContents+        ]+    DOMText{..} ->+      bsConcat+        [ indent+        , domTextData+        , "\n"+        ]+    DOMComment{} ->+      bsEmpty+  where+    indent = bsPack $ take x $ repeat 0x20
+ src/Zenacy/HTML/Internal/Entity.hs view
@@ -0,0 +1,2302 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Matches and extracts entities from byte strings.+module Zenacy.HTML.Internal.Entity+  ( entityMatch+  , entityTrie+  , entityData+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Char+import Data.Char+  ( chr+  , ord+  )+import qualified Data.Text as Text+  ( pack+  )+import qualified Data.Text.Encoding as Text+  ( encodeUtf8+  )+import Zenacy.HTML.Internal.Trie+  ( Trie+  )+import qualified Zenacy.HTML.Internal.Trie as Trie+  ( fromList+  , match+  )+import Data.Word+  ( Word8+  )++-- | Searches for an entity match.+-- Returns a tuple with the prefix, its value, and the remaining string.+entityMatch :: BS -> Maybe (BS, BS, BS)+entityMatch = Trie.match entityTrie++-- | A trie of the entity data with surrogates converted.+entityTrie :: Trie BS+entityTrie =+  Trie.fromList $ map (f . g) entityData+  where+    f (x, y) = (x, Text.encodeUtf8 $ Text.pack y)+    g (x, y) = case y of+      [a, b] ->+        let a' = ord a+            b' = ord b+        in if isUTF16Surrogate a' b'+              then (x, [convUTF16Surrogate a' b'])+              else (x, [a,b])+      _otherwise ->+        (x, y)++-- | Converts a surrogate pair to a unicode character.+convUTF16Surrogate :: Int -> Int -> Char+convUTF16Surrogate high low =+  chr $ (high - 0xD800) * 0x400 + (low - 0xDC00) + 0x10000++-- | Determines is a pair of codes represent a surrogate.+isUTF16Surrogate :: Int -> Int -> Bool+isUTF16Surrogate high low =+  high >= 0xD800 && high <= 0xDBFF && low >= 0xDC00 && low <= 0xDFFF++-- | The raw entity data.+entityData :: [(BS,String)]+entityData =+  [("Aacute","\x00C1")+  ,("aacute","\x00E1")+  ,("Aacute;","\x00C1")+  ,("aacute;","\x00E1")+  ,("Abreve;","\x0102")+  ,("abreve;","\x0103")+  ,("ac;","\x223E")+  ,("acd;","\x223F")+  ,("acE;","\x223E\x0333")+  ,("Acirc","\x00C2")+  ,("acirc","\x00E2")+  ,("Acirc;","\x00C2")+  ,("acirc;","\x00E2")+  ,("acute","\x00B4")+  ,("acute;","\x00B4")+  ,("Acy;","\x0410")+  ,("acy;","\x0430")+  ,("AElig","\x00C6")+  ,("aelig","\x00E6")+  ,("AElig;","\x00C6")+  ,("aelig;","\x00E6")+  ,("af;","\x2061")+  ,("Afr;","\xD835\xDD04")+  ,("afr;","\xD835\xDD1E")+  ,("Agrave","\x00C0")+  ,("agrave","\x00E0")+  ,("Agrave;","\x00C0")+  ,("agrave;","\x00E0")+  ,("alefsym;","\x2135")+  ,("aleph;","\x2135")+  ,("Alpha;","\x0391")+  ,("alpha;","\x03B1")+  ,("Amacr;","\x0100")+  ,("amacr;","\x0101")+  ,("amalg;","\x2A3F")+  ,("AMP","\x0026")+  ,("amp","\x0026")+  ,("AMP;","\x0026")+  ,("amp;","\x0026")+  ,("and;","\x2227")+  ,("And;","\x2A53")+  ,("andand;","\x2A55")+  ,("andd;","\x2A5C")+  ,("andslope;","\x2A58")+  ,("andv;","\x2A5A")+  ,("ang;","\x2220")+  ,("ange;","\x29A4")+  ,("angle;","\x2220")+  ,("angmsd;","\x2221")+  ,("angmsdaa;","\x29A8")+  ,("angmsdab;","\x29A9")+  ,("angmsdac;","\x29AA")+  ,("angmsdad;","\x29AB")+  ,("angmsdae;","\x29AC")+  ,("angmsdaf;","\x29AD")+  ,("angmsdag;","\x29AE")+  ,("angmsdah;","\x29AF")+  ,("angrt;","\x221F")+  ,("angrtvb;","\x22BE")+  ,("angrtvbd;","\x299D")+  ,("angsph;","\x2222")+  ,("angst;","\x00C5")+  ,("angzarr;","\x237C")+  ,("Aogon;","\x0104")+  ,("aogon;","\x0105")+  ,("Aopf;","\xD835\xDD38")+  ,("aopf;","\xD835\xDD52")+  ,("ap;","\x2248")+  ,("apacir;","\x2A6F")+  ,("ape;","\x224A")+  ,("apE;","\x2A70")+  ,("apid;","\x224B")+  ,("apos;","\x0027")+  ,("ApplyFunction;","\x2061")+  ,("approx;","\x2248")+  ,("approxeq;","\x224A")+  ,("Aring","\x00C5")+  ,("aring","\x00E5")+  ,("Aring;","\x00C5")+  ,("aring;","\x00E5")+  ,("Ascr;","\xD835\xDC9C")+  ,("ascr;","\xD835\xDCB6")+  ,("Assign;","\x2254")+  ,("ast;","\x002A")+  ,("asymp;","\x2248")+  ,("asympeq;","\x224D")+  ,("Atilde","\x00C3")+  ,("atilde","\x00E3")+  ,("Atilde;","\x00C3")+  ,("atilde;","\x00E3")+  ,("Auml","\x00C4")+  ,("auml","\x00E4")+  ,("Auml;","\x00C4")+  ,("auml;","\x00E4")+  ,("awconint;","\x2233")+  ,("awint;","\x2A11")+  ,("backcong;","\x224C")+  ,("backepsilon;","\x03F6")+  ,("backprime;","\x2035")+  ,("backsim;","\x223D")+  ,("backsimeq;","\x22CD")+  ,("Backslash;","\x2216")+  ,("Barv;","\x2AE7")+  ,("barvee;","\x22BD")+  ,("barwed;","\x2305")+  ,("Barwed;","\x2306")+  ,("barwedge;","\x2305")+  ,("bbrk;","\x23B5")+  ,("bbrktbrk;","\x23B6")+  ,("bcong;","\x224C")+  ,("Bcy;","\x0411")+  ,("bcy;","\x0431")+  ,("bdquo;","\x201E")+  ,("becaus;","\x2235")+  ,("Because;","\x2235")+  ,("because;","\x2235")+  ,("bemptyv;","\x29B0")+  ,("bepsi;","\x03F6")+  ,("bernou;","\x212C")+  ,("Bernoullis;","\x212C")+  ,("Beta;","\x0392")+  ,("beta;","\x03B2")+  ,("beth;","\x2136")+  ,("between;","\x226C")+  ,("Bfr;","\xD835\xDD05")+  ,("bfr;","\xD835\xDD1F")+  ,("bigcap;","\x22C2")+  ,("bigcirc;","\x25EF")+  ,("bigcup;","\x22C3")+  ,("bigodot;","\x2A00")+  ,("bigoplus;","\x2A01")+  ,("bigotimes;","\x2A02")+  ,("bigsqcup;","\x2A06")+  ,("bigstar;","\x2605")+  ,("bigtriangledown;","\x25BD")+  ,("bigtriangleup;","\x25B3")+  ,("biguplus;","\x2A04")+  ,("bigvee;","\x22C1")+  ,("bigwedge;","\x22C0")+  ,("bkarow;","\x290D")+  ,("blacklozenge;","\x29EB")+  ,("blacksquare;","\x25AA")+  ,("blacktriangle;","\x25B4")+  ,("blacktriangledown;","\x25BE")+  ,("blacktriangleleft;","\x25C2")+  ,("blacktriangleright;","\x25B8")+  ,("blank;","\x2423")+  ,("blk12;","\x2592")+  ,("blk14;","\x2591")+  ,("blk34;","\x2593")+  ,("block;","\x2588")+  ,("bne;","\x003D\x20E5")+  ,("bnequiv;","\x2261\x20E5")+  ,("bnot;","\x2310")+  ,("bNot;","\x2AED")+  ,("Bopf;","\xD835\xDD39")+  ,("bopf;","\xD835\xDD53")+  ,("bot;","\x22A5")+  ,("bottom;","\x22A5")+  ,("bowtie;","\x22C8")+  ,("boxbox;","\x29C9")+  ,("boxdl;","\x2510")+  ,("boxdL;","\x2555")+  ,("boxDl;","\x2556")+  ,("boxDL;","\x2557")+  ,("boxdr;","\x250C")+  ,("boxdR;","\x2552")+  ,("boxDr;","\x2553")+  ,("boxDR;","\x2554")+  ,("boxh;","\x2500")+  ,("boxH;","\x2550")+  ,("boxhd;","\x252C")+  ,("boxHd;","\x2564")+  ,("boxhD;","\x2565")+  ,("boxHD;","\x2566")+  ,("boxhu;","\x2534")+  ,("boxHu;","\x2567")+  ,("boxhU;","\x2568")+  ,("boxHU;","\x2569")+  ,("boxminus;","\x229F")+  ,("boxplus;","\x229E")+  ,("boxtimes;","\x22A0")+  ,("boxul;","\x2518")+  ,("boxuL;","\x255B")+  ,("boxUl;","\x255C")+  ,("boxUL;","\x255D")+  ,("boxur;","\x2514")+  ,("boxuR;","\x2558")+  ,("boxUr;","\x2559")+  ,("boxUR;","\x255A")+  ,("boxv;","\x2502")+  ,("boxV;","\x2551")+  ,("boxvh;","\x253C")+  ,("boxvH;","\x256A")+  ,("boxVh;","\x256B")+  ,("boxVH;","\x256C")+  ,("boxvl;","\x2524")+  ,("boxvL;","\x2561")+  ,("boxVl;","\x2562")+  ,("boxVL;","\x2563")+  ,("boxvr;","\x251C")+  ,("boxvR;","\x255E")+  ,("boxVr;","\x255F")+  ,("boxVR;","\x2560")+  ,("bprime;","\x2035")+  ,("Breve;","\x02D8")+  ,("breve;","\x02D8")+  ,("brvbar","\x00A6")+  ,("brvbar;","\x00A6")+  ,("Bscr;","\x212C")+  ,("bscr;","\xD835\xDCB7")+  ,("bsemi;","\x204F")+  ,("bsim;","\x223D")+  ,("bsime;","\x22CD")+  ,("bsol;","\x005C")+  ,("bsolb;","\x29C5")+  ,("bsolhsub;","\x27C8")+  ,("bull;","\x2022")+  ,("bullet;","\x2022")+  ,("bump;","\x224E")+  ,("bumpe;","\x224F")+  ,("bumpE;","\x2AAE")+  ,("Bumpeq;","\x224E")+  ,("bumpeq;","\x224F")+  ,("Cacute;","\x0106")+  ,("cacute;","\x0107")+  ,("cap;","\x2229")+  ,("Cap;","\x22D2")+  ,("capand;","\x2A44")+  ,("capbrcup;","\x2A49")+  ,("capcap;","\x2A4B")+  ,("capcup;","\x2A47")+  ,("capdot;","\x2A40")+  ,("CapitalDifferentialD;","\x2145")+  ,("caps;","\x2229\xFE00")+  ,("caret;","\x2041")+  ,("caron;","\x02C7")+  ,("Cayleys;","\x212D")+  ,("ccaps;","\x2A4D")+  ,("Ccaron;","\x010C")+  ,("ccaron;","\x010D")+  ,("Ccedil","\x00C7")+  ,("ccedil","\x00E7")+  ,("Ccedil;","\x00C7")+  ,("ccedil;","\x00E7")+  ,("Ccirc;","\x0108")+  ,("ccirc;","\x0109")+  ,("Cconint;","\x2230")+  ,("ccups;","\x2A4C")+  ,("ccupssm;","\x2A50")+  ,("Cdot;","\x010A")+  ,("cdot;","\x010B")+  ,("cedil","\x00B8")+  ,("cedil;","\x00B8")+  ,("Cedilla;","\x00B8")+  ,("cemptyv;","\x29B2")+  ,("cent","\x00A2")+  ,("cent;","\x00A2")+  ,("CenterDot;","\x00B7")+  ,("centerdot;","\x00B7")+  ,("Cfr;","\x212D")+  ,("cfr;","\xD835\xDD20")+  ,("CHcy;","\x0427")+  ,("chcy;","\x0447")+  ,("check;","\x2713")+  ,("checkmark;","\x2713")+  ,("Chi;","\x03A7")+  ,("chi;","\x03C7")+  ,("cir;","\x25CB")+  ,("circ;","\x02C6")+  ,("circeq;","\x2257")+  ,("circlearrowleft;","\x21BA")+  ,("circlearrowright;","\x21BB")+  ,("circledast;","\x229B")+  ,("circledcirc;","\x229A")+  ,("circleddash;","\x229D")+  ,("CircleDot;","\x2299")+  ,("circledR;","\x00AE")+  ,("circledS;","\x24C8")+  ,("CircleMinus;","\x2296")+  ,("CirclePlus;","\x2295")+  ,("CircleTimes;","\x2297")+  ,("cire;","\x2257")+  ,("cirE;","\x29C3")+  ,("cirfnint;","\x2A10")+  ,("cirmid;","\x2AEF")+  ,("cirscir;","\x29C2")+  ,("ClockwiseContourIntegral;","\x2232")+  ,("CloseCurlyDoubleQuote;","\x201D")+  ,("CloseCurlyQuote;","\x2019")+  ,("clubs;","\x2663")+  ,("clubsuit;","\x2663")+  ,("colon;","\x003A")+  ,("Colon;","\x2237")+  ,("colone;","\x2254")+  ,("Colone;","\x2A74")+  ,("coloneq;","\x2254")+  ,("comma;","\x002C")+  ,("commat;","\x0040")+  ,("comp;","\x2201")+  ,("compfn;","\x2218")+  ,("complement;","\x2201")+  ,("complexes;","\x2102")+  ,("cong;","\x2245")+  ,("congdot;","\x2A6D")+  ,("Congruent;","\x2261")+  ,("conint;","\x222E")+  ,("Conint;","\x222F")+  ,("ContourIntegral;","\x222E")+  ,("Copf;","\x2102")+  ,("copf;","\xD835\xDD54")+  ,("coprod;","\x2210")+  ,("Coproduct;","\x2210")+  ,("COPY","\x00A9")+  ,("copy","\x00A9")+  ,("COPY;","\x00A9")+  ,("copy;","\x00A9")+  ,("copysr;","\x2117")+  ,("CounterClockwiseContourIntegral;","\x2233")+  ,("crarr;","\x21B5")+  ,("cross;","\x2717")+  ,("Cross;","\x2A2F")+  ,("Cscr;","\xD835\xDC9E")+  ,("cscr;","\xD835\xDCB8")+  ,("csub;","\x2ACF")+  ,("csube;","\x2AD1")+  ,("csup;","\x2AD0")+  ,("csupe;","\x2AD2")+  ,("ctdot;","\x22EF")+  ,("cudarrl;","\x2938")+  ,("cudarrr;","\x2935")+  ,("cuepr;","\x22DE")+  ,("cuesc;","\x22DF")+  ,("cularr;","\x21B6")+  ,("cularrp;","\x293D")+  ,("cup;","\x222A")+  ,("Cup;","\x22D3")+  ,("cupbrcap;","\x2A48")+  ,("CupCap;","\x224D")+  ,("cupcap;","\x2A46")+  ,("cupcup;","\x2A4A")+  ,("cupdot;","\x228D")+  ,("cupor;","\x2A45")+  ,("cups;","\x222A\xFE00")+  ,("curarr;","\x21B7")+  ,("curarrm;","\x293C")+  ,("curlyeqprec;","\x22DE")+  ,("curlyeqsucc;","\x22DF")+  ,("curlyvee;","\x22CE")+  ,("curlywedge;","\x22CF")+  ,("curren","\x00A4")+  ,("curren;","\x00A4")+  ,("curvearrowleft;","\x21B6")+  ,("curvearrowright;","\x21B7")+  ,("cuvee;","\x22CE")+  ,("cuwed;","\x22CF")+  ,("cwconint;","\x2232")+  ,("cwint;","\x2231")+  ,("cylcty;","\x232D")+  ,("dagger;","\x2020")+  ,("Dagger;","\x2021")+  ,("daleth;","\x2138")+  ,("darr;","\x2193")+  ,("Darr;","\x21A1")+  ,("dArr;","\x21D3")+  ,("dash;","\x2010")+  ,("dashv;","\x22A3")+  ,("Dashv;","\x2AE4")+  ,("dbkarow;","\x290F")+  ,("dblac;","\x02DD")+  ,("Dcaron;","\x010E")+  ,("dcaron;","\x010F")+  ,("Dcy;","\x0414")+  ,("dcy;","\x0434")+  ,("DD;","\x2145")+  ,("dd;","\x2146")+  ,("ddagger;","\x2021")+  ,("ddarr;","\x21CA")+  ,("DDotrahd;","\x2911")+  ,("ddotseq;","\x2A77")+  ,("deg","\x00B0")+  ,("deg;","\x00B0")+  ,("Del;","\x2207")+  ,("Delta;","\x0394")+  ,("delta;","\x03B4")+  ,("demptyv;","\x29B1")+  ,("dfisht;","\x297F")+  ,("Dfr;","\xD835\xDD07")+  ,("dfr;","\xD835\xDD21")+  ,("dHar;","\x2965")+  ,("dharl;","\x21C3")+  ,("dharr;","\x21C2")+  ,("DiacriticalAcute;","\x00B4")+  ,("DiacriticalDot;","\x02D9")+  ,("DiacriticalDoubleAcute;","\x02DD")+  ,("DiacriticalGrave;","\x0060")+  ,("DiacriticalTilde;","\x02DC")+  ,("diam;","\x22C4")+  ,("Diamond;","\x22C4")+  ,("diamond;","\x22C4")+  ,("diamondsuit;","\x2666")+  ,("diams;","\x2666")+  ,("die;","\x00A8")+  ,("DifferentialD;","\x2146")+  ,("digamma;","\x03DD")+  ,("disin;","\x22F2")+  ,("div;","\x00F7")+  ,("divide","\x00F7")+  ,("divide;","\x00F7")+  ,("divideontimes;","\x22C7")+  ,("divonx;","\x22C7")+  ,("DJcy;","\x0402")+  ,("djcy;","\x0452")+  ,("dlcorn;","\x231E")+  ,("dlcrop;","\x230D")+  ,("dollar;","\x0024")+  ,("Dopf;","\xD835\xDD3B")+  ,("dopf;","\xD835\xDD55")+  ,("Dot;","\x00A8")+  ,("dot;","\x02D9")+  ,("DotDot;","\x20DC")+  ,("doteq;","\x2250")+  ,("doteqdot;","\x2251")+  ,("DotEqual;","\x2250")+  ,("dotminus;","\x2238")+  ,("dotplus;","\x2214")+  ,("dotsquare;","\x22A1")+  ,("doublebarwedge;","\x2306")+  ,("DoubleContourIntegral;","\x222F")+  ,("DoubleDot;","\x00A8")+  ,("DoubleDownArrow;","\x21D3")+  ,("DoubleLeftArrow;","\x21D0")+  ,("DoubleLeftRightArrow;","\x21D4")+  ,("DoubleLeftTee;","\x2AE4")+  ,("DoubleLongLeftArrow;","\x27F8")+  ,("DoubleLongLeftRightArrow;","\x27FA")+  ,("DoubleLongRightArrow;","\x27F9")+  ,("DoubleRightArrow;","\x21D2")+  ,("DoubleRightTee;","\x22A8")+  ,("DoubleUpArrow;","\x21D1")+  ,("DoubleUpDownArrow;","\x21D5")+  ,("DoubleVerticalBar;","\x2225")+  ,("DownArrow;","\x2193")+  ,("downarrow;","\x2193")+  ,("Downarrow;","\x21D3")+  ,("DownArrowBar;","\x2913")+  ,("DownArrowUpArrow;","\x21F5")+  ,("DownBreve;","\x0311")+  ,("downdownarrows;","\x21CA")+  ,("downharpoonleft;","\x21C3")+  ,("downharpoonright;","\x21C2")+  ,("DownLeftRightVector;","\x2950")+  ,("DownLeftTeeVector;","\x295E")+  ,("DownLeftVector;","\x21BD")+  ,("DownLeftVectorBar;","\x2956")+  ,("DownRightTeeVector;","\x295F")+  ,("DownRightVector;","\x21C1")+  ,("DownRightVectorBar;","\x2957")+  ,("DownTee;","\x22A4")+  ,("DownTeeArrow;","\x21A7")+  ,("drbkarow;","\x2910")+  ,("drcorn;","\x231F")+  ,("drcrop;","\x230C")+  ,("Dscr;","\xD835\xDC9F")+  ,("dscr;","\xD835\xDCB9")+  ,("DScy;","\x0405")+  ,("dscy;","\x0455")+  ,("dsol;","\x29F6")+  ,("Dstrok;","\x0110")+  ,("dstrok;","\x0111")+  ,("dtdot;","\x22F1")+  ,("dtri;","\x25BF")+  ,("dtrif;","\x25BE")+  ,("duarr;","\x21F5")+  ,("duhar;","\x296F")+  ,("dwangle;","\x29A6")+  ,("DZcy;","\x040F")+  ,("dzcy;","\x045F")+  ,("dzigrarr;","\x27FF")+  ,("Eacute","\x00C9")+  ,("eacute","\x00E9")+  ,("Eacute;","\x00C9")+  ,("eacute;","\x00E9")+  ,("easter;","\x2A6E")+  ,("Ecaron;","\x011A")+  ,("ecaron;","\x011B")+  ,("ecir;","\x2256")+  ,("Ecirc","\x00CA")+  ,("ecirc","\x00EA")+  ,("Ecirc;","\x00CA")+  ,("ecirc;","\x00EA")+  ,("ecolon;","\x2255")+  ,("Ecy;","\x042D")+  ,("ecy;","\x044D")+  ,("eDDot;","\x2A77")+  ,("Edot;","\x0116")+  ,("edot;","\x0117")+  ,("eDot;","\x2251")+  ,("ee;","\x2147")+  ,("efDot;","\x2252")+  ,("Efr;","\xD835\xDD08")+  ,("efr;","\xD835\xDD22")+  ,("eg;","\x2A9A")+  ,("Egrave","\x00C8")+  ,("egrave","\x00E8")+  ,("Egrave;","\x00C8")+  ,("egrave;","\x00E8")+  ,("egs;","\x2A96")+  ,("egsdot;","\x2A98")+  ,("el;","\x2A99")+  ,("Element;","\x2208")+  ,("elinters;","\x23E7")+  ,("ell;","\x2113")+  ,("els;","\x2A95")+  ,("elsdot;","\x2A97")+  ,("Emacr;","\x0112")+  ,("emacr;","\x0113")+  ,("empty;","\x2205")+  ,("emptyset;","\x2205")+  ,("EmptySmallSquare;","\x25FB")+  ,("emptyv;","\x2205")+  ,("EmptyVerySmallSquare;","\x25AB")+  ,("emsp13;","\x2004")+  ,("emsp14;","\x2005")+  ,("emsp;","\x2003")+  ,("ENG;","\x014A")+  ,("eng;","\x014B")+  ,("ensp;","\x2002")+  ,("Eogon;","\x0118")+  ,("eogon;","\x0119")+  ,("Eopf;","\xD835\xDD3C")+  ,("eopf;","\xD835\xDD56")+  ,("epar;","\x22D5")+  ,("eparsl;","\x29E3")+  ,("eplus;","\x2A71")+  ,("epsi;","\x03B5")+  ,("Epsilon;","\x0395")+  ,("epsilon;","\x03B5")+  ,("epsiv;","\x03F5")+  ,("eqcirc;","\x2256")+  ,("eqcolon;","\x2255")+  ,("eqsim;","\x2242")+  ,("eqslantgtr;","\x2A96")+  ,("eqslantless;","\x2A95")+  ,("Equal;","\x2A75")+  ,("equals;","\x003D")+  ,("EqualTilde;","\x2242")+  ,("equest;","\x225F")+  ,("Equilibrium;","\x21CC")+  ,("equiv;","\x2261")+  ,("equivDD;","\x2A78")+  ,("eqvparsl;","\x29E5")+  ,("erarr;","\x2971")+  ,("erDot;","\x2253")+  ,("escr;","\x212F")+  ,("Escr;","\x2130")+  ,("esdot;","\x2250")+  ,("esim;","\x2242")+  ,("Esim;","\x2A73")+  ,("Eta;","\x0397")+  ,("eta;","\x03B7")+  ,("ETH","\x00D0")+  ,("eth","\x00F0")+  ,("ETH;","\x00D0")+  ,("eth;","\x00F0")+  ,("Euml","\x00CB")+  ,("euml","\x00EB")+  ,("Euml;","\x00CB")+  ,("euml;","\x00EB")+  ,("euro;","\x20AC")+  ,("excl;","\x0021")+  ,("exist;","\x2203")+  ,("Exists;","\x2203")+  ,("expectation;","\x2130")+  ,("ExponentialE;","\x2147")+  ,("exponentiale;","\x2147")+  ,("fallingdotseq;","\x2252")+  ,("Fcy;","\x0424")+  ,("fcy;","\x0444")+  ,("female;","\x2640")+  ,("ffilig;","\xFB03")+  ,("fflig;","\xFB00")+  ,("ffllig;","\xFB04")+  ,("Ffr;","\xD835\xDD09")+  ,("ffr;","\xD835\xDD23")+  ,("filig;","\xFB01")+  ,("FilledSmallSquare;","\x25FC")+  ,("FilledVerySmallSquare;","\x25AA")+  ,("fjlig;","\x0066\x006A")+  ,("flat;","\x266D")+  ,("fllig;","\xFB02")+  ,("fltns;","\x25B1")+  ,("fnof;","\x0192")+  ,("Fopf;","\xD835\xDD3D")+  ,("fopf;","\xD835\xDD57")+  ,("ForAll;","\x2200")+  ,("forall;","\x2200")+  ,("fork;","\x22D4")+  ,("forkv;","\x2AD9")+  ,("Fouriertrf;","\x2131")+  ,("fpartint;","\x2A0D")+  ,("frac12","\x00BD")+  ,("frac12;","\x00BD")+  ,("frac13;","\x2153")+  ,("frac14","\x00BC")+  ,("frac14;","\x00BC")+  ,("frac15;","\x2155")+  ,("frac16;","\x2159")+  ,("frac18;","\x215B")+  ,("frac23;","\x2154")+  ,("frac25;","\x2156")+  ,("frac34","\x00BE")+  ,("frac34;","\x00BE")+  ,("frac35;","\x2157")+  ,("frac38;","\x215C")+  ,("frac45;","\x2158")+  ,("frac56;","\x215A")+  ,("frac58;","\x215D")+  ,("frac78;","\x215E")+  ,("frasl;","\x2044")+  ,("frown;","\x2322")+  ,("Fscr;","\x2131")+  ,("fscr;","\xD835\xDCBB")+  ,("gacute;","\x01F5")+  ,("Gamma;","\x0393")+  ,("gamma;","\x03B3")+  ,("Gammad;","\x03DC")+  ,("gammad;","\x03DD")+  ,("gap;","\x2A86")+  ,("Gbreve;","\x011E")+  ,("gbreve;","\x011F")+  ,("Gcedil;","\x0122")+  ,("Gcirc;","\x011C")+  ,("gcirc;","\x011D")+  ,("Gcy;","\x0413")+  ,("gcy;","\x0433")+  ,("Gdot;","\x0120")+  ,("gdot;","\x0121")+  ,("ge;","\x2265")+  ,("gE;","\x2267")+  ,("gel;","\x22DB")+  ,("gEl;","\x2A8C")+  ,("geq;","\x2265")+  ,("geqq;","\x2267")+  ,("geqslant;","\x2A7E")+  ,("ges;","\x2A7E")+  ,("gescc;","\x2AA9")+  ,("gesdot;","\x2A80")+  ,("gesdoto;","\x2A82")+  ,("gesdotol;","\x2A84")+  ,("gesl;","\x22DB\xFE00")+  ,("gesles;","\x2A94")+  ,("Gfr;","\xD835\xDD0A")+  ,("gfr;","\xD835\xDD24")+  ,("gg;","\x226B")+  ,("Gg;","\x22D9")+  ,("ggg;","\x22D9")+  ,("gimel;","\x2137")+  ,("GJcy;","\x0403")+  ,("gjcy;","\x0453")+  ,("gl;","\x2277")+  ,("gla;","\x2AA5")+  ,("glE;","\x2A92")+  ,("glj;","\x2AA4")+  ,("gnap;","\x2A8A")+  ,("gnapprox;","\x2A8A")+  ,("gnE;","\x2269")+  ,("gne;","\x2A88")+  ,("gneq;","\x2A88")+  ,("gneqq;","\x2269")+  ,("gnsim;","\x22E7")+  ,("Gopf;","\xD835\xDD3E")+  ,("gopf;","\xD835\xDD58")+  ,("grave;","\x0060")+  ,("GreaterEqual;","\x2265")+  ,("GreaterEqualLess;","\x22DB")+  ,("GreaterFullEqual;","\x2267")+  ,("GreaterGreater;","\x2AA2")+  ,("GreaterLess;","\x2277")+  ,("GreaterSlantEqual;","\x2A7E")+  ,("GreaterTilde;","\x2273")+  ,("gscr;","\x210A")+  ,("Gscr;","\xD835\xDCA2")+  ,("gsim;","\x2273")+  ,("gsime;","\x2A8E")+  ,("gsiml;","\x2A90")+  ,("GT","\x003E")+  ,("gt","\x003E")+  ,("GT;","\x003E")+  ,("gt;","\x003E")+  ,("Gt;","\x226B")+  ,("gtcc;","\x2AA7")+  ,("gtcir;","\x2A7A")+  ,("gtdot;","\x22D7")+  ,("gtlPar;","\x2995")+  ,("gtquest;","\x2A7C")+  ,("gtrapprox;","\x2A86")+  ,("gtrarr;","\x2978")+  ,("gtrdot;","\x22D7")+  ,("gtreqless;","\x22DB")+  ,("gtreqqless;","\x2A8C")+  ,("gtrless;","\x2277")+  ,("gtrsim;","\x2273")+  ,("gvertneqq;","\x2269\xFE00")+  ,("gvnE;","\x2269\xFE00")+  ,("Hacek;","\x02C7")+  ,("hairsp;","\x200A")+  ,("half;","\x00BD")+  ,("hamilt;","\x210B")+  ,("HARDcy;","\x042A")+  ,("hardcy;","\x044A")+  ,("harr;","\x2194")+  ,("hArr;","\x21D4")+  ,("harrcir;","\x2948")+  ,("harrw;","\x21AD")+  ,("Hat;","\x005E")+  ,("hbar;","\x210F")+  ,("Hcirc;","\x0124")+  ,("hcirc;","\x0125")+  ,("hearts;","\x2665")+  ,("heartsuit;","\x2665")+  ,("hellip;","\x2026")+  ,("hercon;","\x22B9")+  ,("Hfr;","\x210C")+  ,("hfr;","\xD835\xDD25")+  ,("HilbertSpace;","\x210B")+  ,("hksearow;","\x2925")+  ,("hkswarow;","\x2926")+  ,("hoarr;","\x21FF")+  ,("homtht;","\x223B")+  ,("hookleftarrow;","\x21A9")+  ,("hookrightarrow;","\x21AA")+  ,("Hopf;","\x210D")+  ,("hopf;","\xD835\xDD59")+  ,("horbar;","\x2015")+  ,("HorizontalLine;","\x2500")+  ,("Hscr;","\x210B")+  ,("hscr;","\xD835\xDCBD")+  ,("hslash;","\x210F")+  ,("Hstrok;","\x0126")+  ,("hstrok;","\x0127")+  ,("HumpDownHump;","\x224E")+  ,("HumpEqual;","\x224F")+  ,("hybull;","\x2043")+  ,("hyphen;","\x2010")+  ,("Iacute","\x00CD")+  ,("iacute","\x00ED")+  ,("Iacute;","\x00CD")+  ,("iacute;","\x00ED")+  ,("ic;","\x2063")+  ,("Icirc","\x00CE")+  ,("icirc","\x00EE")+  ,("Icirc;","\x00CE")+  ,("icirc;","\x00EE")+  ,("Icy;","\x0418")+  ,("icy;","\x0438")+  ,("Idot;","\x0130")+  ,("IEcy;","\x0415")+  ,("iecy;","\x0435")+  ,("iexcl","\x00A1")+  ,("iexcl;","\x00A1")+  ,("iff;","\x21D4")+  ,("Ifr;","\x2111")+  ,("ifr;","\xD835\xDD26")+  ,("Igrave","\x00CC")+  ,("igrave","\x00EC")+  ,("Igrave;","\x00CC")+  ,("igrave;","\x00EC")+  ,("ii;","\x2148")+  ,("iiiint;","\x2A0C")+  ,("iiint;","\x222D")+  ,("iinfin;","\x29DC")+  ,("iiota;","\x2129")+  ,("IJlig;","\x0132")+  ,("ijlig;","\x0133")+  ,("Im;","\x2111")+  ,("Imacr;","\x012A")+  ,("imacr;","\x012B")+  ,("image;","\x2111")+  ,("ImaginaryI;","\x2148")+  ,("imagline;","\x2110")+  ,("imagpart;","\x2111")+  ,("imath;","\x0131")+  ,("imof;","\x22B7")+  ,("imped;","\x01B5")+  ,("Implies;","\x21D2")+  ,("in;","\x2208")+  ,("incare;","\x2105")+  ,("infin;","\x221E")+  ,("infintie;","\x29DD")+  ,("inodot;","\x0131")+  ,("int;","\x222B")+  ,("Int;","\x222C")+  ,("intcal;","\x22BA")+  ,("integers;","\x2124")+  ,("Integral;","\x222B")+  ,("intercal;","\x22BA")+  ,("Intersection;","\x22C2")+  ,("intlarhk;","\x2A17")+  ,("intprod;","\x2A3C")+  ,("InvisibleComma;","\x2063")+  ,("InvisibleTimes;","\x2062")+  ,("IOcy;","\x0401")+  ,("iocy;","\x0451")+  ,("Iogon;","\x012E")+  ,("iogon;","\x012F")+  ,("Iopf;","\xD835\xDD40")+  ,("iopf;","\xD835\xDD5A")+  ,("Iota;","\x0399")+  ,("iota;","\x03B9")+  ,("iprod;","\x2A3C")+  ,("iquest","\x00BF")+  ,("iquest;","\x00BF")+  ,("Iscr;","\x2110")+  ,("iscr;","\xD835\xDCBE")+  ,("isin;","\x2208")+  ,("isindot;","\x22F5")+  ,("isinE;","\x22F9")+  ,("isins;","\x22F4")+  ,("isinsv;","\x22F3")+  ,("isinv;","\x2208")+  ,("it;","\x2062")+  ,("Itilde;","\x0128")+  ,("itilde;","\x0129")+  ,("Iukcy;","\x0406")+  ,("iukcy;","\x0456")+  ,("Iuml","\x00CF")+  ,("iuml","\x00EF")+  ,("Iuml;","\x00CF")+  ,("iuml;","\x00EF")+  ,("Jcirc;","\x0134")+  ,("jcirc;","\x0135")+  ,("Jcy;","\x0419")+  ,("jcy;","\x0439")+  ,("Jfr;","\xD835\xDD0D")+  ,("jfr;","\xD835\xDD27")+  ,("jmath;","\x0237")+  ,("Jopf;","\xD835\xDD41")+  ,("jopf;","\xD835\xDD5B")+  ,("Jscr;","\xD835\xDCA5")+  ,("jscr;","\xD835\xDCBF")+  ,("Jsercy;","\x0408")+  ,("jsercy;","\x0458")+  ,("Jukcy;","\x0404")+  ,("jukcy;","\x0454")+  ,("Kappa;","\x039A")+  ,("kappa;","\x03BA")+  ,("kappav;","\x03F0")+  ,("Kcedil;","\x0136")+  ,("kcedil;","\x0137")+  ,("Kcy;","\x041A")+  ,("kcy;","\x043A")+  ,("Kfr;","\xD835\xDD0E")+  ,("kfr;","\xD835\xDD28")+  ,("kgreen;","\x0138")+  ,("KHcy;","\x0425")+  ,("khcy;","\x0445")+  ,("KJcy;","\x040C")+  ,("kjcy;","\x045C")+  ,("Kopf;","\xD835\xDD42")+  ,("kopf;","\xD835\xDD5C")+  ,("Kscr;","\xD835\xDCA6")+  ,("kscr;","\xD835\xDCC0")+  ,("lAarr;","\x21DA")+  ,("Lacute;","\x0139")+  ,("lacute;","\x013A")+  ,("laemptyv;","\x29B4")+  ,("lagran;","\x2112")+  ,("Lambda;","\x039B")+  ,("lambda;","\x03BB")+  ,("lang;","\x27E8")+  ,("Lang;","\x27EA")+  ,("langd;","\x2991")+  ,("langle;","\x27E8")+  ,("lap;","\x2A85")+  ,("Laplacetrf;","\x2112")+  ,("laquo","\x00AB")+  ,("laquo;","\x00AB")+  ,("larr;","\x2190")+  ,("Larr;","\x219E")+  ,("lArr;","\x21D0")+  ,("larrb;","\x21E4")+  ,("larrbfs;","\x291F")+  ,("larrfs;","\x291D")+  ,("larrhk;","\x21A9")+  ,("larrlp;","\x21AB")+  ,("larrpl;","\x2939")+  ,("larrsim;","\x2973")+  ,("larrtl;","\x21A2")+  ,("lat;","\x2AAB")+  ,("latail;","\x2919")+  ,("lAtail;","\x291B")+  ,("late;","\x2AAD")+  ,("lates;","\x2AAD\xFE00")+  ,("lbarr;","\x290C")+  ,("lBarr;","\x290E")+  ,("lbbrk;","\x2772")+  ,("lbrace;","\x007B")+  ,("lbrack;","\x005B")+  ,("lbrke;","\x298B")+  ,("lbrksld;","\x298F")+  ,("lbrkslu;","\x298D")+  ,("Lcaron;","\x013D")+  ,("lcaron;","\x013E")+  ,("Lcedil;","\x013B")+  ,("lcedil;","\x013C")+  ,("lceil;","\x2308")+  ,("lcub;","\x007B")+  ,("Lcy;","\x041B")+  ,("lcy;","\x043B")+  ,("ldca;","\x2936")+  ,("ldquo;","\x201C")+  ,("ldquor;","\x201E")+  ,("ldrdhar;","\x2967")+  ,("ldrushar;","\x294B")+  ,("ldsh;","\x21B2")+  ,("le;","\x2264")+  ,("lE;","\x2266")+  ,("LeftAngleBracket;","\x27E8")+  ,("LeftArrow;","\x2190")+  ,("leftarrow;","\x2190")+  ,("Leftarrow;","\x21D0")+  ,("LeftArrowBar;","\x21E4")+  ,("LeftArrowRightArrow;","\x21C6")+  ,("leftarrowtail;","\x21A2")+  ,("LeftCeiling;","\x2308")+  ,("LeftDoubleBracket;","\x27E6")+  ,("LeftDownTeeVector;","\x2961")+  ,("LeftDownVector;","\x21C3")+  ,("LeftDownVectorBar;","\x2959")+  ,("LeftFloor;","\x230A")+  ,("leftharpoondown;","\x21BD")+  ,("leftharpoonup;","\x21BC")+  ,("leftleftarrows;","\x21C7")+  ,("LeftRightArrow;","\x2194")+  ,("leftrightarrow;","\x2194")+  ,("Leftrightarrow;","\x21D4")+  ,("leftrightarrows;","\x21C6")+  ,("leftrightharpoons;","\x21CB")+  ,("leftrightsquigarrow;","\x21AD")+  ,("LeftRightVector;","\x294E")+  ,("LeftTee;","\x22A3")+  ,("LeftTeeArrow;","\x21A4")+  ,("LeftTeeVector;","\x295A")+  ,("leftthreetimes;","\x22CB")+  ,("LeftTriangle;","\x22B2")+  ,("LeftTriangleBar;","\x29CF")+  ,("LeftTriangleEqual;","\x22B4")+  ,("LeftUpDownVector;","\x2951")+  ,("LeftUpTeeVector;","\x2960")+  ,("LeftUpVector;","\x21BF")+  ,("LeftUpVectorBar;","\x2958")+  ,("LeftVector;","\x21BC")+  ,("LeftVectorBar;","\x2952")+  ,("leg;","\x22DA")+  ,("lEg;","\x2A8B")+  ,("leq;","\x2264")+  ,("leqq;","\x2266")+  ,("leqslant;","\x2A7D")+  ,("les;","\x2A7D")+  ,("lescc;","\x2AA8")+  ,("lesdot;","\x2A7F")+  ,("lesdoto;","\x2A81")+  ,("lesdotor;","\x2A83")+  ,("lesg;","\x22DA\xFE00")+  ,("lesges;","\x2A93")+  ,("lessapprox;","\x2A85")+  ,("lessdot;","\x22D6")+  ,("lesseqgtr;","\x22DA")+  ,("lesseqqgtr;","\x2A8B")+  ,("LessEqualGreater;","\x22DA")+  ,("LessFullEqual;","\x2266")+  ,("LessGreater;","\x2276")+  ,("lessgtr;","\x2276")+  ,("LessLess;","\x2AA1")+  ,("lesssim;","\x2272")+  ,("LessSlantEqual;","\x2A7D")+  ,("LessTilde;","\x2272")+  ,("lfisht;","\x297C")+  ,("lfloor;","\x230A")+  ,("Lfr;","\xD835\xDD0F")+  ,("lfr;","\xD835\xDD29")+  ,("lg;","\x2276")+  ,("lgE;","\x2A91")+  ,("lHar;","\x2962")+  ,("lhard;","\x21BD")+  ,("lharu;","\x21BC")+  ,("lharul;","\x296A")+  ,("lhblk;","\x2584")+  ,("LJcy;","\x0409")+  ,("ljcy;","\x0459")+  ,("ll;","\x226A")+  ,("Ll;","\x22D8")+  ,("llarr;","\x21C7")+  ,("llcorner;","\x231E")+  ,("Lleftarrow;","\x21DA")+  ,("llhard;","\x296B")+  ,("lltri;","\x25FA")+  ,("Lmidot;","\x013F")+  ,("lmidot;","\x0140")+  ,("lmoust;","\x23B0")+  ,("lmoustache;","\x23B0")+  ,("lnap;","\x2A89")+  ,("lnapprox;","\x2A89")+  ,("lnE;","\x2268")+  ,("lne;","\x2A87")+  ,("lneq;","\x2A87")+  ,("lneqq;","\x2268")+  ,("lnsim;","\x22E6")+  ,("loang;","\x27EC")+  ,("loarr;","\x21FD")+  ,("lobrk;","\x27E6")+  ,("LongLeftArrow;","\x27F5")+  ,("longleftarrow;","\x27F5")+  ,("Longleftarrow;","\x27F8")+  ,("LongLeftRightArrow;","\x27F7")+  ,("longleftrightarrow;","\x27F7")+  ,("Longleftrightarrow;","\x27FA")+  ,("longmapsto;","\x27FC")+  ,("LongRightArrow;","\x27F6")+  ,("longrightarrow;","\x27F6")+  ,("Longrightarrow;","\x27F9")+  ,("looparrowleft;","\x21AB")+  ,("looparrowright;","\x21AC")+  ,("lopar;","\x2985")+  ,("Lopf;","\xD835\xDD43")+  ,("lopf;","\xD835\xDD5D")+  ,("loplus;","\x2A2D")+  ,("lotimes;","\x2A34")+  ,("lowast;","\x2217")+  ,("lowbar;","\x005F")+  ,("LowerLeftArrow;","\x2199")+  ,("LowerRightArrow;","\x2198")+  ,("loz;","\x25CA")+  ,("lozenge;","\x25CA")+  ,("lozf;","\x29EB")+  ,("lpar;","\x0028")+  ,("lparlt;","\x2993")+  ,("lrarr;","\x21C6")+  ,("lrcorner;","\x231F")+  ,("lrhar;","\x21CB")+  ,("lrhard;","\x296D")+  ,("lrm;","\x200E")+  ,("lrtri;","\x22BF")+  ,("lsaquo;","\x2039")+  ,("Lscr;","\x2112")+  ,("lscr;","\xD835\xDCC1")+  ,("Lsh;","\x21B0")+  ,("lsh;","\x21B0")+  ,("lsim;","\x2272")+  ,("lsime;","\x2A8D")+  ,("lsimg;","\x2A8F")+  ,("lsqb;","\x005B")+  ,("lsquo;","\x2018")+  ,("lsquor;","\x201A")+  ,("Lstrok;","\x0141")+  ,("lstrok;","\x0142")+  ,("LT","\x003C")+  ,("lt","\x003C")+  ,("LT;","\x003C")+  ,("lt;","\x003C")+  ,("Lt;","\x226A")+  ,("ltcc;","\x2AA6")+  ,("ltcir;","\x2A79")+  ,("ltdot;","\x22D6")+  ,("lthree;","\x22CB")+  ,("ltimes;","\x22C9")+  ,("ltlarr;","\x2976")+  ,("ltquest;","\x2A7B")+  ,("ltri;","\x25C3")+  ,("ltrie;","\x22B4")+  ,("ltrif;","\x25C2")+  ,("ltrPar;","\x2996")+  ,("lurdshar;","\x294A")+  ,("luruhar;","\x2966")+  ,("lvertneqq;","\x2268\xFE00")+  ,("lvnE;","\x2268\xFE00")+  ,("macr","\x00AF")+  ,("macr;","\x00AF")+  ,("male;","\x2642")+  ,("malt;","\x2720")+  ,("maltese;","\x2720")+  ,("map;","\x21A6")+  ,("Map;","\x2905")+  ,("mapsto;","\x21A6")+  ,("mapstodown;","\x21A7")+  ,("mapstoleft;","\x21A4")+  ,("mapstoup;","\x21A5")+  ,("marker;","\x25AE")+  ,("mcomma;","\x2A29")+  ,("Mcy;","\x041C")+  ,("mcy;","\x043C")+  ,("mdash;","\x2014")+  ,("mDDot;","\x223A")+  ,("measuredangle;","\x2221")+  ,("MediumSpace;","\x205F")+  ,("Mellintrf;","\x2133")+  ,("Mfr;","\xD835\xDD10")+  ,("mfr;","\xD835\xDD2A")+  ,("mho;","\x2127")+  ,("micro","\x00B5")+  ,("micro;","\x00B5")+  ,("mid;","\x2223")+  ,("midast;","\x002A")+  ,("midcir;","\x2AF0")+  ,("middot","\x00B7")+  ,("middot;","\x00B7")+  ,("minus;","\x2212")+  ,("minusb;","\x229F")+  ,("minusd;","\x2238")+  ,("minusdu;","\x2A2A")+  ,("MinusPlus;","\x2213")+  ,("mlcp;","\x2ADB")+  ,("mldr;","\x2026")+  ,("mnplus;","\x2213")+  ,("models;","\x22A7")+  ,("Mopf;","\xD835\xDD44")+  ,("mopf;","\xD835\xDD5E")+  ,("mp;","\x2213")+  ,("Mscr;","\x2133")+  ,("mscr;","\xD835\xDCC2")+  ,("mstpos;","\x223E")+  ,("Mu;","\x039C")+  ,("mu;","\x03BC")+  ,("multimap;","\x22B8")+  ,("mumap;","\x22B8")+  ,("nabla;","\x2207")+  ,("Nacute;","\x0143")+  ,("nacute;","\x0144")+  ,("nang;","\x2220\x20D2")+  ,("nap;","\x2249")+  ,("napE;","\x2A70\x0338")+  ,("napid;","\x224B\x0338")+  ,("napos;","\x0149")+  ,("napprox;","\x2249")+  ,("natur;","\x266E")+  ,("natural;","\x266E")+  ,("naturals;","\x2115")+  ,("nbsp","\x00A0")+  ,("nbsp;","\x00A0")+  ,("nbump;","\x224E\x0338")+  ,("nbumpe;","\x224F\x0338")+  ,("ncap;","\x2A43")+  ,("Ncaron;","\x0147")+  ,("ncaron;","\x0148")+  ,("Ncedil;","\x0145")+  ,("ncedil;","\x0146")+  ,("ncong;","\x2247")+  ,("ncongdot;","\x2A6D\x0338")+  ,("ncup;","\x2A42")+  ,("Ncy;","\x041D")+  ,("ncy;","\x043D")+  ,("ndash;","\x2013")+  ,("ne;","\x2260")+  ,("nearhk;","\x2924")+  ,("nearr;","\x2197")+  ,("neArr;","\x21D7")+  ,("nearrow;","\x2197")+  ,("nedot;","\x2250\x0338")+  ,("NegativeMediumSpace;","\x200B")+  ,("NegativeThickSpace;","\x200B")+  ,("NegativeThinSpace;","\x200B")+  ,("NegativeVeryThinSpace;","\x200B")+  ,("nequiv;","\x2262")+  ,("nesear;","\x2928")+  ,("nesim;","\x2242\x0338")+  ,("NestedGreaterGreater;","\x226B")+  ,("NestedLessLess;","\x226A")+  ,("NewLine;","\x000A")+  ,("nexist;","\x2204")+  ,("nexists;","\x2204")+  ,("Nfr;","\xD835\xDD11")+  ,("nfr;","\xD835\xDD2B")+  ,("ngE;","\x2267\x0338")+  ,("nge;","\x2271")+  ,("ngeq;","\x2271")+  ,("ngeqq;","\x2267\x0338")+  ,("ngeqslant;","\x2A7E\x0338")+  ,("nges;","\x2A7E\x0338")+  ,("nGg;","\x22D9\x0338")+  ,("ngsim;","\x2275")+  ,("nGt;","\x226B\x20D2")+  ,("ngt;","\x226F")+  ,("ngtr;","\x226F")+  ,("nGtv;","\x226B\x0338")+  ,("nharr;","\x21AE")+  ,("nhArr;","\x21CE")+  ,("nhpar;","\x2AF2")+  ,("ni;","\x220B")+  ,("nis;","\x22FC")+  ,("nisd;","\x22FA")+  ,("niv;","\x220B")+  ,("NJcy;","\x040A")+  ,("njcy;","\x045A")+  ,("nlarr;","\x219A")+  ,("nlArr;","\x21CD")+  ,("nldr;","\x2025")+  ,("nlE;","\x2266\x0338")+  ,("nle;","\x2270")+  ,("nleftarrow;","\x219A")+  ,("nLeftarrow;","\x21CD")+  ,("nleftrightarrow;","\x21AE")+  ,("nLeftrightarrow;","\x21CE")+  ,("nleq;","\x2270")+  ,("nleqq;","\x2266\x0338")+  ,("nleqslant;","\x2A7D\x0338")+  ,("nles;","\x2A7D\x0338")+  ,("nless;","\x226E")+  ,("nLl;","\x22D8\x0338")+  ,("nlsim;","\x2274")+  ,("nLt;","\x226A\x20D2")+  ,("nlt;","\x226E")+  ,("nltri;","\x22EA")+  ,("nltrie;","\x22EC")+  ,("nLtv;","\x226A\x0338")+  ,("nmid;","\x2224")+  ,("NoBreak;","\x2060")+  ,("NonBreakingSpace;","\x00A0")+  ,("Nopf;","\x2115")+  ,("nopf;","\xD835\xDD5F")+  ,("not","\x00AC")+  ,("not;","\x00AC")+  ,("Not;","\x2AEC")+  ,("NotCongruent;","\x2262")+  ,("NotCupCap;","\x226D")+  ,("NotDoubleVerticalBar;","\x2226")+  ,("NotElement;","\x2209")+  ,("NotEqual;","\x2260")+  ,("NotEqualTilde;","\x2242\x0338")+  ,("NotExists;","\x2204")+  ,("NotGreater;","\x226F")+  ,("NotGreaterEqual;","\x2271")+  ,("NotGreaterFullEqual;","\x2267\x0338")+  ,("NotGreaterGreater;","\x226B\x0338")+  ,("NotGreaterLess;","\x2279")+  ,("NotGreaterSlantEqual;","\x2A7E\x0338")+  ,("NotGreaterTilde;","\x2275")+  ,("NotHumpDownHump;","\x224E\x0338")+  ,("NotHumpEqual;","\x224F\x0338")+  ,("notin;","\x2209")+  ,("notindot;","\x22F5\x0338")+  ,("notinE;","\x22F9\x0338")+  ,("notinva;","\x2209")+  ,("notinvb;","\x22F7")+  ,("notinvc;","\x22F6")+  ,("NotLeftTriangle;","\x22EA")+  ,("NotLeftTriangleBar;","\x29CF\x0338")+  ,("NotLeftTriangleEqual;","\x22EC")+  ,("NotLess;","\x226E")+  ,("NotLessEqual;","\x2270")+  ,("NotLessGreater;","\x2278")+  ,("NotLessLess;","\x226A\x0338")+  ,("NotLessSlantEqual;","\x2A7D\x0338")+  ,("NotLessTilde;","\x2274")+  ,("NotNestedGreaterGreater;","\x2AA2\x0338")+  ,("NotNestedLessLess;","\x2AA1\x0338")+  ,("notni;","\x220C")+  ,("notniva;","\x220C")+  ,("notnivb;","\x22FE")+  ,("notnivc;","\x22FD")+  ,("NotPrecedes;","\x2280")+  ,("NotPrecedesEqual;","\x2AAF\x0338")+  ,("NotPrecedesSlantEqual;","\x22E0")+  ,("NotReverseElement;","\x220C")+  ,("NotRightTriangle;","\x22EB")+  ,("NotRightTriangleBar;","\x29D0\x0338")+  ,("NotRightTriangleEqual;","\x22ED")+  ,("NotSquareSubset;","\x228F\x0338")+  ,("NotSquareSubsetEqual;","\x22E2")+  ,("NotSquareSuperset;","\x2290\x0338")+  ,("NotSquareSupersetEqual;","\x22E3")+  ,("NotSubset;","\x2282\x20D2")+  ,("NotSubsetEqual;","\x2288")+  ,("NotSucceeds;","\x2281")+  ,("NotSucceedsEqual;","\x2AB0\x0338")+  ,("NotSucceedsSlantEqual;","\x22E1")+  ,("NotSucceedsTilde;","\x227F\x0338")+  ,("NotSuperset;","\x2283\x20D2")+  ,("NotSupersetEqual;","\x2289")+  ,("NotTilde;","\x2241")+  ,("NotTildeEqual;","\x2244")+  ,("NotTildeFullEqual;","\x2247")+  ,("NotTildeTilde;","\x2249")+  ,("NotVerticalBar;","\x2224")+  ,("npar;","\x2226")+  ,("nparallel;","\x2226")+  ,("nparsl;","\x2AFD\x20E5")+  ,("npart;","\x2202\x0338")+  ,("npolint;","\x2A14")+  ,("npr;","\x2280")+  ,("nprcue;","\x22E0")+  ,("npre;","\x2AAF\x0338")+  ,("nprec;","\x2280")+  ,("npreceq;","\x2AAF\x0338")+  ,("nrarr;","\x219B")+  ,("nrArr;","\x21CF")+  ,("nrarrc;","\x2933\x0338")+  ,("nrarrw;","\x219D\x0338")+  ,("nrightarrow;","\x219B")+  ,("nRightarrow;","\x21CF")+  ,("nrtri;","\x22EB")+  ,("nrtrie;","\x22ED")+  ,("nsc;","\x2281")+  ,("nsccue;","\x22E1")+  ,("nsce;","\x2AB0\x0338")+  ,("Nscr;","\xD835\xDCA9")+  ,("nscr;","\xD835\xDCC3")+  ,("nshortmid;","\x2224")+  ,("nshortparallel;","\x2226")+  ,("nsim;","\x2241")+  ,("nsime;","\x2244")+  ,("nsimeq;","\x2244")+  ,("nsmid;","\x2224")+  ,("nspar;","\x2226")+  ,("nsqsube;","\x22E2")+  ,("nsqsupe;","\x22E3")+  ,("nsub;","\x2284")+  ,("nsube;","\x2288")+  ,("nsubE;","\x2AC5\x0338")+  ,("nsubset;","\x2282\x20D2")+  ,("nsubseteq;","\x2288")+  ,("nsubseteqq;","\x2AC5\x0338")+  ,("nsucc;","\x2281")+  ,("nsucceq;","\x2AB0\x0338")+  ,("nsup;","\x2285")+  ,("nsupe;","\x2289")+  ,("nsupE;","\x2AC6\x0338")+  ,("nsupset;","\x2283\x20D2")+  ,("nsupseteq;","\x2289")+  ,("nsupseteqq;","\x2AC6\x0338")+  ,("ntgl;","\x2279")+  ,("Ntilde","\x00D1")+  ,("ntilde","\x00F1")+  ,("Ntilde;","\x00D1")+  ,("ntilde;","\x00F1")+  ,("ntlg;","\x2278")+  ,("ntriangleleft;","\x22EA")+  ,("ntrianglelefteq;","\x22EC")+  ,("ntriangleright;","\x22EB")+  ,("ntrianglerighteq;","\x22ED")+  ,("Nu;","\x039D")+  ,("nu;","\x03BD")+  ,("num;","\x0023")+  ,("numero;","\x2116")+  ,("numsp;","\x2007")+  ,("nvap;","\x224D\x20D2")+  ,("nvdash;","\x22AC")+  ,("nvDash;","\x22AD")+  ,("nVdash;","\x22AE")+  ,("nVDash;","\x22AF")+  ,("nvge;","\x2265\x20D2")+  ,("nvgt;","\x003E\x20D2")+  ,("nvHarr;","\x2904")+  ,("nvinfin;","\x29DE")+  ,("nvlArr;","\x2902")+  ,("nvle;","\x2264\x20D2")+  ,("nvlt;","\x003C\x20D2")+  ,("nvltrie;","\x22B4\x20D2")+  ,("nvrArr;","\x2903")+  ,("nvrtrie;","\x22B5\x20D2")+  ,("nvsim;","\x223C\x20D2")+  ,("nwarhk;","\x2923")+  ,("nwarr;","\x2196")+  ,("nwArr;","\x21D6")+  ,("nwarrow;","\x2196")+  ,("nwnear;","\x2927")+  ,("Oacute","\x00D3")+  ,("oacute","\x00F3")+  ,("Oacute;","\x00D3")+  ,("oacute;","\x00F3")+  ,("oast;","\x229B")+  ,("ocir;","\x229A")+  ,("Ocirc","\x00D4")+  ,("ocirc","\x00F4")+  ,("Ocirc;","\x00D4")+  ,("ocirc;","\x00F4")+  ,("Ocy;","\x041E")+  ,("ocy;","\x043E")+  ,("odash;","\x229D")+  ,("Odblac;","\x0150")+  ,("odblac;","\x0151")+  ,("odiv;","\x2A38")+  ,("odot;","\x2299")+  ,("odsold;","\x29BC")+  ,("OElig;","\x0152")+  ,("oelig;","\x0153")+  ,("ofcir;","\x29BF")+  ,("Ofr;","\xD835\xDD12")+  ,("ofr;","\xD835\xDD2C")+  ,("ogon;","\x02DB")+  ,("Ograve","\x00D2")+  ,("ograve","\x00F2")+  ,("Ograve;","\x00D2")+  ,("ograve;","\x00F2")+  ,("ogt;","\x29C1")+  ,("ohbar;","\x29B5")+  ,("ohm;","\x03A9")+  ,("oint;","\x222E")+  ,("olarr;","\x21BA")+  ,("olcir;","\x29BE")+  ,("olcross;","\x29BB")+  ,("oline;","\x203E")+  ,("olt;","\x29C0")+  ,("Omacr;","\x014C")+  ,("omacr;","\x014D")+  ,("Omega;","\x03A9")+  ,("omega;","\x03C9")+  ,("Omicron;","\x039F")+  ,("omicron;","\x03BF")+  ,("omid;","\x29B6")+  ,("ominus;","\x2296")+  ,("Oopf;","\xD835\xDD46")+  ,("oopf;","\xD835\xDD60")+  ,("opar;","\x29B7")+  ,("OpenCurlyDoubleQuote;","\x201C")+  ,("OpenCurlyQuote;","\x2018")+  ,("operp;","\x29B9")+  ,("oplus;","\x2295")+  ,("or;","\x2228")+  ,("Or;","\x2A54")+  ,("orarr;","\x21BB")+  ,("ord;","\x2A5D")+  ,("order;","\x2134")+  ,("orderof;","\x2134")+  ,("ordf","\x00AA")+  ,("ordf;","\x00AA")+  ,("ordm","\x00BA")+  ,("ordm;","\x00BA")+  ,("origof;","\x22B6")+  ,("oror;","\x2A56")+  ,("orslope;","\x2A57")+  ,("orv;","\x2A5B")+  ,("oS;","\x24C8")+  ,("oscr;","\x2134")+  ,("Oscr;","\xD835\xDCAA")+  ,("Oslash","\x00D8")+  ,("oslash","\x00F8")+  ,("Oslash;","\x00D8")+  ,("oslash;","\x00F8")+  ,("osol;","\x2298")+  ,("Otilde","\x00D5")+  ,("otilde","\x00F5")+  ,("Otilde;","\x00D5")+  ,("otilde;","\x00F5")+  ,("otimes;","\x2297")+  ,("Otimes;","\x2A37")+  ,("otimesas;","\x2A36")+  ,("Ouml","\x00D6")+  ,("ouml","\x00F6")+  ,("Ouml;","\x00D6")+  ,("ouml;","\x00F6")+  ,("ovbar;","\x233D")+  ,("OverBar;","\x203E")+  ,("OverBrace;","\x23DE")+  ,("OverBracket;","\x23B4")+  ,("OverParenthesis;","\x23DC")+  ,("par;","\x2225")+  ,("para","\x00B6")+  ,("para;","\x00B6")+  ,("parallel;","\x2225")+  ,("parsim;","\x2AF3")+  ,("parsl;","\x2AFD")+  ,("part;","\x2202")+  ,("PartialD;","\x2202")+  ,("Pcy;","\x041F")+  ,("pcy;","\x043F")+  ,("percnt;","\x0025")+  ,("period;","\x002E")+  ,("permil;","\x2030")+  ,("perp;","\x22A5")+  ,("pertenk;","\x2031")+  ,("Pfr;","\xD835\xDD13")+  ,("pfr;","\xD835\xDD2D")+  ,("Phi;","\x03A6")+  ,("phi;","\x03C6")+  ,("phiv;","\x03D5")+  ,("phmmat;","\x2133")+  ,("phone;","\x260E")+  ,("Pi;","\x03A0")+  ,("pi;","\x03C0")+  ,("pitchfork;","\x22D4")+  ,("piv;","\x03D6")+  ,("planck;","\x210F")+  ,("planckh;","\x210E")+  ,("plankv;","\x210F")+  ,("plus;","\x002B")+  ,("plusacir;","\x2A23")+  ,("plusb;","\x229E")+  ,("pluscir;","\x2A22")+  ,("plusdo;","\x2214")+  ,("plusdu;","\x2A25")+  ,("pluse;","\x2A72")+  ,("PlusMinus;","\x00B1")+  ,("plusmn","\x00B1")+  ,("plusmn;","\x00B1")+  ,("plussim;","\x2A26")+  ,("plustwo;","\x2A27")+  ,("pm;","\x00B1")+  ,("Poincareplane;","\x210C")+  ,("pointint;","\x2A15")+  ,("Popf;","\x2119")+  ,("popf;","\xD835\xDD61")+  ,("pound","\x00A3")+  ,("pound;","\x00A3")+  ,("pr;","\x227A")+  ,("Pr;","\x2ABB")+  ,("prap;","\x2AB7")+  ,("prcue;","\x227C")+  ,("pre;","\x2AAF")+  ,("prE;","\x2AB3")+  ,("prec;","\x227A")+  ,("precapprox;","\x2AB7")+  ,("preccurlyeq;","\x227C")+  ,("Precedes;","\x227A")+  ,("PrecedesEqual;","\x2AAF")+  ,("PrecedesSlantEqual;","\x227C")+  ,("PrecedesTilde;","\x227E")+  ,("preceq;","\x2AAF")+  ,("precnapprox;","\x2AB9")+  ,("precneqq;","\x2AB5")+  ,("precnsim;","\x22E8")+  ,("precsim;","\x227E")+  ,("prime;","\x2032")+  ,("Prime;","\x2033")+  ,("primes;","\x2119")+  ,("prnap;","\x2AB9")+  ,("prnE;","\x2AB5")+  ,("prnsim;","\x22E8")+  ,("prod;","\x220F")+  ,("Product;","\x220F")+  ,("profalar;","\x232E")+  ,("profline;","\x2312")+  ,("profsurf;","\x2313")+  ,("prop;","\x221D")+  ,("Proportion;","\x2237")+  ,("Proportional;","\x221D")+  ,("propto;","\x221D")+  ,("prsim;","\x227E")+  ,("prurel;","\x22B0")+  ,("Pscr;","\xD835\xDCAB")+  ,("pscr;","\xD835\xDCC5")+  ,("Psi;","\x03A8")+  ,("psi;","\x03C8")+  ,("puncsp;","\x2008")+  ,("Qfr;","\xD835\xDD14")+  ,("qfr;","\xD835\xDD2E")+  ,("qint;","\x2A0C")+  ,("Qopf;","\x211A")+  ,("qopf;","\xD835\xDD62")+  ,("qprime;","\x2057")+  ,("Qscr;","\xD835\xDCAC")+  ,("qscr;","\xD835\xDCC6")+  ,("quaternions;","\x210D")+  ,("quatint;","\x2A16")+  ,("quest;","\x003F")+  ,("questeq;","\x225F")+  ,("QUOT","\x0022")+  ,("quot","\x0022")+  ,("QUOT;","\x0022")+  ,("quot;","\x0022")+  ,("rAarr;","\x21DB")+  ,("race;","\x223D\x0331")+  ,("Racute;","\x0154")+  ,("racute;","\x0155")+  ,("radic;","\x221A")+  ,("raemptyv;","\x29B3")+  ,("rang;","\x27E9")+  ,("Rang;","\x27EB")+  ,("rangd;","\x2992")+  ,("range;","\x29A5")+  ,("rangle;","\x27E9")+  ,("raquo","\x00BB")+  ,("raquo;","\x00BB")+  ,("rarr;","\x2192")+  ,("Rarr;","\x21A0")+  ,("rArr;","\x21D2")+  ,("rarrap;","\x2975")+  ,("rarrb;","\x21E5")+  ,("rarrbfs;","\x2920")+  ,("rarrc;","\x2933")+  ,("rarrfs;","\x291E")+  ,("rarrhk;","\x21AA")+  ,("rarrlp;","\x21AC")+  ,("rarrpl;","\x2945")+  ,("rarrsim;","\x2974")+  ,("rarrtl;","\x21A3")+  ,("Rarrtl;","\x2916")+  ,("rarrw;","\x219D")+  ,("ratail;","\x291A")+  ,("rAtail;","\x291C")+  ,("ratio;","\x2236")+  ,("rationals;","\x211A")+  ,("rbarr;","\x290D")+  ,("rBarr;","\x290F")+  ,("RBarr;","\x2910")+  ,("rbbrk;","\x2773")+  ,("rbrace;","\x007D")+  ,("rbrack;","\x005D")+  ,("rbrke;","\x298C")+  ,("rbrksld;","\x298E")+  ,("rbrkslu;","\x2990")+  ,("Rcaron;","\x0158")+  ,("rcaron;","\x0159")+  ,("Rcedil;","\x0156")+  ,("rcedil;","\x0157")+  ,("rceil;","\x2309")+  ,("rcub;","\x007D")+  ,("Rcy;","\x0420")+  ,("rcy;","\x0440")+  ,("rdca;","\x2937")+  ,("rdldhar;","\x2969")+  ,("rdquo;","\x201D")+  ,("rdquor;","\x201D")+  ,("rdsh;","\x21B3")+  ,("Re;","\x211C")+  ,("real;","\x211C")+  ,("realine;","\x211B")+  ,("realpart;","\x211C")+  ,("reals;","\x211D")+  ,("rect;","\x25AD")+  ,("REG","\x00AE")+  ,("reg","\x00AE")+  ,("REG;","\x00AE")+  ,("reg;","\x00AE")+  ,("ReverseElement;","\x220B")+  ,("ReverseEquilibrium;","\x21CB")+  ,("ReverseUpEquilibrium;","\x296F")+  ,("rfisht;","\x297D")+  ,("rfloor;","\x230B")+  ,("Rfr;","\x211C")+  ,("rfr;","\xD835\xDD2F")+  ,("rHar;","\x2964")+  ,("rhard;","\x21C1")+  ,("rharu;","\x21C0")+  ,("rharul;","\x296C")+  ,("Rho;","\x03A1")+  ,("rho;","\x03C1")+  ,("rhov;","\x03F1")+  ,("RightAngleBracket;","\x27E9")+  ,("RightArrow;","\x2192")+  ,("rightarrow;","\x2192")+  ,("Rightarrow;","\x21D2")+  ,("RightArrowBar;","\x21E5")+  ,("RightArrowLeftArrow;","\x21C4")+  ,("rightarrowtail;","\x21A3")+  ,("RightCeiling;","\x2309")+  ,("RightDoubleBracket;","\x27E7")+  ,("RightDownTeeVector;","\x295D")+  ,("RightDownVector;","\x21C2")+  ,("RightDownVectorBar;","\x2955")+  ,("RightFloor;","\x230B")+  ,("rightharpoondown;","\x21C1")+  ,("rightharpoonup;","\x21C0")+  ,("rightleftarrows;","\x21C4")+  ,("rightleftharpoons;","\x21CC")+  ,("rightrightarrows;","\x21C9")+  ,("rightsquigarrow;","\x219D")+  ,("RightTee;","\x22A2")+  ,("RightTeeArrow;","\x21A6")+  ,("RightTeeVector;","\x295B")+  ,("rightthreetimes;","\x22CC")+  ,("RightTriangle;","\x22B3")+  ,("RightTriangleBar;","\x29D0")+  ,("RightTriangleEqual;","\x22B5")+  ,("RightUpDownVector;","\x294F")+  ,("RightUpTeeVector;","\x295C")+  ,("RightUpVector;","\x21BE")+  ,("RightUpVectorBar;","\x2954")+  ,("RightVector;","\x21C0")+  ,("RightVectorBar;","\x2953")+  ,("ring;","\x02DA")+  ,("risingdotseq;","\x2253")+  ,("rlarr;","\x21C4")+  ,("rlhar;","\x21CC")+  ,("rlm;","\x200F")+  ,("rmoust;","\x23B1")+  ,("rmoustache;","\x23B1")+  ,("rnmid;","\x2AEE")+  ,("roang;","\x27ED")+  ,("roarr;","\x21FE")+  ,("robrk;","\x27E7")+  ,("ropar;","\x2986")+  ,("Ropf;","\x211D")+  ,("ropf;","\xD835\xDD63")+  ,("roplus;","\x2A2E")+  ,("rotimes;","\x2A35")+  ,("RoundImplies;","\x2970")+  ,("rpar;","\x0029")+  ,("rpargt;","\x2994")+  ,("rppolint;","\x2A12")+  ,("rrarr;","\x21C9")+  ,("Rrightarrow;","\x21DB")+  ,("rsaquo;","\x203A")+  ,("Rscr;","\x211B")+  ,("rscr;","\xD835\xDCC7")+  ,("Rsh;","\x21B1")+  ,("rsh;","\x21B1")+  ,("rsqb;","\x005D")+  ,("rsquo;","\x2019")+  ,("rsquor;","\x2019")+  ,("rthree;","\x22CC")+  ,("rtimes;","\x22CA")+  ,("rtri;","\x25B9")+  ,("rtrie;","\x22B5")+  ,("rtrif;","\x25B8")+  ,("rtriltri;","\x29CE")+  ,("RuleDelayed;","\x29F4")+  ,("ruluhar;","\x2968")+  ,("rx;","\x211E")+  ,("Sacute;","\x015A")+  ,("sacute;","\x015B")+  ,("sbquo;","\x201A")+  ,("sc;","\x227B")+  ,("Sc;","\x2ABC")+  ,("scap;","\x2AB8")+  ,("Scaron;","\x0160")+  ,("scaron;","\x0161")+  ,("sccue;","\x227D")+  ,("sce;","\x2AB0")+  ,("scE;","\x2AB4")+  ,("Scedil;","\x015E")+  ,("scedil;","\x015F")+  ,("Scirc;","\x015C")+  ,("scirc;","\x015D")+  ,("scnap;","\x2ABA")+  ,("scnE;","\x2AB6")+  ,("scnsim;","\x22E9")+  ,("scpolint;","\x2A13")+  ,("scsim;","\x227F")+  ,("Scy;","\x0421")+  ,("scy;","\x0441")+  ,("sdot;","\x22C5")+  ,("sdotb;","\x22A1")+  ,("sdote;","\x2A66")+  ,("searhk;","\x2925")+  ,("searr;","\x2198")+  ,("seArr;","\x21D8")+  ,("searrow;","\x2198")+  ,("sect","\x00A7")+  ,("sect;","\x00A7")+  ,("semi;","\x003B")+  ,("seswar;","\x2929")+  ,("setminus;","\x2216")+  ,("setmn;","\x2216")+  ,("sext;","\x2736")+  ,("Sfr;","\xD835\xDD16")+  ,("sfr;","\xD835\xDD30")+  ,("sfrown;","\x2322")+  ,("sharp;","\x266F")+  ,("SHCHcy;","\x0429")+  ,("shchcy;","\x0449")+  ,("SHcy;","\x0428")+  ,("shcy;","\x0448")+  ,("ShortDownArrow;","\x2193")+  ,("ShortLeftArrow;","\x2190")+  ,("shortmid;","\x2223")+  ,("shortparallel;","\x2225")+  ,("ShortRightArrow;","\x2192")+  ,("ShortUpArrow;","\x2191")+  ,("shy","\x00AD")+  ,("shy;","\x00AD")+  ,("Sigma;","\x03A3")+  ,("sigma;","\x03C3")+  ,("sigmaf;","\x03C2")+  ,("sigmav;","\x03C2")+  ,("sim;","\x223C")+  ,("simdot;","\x2A6A")+  ,("sime;","\x2243")+  ,("simeq;","\x2243")+  ,("simg;","\x2A9E")+  ,("simgE;","\x2AA0")+  ,("siml;","\x2A9D")+  ,("simlE;","\x2A9F")+  ,("simne;","\x2246")+  ,("simplus;","\x2A24")+  ,("simrarr;","\x2972")+  ,("slarr;","\x2190")+  ,("SmallCircle;","\x2218")+  ,("smallsetminus;","\x2216")+  ,("smashp;","\x2A33")+  ,("smeparsl;","\x29E4")+  ,("smid;","\x2223")+  ,("smile;","\x2323")+  ,("smt;","\x2AAA")+  ,("smte;","\x2AAC")+  ,("smtes;","\x2AAC\xFE00")+  ,("SOFTcy;","\x042C")+  ,("softcy;","\x044C")+  ,("sol;","\x002F")+  ,("solb;","\x29C4")+  ,("solbar;","\x233F")+  ,("Sopf;","\xD835\xDD4A")+  ,("sopf;","\xD835\xDD64")+  ,("spades;","\x2660")+  ,("spadesuit;","\x2660")+  ,("spar;","\x2225")+  ,("sqcap;","\x2293")+  ,("sqcaps;","\x2293\xFE00")+  ,("sqcup;","\x2294")+  ,("sqcups;","\x2294\xFE00")+  ,("Sqrt;","\x221A")+  ,("sqsub;","\x228F")+  ,("sqsube;","\x2291")+  ,("sqsubset;","\x228F")+  ,("sqsubseteq;","\x2291")+  ,("sqsup;","\x2290")+  ,("sqsupe;","\x2292")+  ,("sqsupset;","\x2290")+  ,("sqsupseteq;","\x2292")+  ,("squ;","\x25A1")+  ,("Square;","\x25A1")+  ,("square;","\x25A1")+  ,("SquareIntersection;","\x2293")+  ,("SquareSubset;","\x228F")+  ,("SquareSubsetEqual;","\x2291")+  ,("SquareSuperset;","\x2290")+  ,("SquareSupersetEqual;","\x2292")+  ,("SquareUnion;","\x2294")+  ,("squarf;","\x25AA")+  ,("squf;","\x25AA")+  ,("srarr;","\x2192")+  ,("Sscr;","\xD835\xDCAE")+  ,("sscr;","\xD835\xDCC8")+  ,("ssetmn;","\x2216")+  ,("ssmile;","\x2323")+  ,("sstarf;","\x22C6")+  ,("Star;","\x22C6")+  ,("star;","\x2606")+  ,("starf;","\x2605")+  ,("straightepsilon;","\x03F5")+  ,("straightphi;","\x03D5")+  ,("strns;","\x00AF")+  ,("sub;","\x2282")+  ,("Sub;","\x22D0")+  ,("subdot;","\x2ABD")+  ,("sube;","\x2286")+  ,("subE;","\x2AC5")+  ,("subedot;","\x2AC3")+  ,("submult;","\x2AC1")+  ,("subne;","\x228A")+  ,("subnE;","\x2ACB")+  ,("subplus;","\x2ABF")+  ,("subrarr;","\x2979")+  ,("subset;","\x2282")+  ,("Subset;","\x22D0")+  ,("subseteq;","\x2286")+  ,("subseteqq;","\x2AC5")+  ,("SubsetEqual;","\x2286")+  ,("subsetneq;","\x228A")+  ,("subsetneqq;","\x2ACB")+  ,("subsim;","\x2AC7")+  ,("subsub;","\x2AD5")+  ,("subsup;","\x2AD3")+  ,("succ;","\x227B")+  ,("succapprox;","\x2AB8")+  ,("succcurlyeq;","\x227D")+  ,("Succeeds;","\x227B")+  ,("SucceedsEqual;","\x2AB0")+  ,("SucceedsSlantEqual;","\x227D")+  ,("SucceedsTilde;","\x227F")+  ,("succeq;","\x2AB0")+  ,("succnapprox;","\x2ABA")+  ,("succneqq;","\x2AB6")+  ,("succnsim;","\x22E9")+  ,("succsim;","\x227F")+  ,("SuchThat;","\x220B")+  ,("Sum;","\x2211")+  ,("sum;","\x2211")+  ,("sung;","\x266A")+  ,("sup1","\x00B9")+  ,("sup1;","\x00B9")+  ,("sup2","\x00B2")+  ,("sup2;","\x00B2")+  ,("sup3","\x00B3")+  ,("sup3;","\x00B3")+  ,("sup;","\x2283")+  ,("Sup;","\x22D1")+  ,("supdot;","\x2ABE")+  ,("supdsub;","\x2AD8")+  ,("supe;","\x2287")+  ,("supE;","\x2AC6")+  ,("supedot;","\x2AC4")+  ,("Superset;","\x2283")+  ,("SupersetEqual;","\x2287")+  ,("suphsol;","\x27C9")+  ,("suphsub;","\x2AD7")+  ,("suplarr;","\x297B")+  ,("supmult;","\x2AC2")+  ,("supne;","\x228B")+  ,("supnE;","\x2ACC")+  ,("supplus;","\x2AC0")+  ,("supset;","\x2283")+  ,("Supset;","\x22D1")+  ,("supseteq;","\x2287")+  ,("supseteqq;","\x2AC6")+  ,("supsetneq;","\x228B")+  ,("supsetneqq;","\x2ACC")+  ,("supsim;","\x2AC8")+  ,("supsub;","\x2AD4")+  ,("supsup;","\x2AD6")+  ,("swarhk;","\x2926")+  ,("swarr;","\x2199")+  ,("swArr;","\x21D9")+  ,("swarrow;","\x2199")+  ,("swnwar;","\x292A")+  ,("szlig","\x00DF")+  ,("szlig;","\x00DF")+  ,("Tab;","\x0009")+  ,("target;","\x2316")+  ,("Tau;","\x03A4")+  ,("tau;","\x03C4")+  ,("tbrk;","\x23B4")+  ,("Tcaron;","\x0164")+  ,("tcaron;","\x0165")+  ,("Tcedil;","\x0162")+  ,("tcedil;","\x0163")+  ,("Tcy;","\x0422")+  ,("tcy;","\x0442")+  ,("tdot;","\x20DB")+  ,("telrec;","\x2315")+  ,("Tfr;","\xD835\xDD17")+  ,("tfr;","\xD835\xDD31")+  ,("there4;","\x2234")+  ,("Therefore;","\x2234")+  ,("therefore;","\x2234")+  ,("Theta;","\x0398")+  ,("theta;","\x03B8")+  ,("thetasym;","\x03D1")+  ,("thetav;","\x03D1")+  ,("thickapprox;","\x2248")+  ,("thicksim;","\x223C")+  ,("ThickSpace;","\x205F\x200A")+  ,("thinsp;","\x2009")+  ,("ThinSpace;","\x2009")+  ,("thkap;","\x2248")+  ,("thksim;","\x223C")+  ,("THORN","\x00DE")+  ,("thorn","\x00FE")+  ,("THORN;","\x00DE")+  ,("thorn;","\x00FE")+  ,("tilde;","\x02DC")+  ,("Tilde;","\x223C")+  ,("TildeEqual;","\x2243")+  ,("TildeFullEqual;","\x2245")+  ,("TildeTilde;","\x2248")+  ,("times","\x00D7")+  ,("times;","\x00D7")+  ,("timesb;","\x22A0")+  ,("timesbar;","\x2A31")+  ,("timesd;","\x2A30")+  ,("tint;","\x222D")+  ,("toea;","\x2928")+  ,("top;","\x22A4")+  ,("topbot;","\x2336")+  ,("topcir;","\x2AF1")+  ,("Topf;","\xD835\xDD4B")+  ,("topf;","\xD835\xDD65")+  ,("topfork;","\x2ADA")+  ,("tosa;","\x2929")+  ,("tprime;","\x2034")+  ,("TRADE;","\x2122")+  ,("trade;","\x2122")+  ,("triangle;","\x25B5")+  ,("triangledown;","\x25BF")+  ,("triangleleft;","\x25C3")+  ,("trianglelefteq;","\x22B4")+  ,("triangleq;","\x225C")+  ,("triangleright;","\x25B9")+  ,("trianglerighteq;","\x22B5")+  ,("tridot;","\x25EC")+  ,("trie;","\x225C")+  ,("triminus;","\x2A3A")+  ,("TripleDot;","\x20DB")+  ,("triplus;","\x2A39")+  ,("trisb;","\x29CD")+  ,("tritime;","\x2A3B")+  ,("trpezium;","\x23E2")+  ,("Tscr;","\xD835\xDCAF")+  ,("tscr;","\xD835\xDCC9")+  ,("TScy;","\x0426")+  ,("tscy;","\x0446")+  ,("TSHcy;","\x040B")+  ,("tshcy;","\x045B")+  ,("Tstrok;","\x0166")+  ,("tstrok;","\x0167")+  ,("twixt;","\x226C")+  ,("twoheadleftarrow;","\x219E")+  ,("twoheadrightarrow;","\x21A0")+  ,("Uacute","\x00DA")+  ,("uacute","\x00FA")+  ,("Uacute;","\x00DA")+  ,("uacute;","\x00FA")+  ,("uarr;","\x2191")+  ,("Uarr;","\x219F")+  ,("uArr;","\x21D1")+  ,("Uarrocir;","\x2949")+  ,("Ubrcy;","\x040E")+  ,("ubrcy;","\x045E")+  ,("Ubreve;","\x016C")+  ,("ubreve;","\x016D")+  ,("Ucirc","\x00DB")+  ,("ucirc","\x00FB")+  ,("Ucirc;","\x00DB")+  ,("ucirc;","\x00FB")+  ,("Ucy;","\x0423")+  ,("ucy;","\x0443")+  ,("udarr;","\x21C5")+  ,("Udblac;","\x0170")+  ,("udblac;","\x0171")+  ,("udhar;","\x296E")+  ,("ufisht;","\x297E")+  ,("Ufr;","\xD835\xDD18")+  ,("ufr;","\xD835\xDD32")+  ,("Ugrave","\x00D9")+  ,("ugrave","\x00F9")+  ,("Ugrave;","\x00D9")+  ,("ugrave;","\x00F9")+  ,("uHar;","\x2963")+  ,("uharl;","\x21BF")+  ,("uharr;","\x21BE")+  ,("uhblk;","\x2580")+  ,("ulcorn;","\x231C")+  ,("ulcorner;","\x231C")+  ,("ulcrop;","\x230F")+  ,("ultri;","\x25F8")+  ,("Umacr;","\x016A")+  ,("umacr;","\x016B")+  ,("uml","\x00A8")+  ,("uml;","\x00A8")+  ,("UnderBar;","\x005F")+  ,("UnderBrace;","\x23DF")+  ,("UnderBracket;","\x23B5")+  ,("UnderParenthesis;","\x23DD")+  ,("Union;","\x22C3")+  ,("UnionPlus;","\x228E")+  ,("Uogon;","\x0172")+  ,("uogon;","\x0173")+  ,("Uopf;","\xD835\xDD4C")+  ,("uopf;","\xD835\xDD66")+  ,("UpArrow;","\x2191")+  ,("uparrow;","\x2191")+  ,("Uparrow;","\x21D1")+  ,("UpArrowBar;","\x2912")+  ,("UpArrowDownArrow;","\x21C5")+  ,("UpDownArrow;","\x2195")+  ,("updownarrow;","\x2195")+  ,("Updownarrow;","\x21D5")+  ,("UpEquilibrium;","\x296E")+  ,("upharpoonleft;","\x21BF")+  ,("upharpoonright;","\x21BE")+  ,("uplus;","\x228E")+  ,("UpperLeftArrow;","\x2196")+  ,("UpperRightArrow;","\x2197")+  ,("upsi;","\x03C5")+  ,("Upsi;","\x03D2")+  ,("upsih;","\x03D2")+  ,("Upsilon;","\x03A5")+  ,("upsilon;","\x03C5")+  ,("UpTee;","\x22A5")+  ,("UpTeeArrow;","\x21A5")+  ,("upuparrows;","\x21C8")+  ,("urcorn;","\x231D")+  ,("urcorner;","\x231D")+  ,("urcrop;","\x230E")+  ,("Uring;","\x016E")+  ,("uring;","\x016F")+  ,("urtri;","\x25F9")+  ,("Uscr;","\xD835\xDCB0")+  ,("uscr;","\xD835\xDCCA")+  ,("utdot;","\x22F0")+  ,("Utilde;","\x0168")+  ,("utilde;","\x0169")+  ,("utri;","\x25B5")+  ,("utrif;","\x25B4")+  ,("uuarr;","\x21C8")+  ,("Uuml","\x00DC")+  ,("uuml","\x00FC")+  ,("Uuml;","\x00DC")+  ,("uuml;","\x00FC")+  ,("uwangle;","\x29A7")+  ,("vangrt;","\x299C")+  ,("varepsilon;","\x03F5")+  ,("varkappa;","\x03F0")+  ,("varnothing;","\x2205")+  ,("varphi;","\x03D5")+  ,("varpi;","\x03D6")+  ,("varpropto;","\x221D")+  ,("varr;","\x2195")+  ,("vArr;","\x21D5")+  ,("varrho;","\x03F1")+  ,("varsigma;","\x03C2")+  ,("varsubsetneq;","\x228A\xFE00")+  ,("varsubsetneqq;","\x2ACB\xFE00")+  ,("varsupsetneq;","\x228B\xFE00")+  ,("varsupsetneqq;","\x2ACC\xFE00")+  ,("vartheta;","\x03D1")+  ,("vartriangleleft;","\x22B2")+  ,("vartriangleright;","\x22B3")+  ,("vBar;","\x2AE8")+  ,("Vbar;","\x2AEB")+  ,("vBarv;","\x2AE9")+  ,("Vcy;","\x0412")+  ,("vcy;","\x0432")+  ,("vdash;","\x22A2")+  ,("vDash;","\x22A8")+  ,("Vdash;","\x22A9")+  ,("VDash;","\x22AB")+  ,("Vdashl;","\x2AE6")+  ,("vee;","\x2228")+  ,("Vee;","\x22C1")+  ,("veebar;","\x22BB")+  ,("veeeq;","\x225A")+  ,("vellip;","\x22EE")+  ,("verbar;","\x007C")+  ,("Verbar;","\x2016")+  ,("vert;","\x007C")+  ,("Vert;","\x2016")+  ,("VerticalBar;","\x2223")+  ,("VerticalLine;","\x007C")+  ,("VerticalSeparator;","\x2758")+  ,("VerticalTilde;","\x2240")+  ,("VeryThinSpace;","\x200A")+  ,("Vfr;","\xD835\xDD19")+  ,("vfr;","\xD835\xDD33")+  ,("vltri;","\x22B2")+  ,("vnsub;","\x2282\x20D2")+  ,("vnsup;","\x2283\x20D2")+  ,("Vopf;","\xD835\xDD4D")+  ,("vopf;","\xD835\xDD67")+  ,("vprop;","\x221D")+  ,("vrtri;","\x22B3")+  ,("Vscr;","\xD835\xDCB1")+  ,("vscr;","\xD835\xDCCB")+  ,("vsubne;","\x228A\xFE00")+  ,("vsubnE;","\x2ACB\xFE00")+  ,("vsupne;","\x228B\xFE00")+  ,("vsupnE;","\x2ACC\xFE00")+  ,("Vvdash;","\x22AA")+  ,("vzigzag;","\x299A")+  ,("Wcirc;","\x0174")+  ,("wcirc;","\x0175")+  ,("wedbar;","\x2A5F")+  ,("wedge;","\x2227")+  ,("Wedge;","\x22C0")+  ,("wedgeq;","\x2259")+  ,("weierp;","\x2118")+  ,("Wfr;","\xD835\xDD1A")+  ,("wfr;","\xD835\xDD34")+  ,("Wopf;","\xD835\xDD4E")+  ,("wopf;","\xD835\xDD68")+  ,("wp;","\x2118")+  ,("wr;","\x2240")+  ,("wreath;","\x2240")+  ,("Wscr;","\xD835\xDCB2")+  ,("wscr;","\xD835\xDCCC")+  ,("xcap;","\x22C2")+  ,("xcirc;","\x25EF")+  ,("xcup;","\x22C3")+  ,("xdtri;","\x25BD")+  ,("Xfr;","\xD835\xDD1B")+  ,("xfr;","\xD835\xDD35")+  ,("xharr;","\x27F7")+  ,("xhArr;","\x27FA")+  ,("Xi;","\x039E")+  ,("xi;","\x03BE")+  ,("xlarr;","\x27F5")+  ,("xlArr;","\x27F8")+  ,("xmap;","\x27FC")+  ,("xnis;","\x22FB")+  ,("xodot;","\x2A00")+  ,("Xopf;","\xD835\xDD4F")+  ,("xopf;","\xD835\xDD69")+  ,("xoplus;","\x2A01")+  ,("xotime;","\x2A02")+  ,("xrarr;","\x27F6")+  ,("xrArr;","\x27F9")+  ,("Xscr;","\xD835\xDCB3")+  ,("xscr;","\xD835\xDCCD")+  ,("xsqcup;","\x2A06")+  ,("xuplus;","\x2A04")+  ,("xutri;","\x25B3")+  ,("xvee;","\x22C1")+  ,("xwedge;","\x22C0")+  ,("Yacute","\x00DD")+  ,("yacute","\x00FD")+  ,("Yacute;","\x00DD")+  ,("yacute;","\x00FD")+  ,("YAcy;","\x042F")+  ,("yacy;","\x044F")+  ,("Ycirc;","\x0176")+  ,("ycirc;","\x0177")+  ,("Ycy;","\x042B")+  ,("ycy;","\x044B")+  ,("yen","\x00A5")+  ,("yen;","\x00A5")+  ,("Yfr;","\xD835\xDD1C")+  ,("yfr;","\xD835\xDD36")+  ,("YIcy;","\x0407")+  ,("yicy;","\x0457")+  ,("Yopf;","\xD835\xDD50")+  ,("yopf;","\xD835\xDD6A")+  ,("Yscr;","\xD835\xDCB4")+  ,("yscr;","\xD835\xDCCE")+  ,("YUcy;","\x042E")+  ,("yucy;","\x044E")+  ,("yuml","\x00FF")+  ,("yuml;","\x00FF")+  ,("Yuml;","\x0178")+  ,("Zacute;","\x0179")+  ,("zacute;","\x017A")+  ,("Zcaron;","\x017D")+  ,("zcaron;","\x017E")+  ,("Zcy;","\x0417")+  ,("zcy;","\x0437")+  ,("Zdot;","\x017B")+  ,("zdot;","\x017C")+  ,("zeetrf;","\x2128")+  ,("ZeroWidthSpace;","\x200B")+  ,("Zeta;","\x0396")+  ,("zeta;","\x03B6")+  ,("Zfr;","\x2128")+  ,("zfr;","\xD835\xDD37")+  ,("ZHcy;","\x0416")+  ,("zhcy;","\x0436")+  ,("zigrarr;","\x21DD")+  ,("Zopf;","\x2124")+  ,("zopf;","\xD835\xDD6B")+  ,("Zscr;","\xD835\xDCB5")+  ,("zscr;","\xD835\xDCCF")+  ,("zwj;","\x200D")+  ,("zwnj;","\x200C")]
+ src/Zenacy/HTML/Internal/Filter.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Filters and transforms for HTML trees.+module Zenacy.HTML.Internal.Filter+  ( htmlSpaceRemove+  ) where++import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.HTML+import Zenacy.HTML.Internal.Oper+import Data.Maybe+  ( mapMaybe+  )++-- | Removes whitespace and comments from an HTML structure.+-- Document elements are not accepted, and only non-empty text nodes+-- and element nodes are kept. @pre@, @code@, @samp@, and @kdb@ elements+-- are passed without modification, since whitespace is typically+-- significant in those elements.+htmlSpaceRemove :: HTMLNode -> Maybe HTMLNode+htmlSpaceRemove = go+  where+    go x = case x of+      HTMLText {}+        | htmlTextSpace x ->+            Nothing+        | otherwise ->+            Just x+      HTMLElement n s a c+        | n == "pre" || n == "code" || n == "samp" || n == "kbd" ->+            Just x+        | otherwise ->+            Just $ HTMLElement n s a $ mapMaybe go c+      _otherwise ->+        Nothing
+ src/Zenacy/HTML/Internal/HTML.hs view
@@ -0,0 +1,284 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines the top-level HTML types and parser functions.+module Zenacy.HTML.Internal.HTML+  ( HTMLOptions(..)+  , HTMLResult(..)+  , HTMLError(..)+  , HTMLNode(..)+  , HTMLAttr(..)+  , HTMLNamespace(..)+  , HTMLAttrNamespace(..)+  , htmlParse+  , htmlParseEasy+  , htmlFragment+  , htmlDefaultDocument+  , htmlDefaultDoctype+  , htmlDefaultFragment+  , htmlDefaultElement+  , htmlDefaultTemplate+  , htmlDefaultText+  , htmlDefaultComment+  , htmlAttr+  , htmlElem+  , htmlText+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.DOM+import Zenacy.HTML.Internal.Parser+import Zenacy.HTML.Internal.Types+import Data.Default+  ( Default(..)+  )+import Data.Either+  ( either+  )+import Data.Foldable+  ( toList+  )+import Data.Maybe+  ( fromJust+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( empty+  )+import qualified Data.Text.Encoding as T+  ( encodeUtf8+  , decodeUtf8+  )++-- | Defines options for the HTML parser.+data HTMLOptions = HTMLOptions+  { htmlOptionLogErrors      :: !Bool+    -- ^ Indicates that errors should be logged.+  , htmlOptionIgnoreEntities :: !Bool+    -- ^ Indicates that entities should not be decoded.+  } deriving (Eq, Ord, Show)++-- | Defines an HTML parser result.+data HTMLResult = HTMLResult+  { htmlResultDocument :: !HTMLNode+    -- ^ The parsed document structure.+  , htmlResultErrors   :: ![HTMLError]+    -- ^ The errors logged while parsing if error logging was enabled.+  } deriving (Eq, Ord, Show)++-- | An HTML error type.+data HTMLError = HTMLError+  { htmlErrorText  :: !Text+    -- ^ The error message.+  } deriving (Show, Eq, Ord)++-- | Defines the model type for an HTML document.+data HTMLNode+  = HTMLDocument+    { htmlDocumentName       :: !Text           -- ^ The document name.+    , htmlDocumentChildren   :: ![HTMLNode]     -- ^ The document children.+    }+  | HTMLDoctype+    { htmlDoctypeName        :: !Text           -- ^ The DOCTYPE name.+    , htmlDoctypePublicID    :: !(Maybe Text)   -- ^ The public ID.+    , htmlDoctypeSystemID    :: !(Maybe Text)   -- ^ The system ID.+    }+  | HTMLFragment+    { htmlFragmentName       :: !Text           -- ^ The fragment name.+    , htmlFragmentChildren   :: ![HTMLNode]     -- ^ The fragment children.+    }+  | HTMLElement+    { htmlElementName        :: !Text           -- ^ The element name.+    , htmlElementNamespace   :: !HTMLNamespace  -- ^ The element namespace.+    , htmlElementAttributes  :: ![HTMLAttr]     -- ^ The element attributes.+    , htmlElementChildren    :: ![HTMLNode]     -- ^ The element children.+    }+  | HTMLTemplate+    { htmlTemplateNamespace  :: !HTMLNamespace  -- ^ The template namespace.+    , htmlTemplateAttributes :: ![HTMLAttr]     -- ^ The template attributes.+    , htmlTemplateContents   :: !HTMLNode       -- ^ The template contents.+    }+  | HTMLText+    { htmlTextData           :: !Text           -- ^ The text value.+    }+  | HTMLComment+    { htmlCommentData        :: !Text           -- ^ The comment text.+    }+    deriving (Eq, Ord, Show)++-- | An HTML element attribute type.+data HTMLAttr = HTMLAttr+  { htmlAttrName      :: Text+  , htmlAttrVal       :: Text+  , htmlAttrNamespace :: HTMLAttrNamespace+  } deriving (Eq, Ord, Show)++-- | Defines default options.+instance Default HTMLOptions where+  def = HTMLOptions+    { htmlOptionLogErrors      = False+    , htmlOptionIgnoreEntities = False+    }++-- | Defines a default result.+instance Default HTMLResult where+  def = HTMLResult+    { htmlResultDocument = htmlDefaultDocument+    , htmlResultErrors   = []+    }++-- | Defines a default error.+instance Default HTMLError where+  def = HTMLError+    { htmlErrorText = T.empty+    }++-- | Defines a default attribute.+instance Default HTMLAttr where+  def = HTMLAttr+    { htmlAttrName      = T.empty+    , htmlAttrVal       = T.empty+    , htmlAttrNamespace = HTMLAttrNamespaceNone+    }++-- | Parses an HTML document.+htmlParse :: HTMLOptions -> Text -> Either HTMLError HTMLResult+htmlParse HTMLOptions {..} x =+  case d of+    Right ParserResult {..} ->+      Right def+        { htmlResultDocument = domToHTML parserResultDOM+        , htmlResultErrors   = map f parserResultErrors+        }+    Left e ->+      Left (f e)+  where+    d = parseDocument def+      { parserOptionInput          = T.encodeUtf8 x+      , parserOptionLogErrors      = htmlOptionLogErrors+      , parserOptionIgnoreEntities = htmlOptionIgnoreEntities+      }+    f x = def { htmlErrorText = T.decodeUtf8 x }++-- | Parses an HTML document the easy way.+htmlParseEasy :: Text -> HTMLNode+htmlParseEasy =+  either (const htmlDefaultDocument) htmlResultDocument . htmlParse def++-- | Parses an HTML fragment.+htmlFragment :: HTMLOptions -> Text -> Either HTMLError HTMLResult+htmlFragment HTMLOptions {..} x = Left def+  { htmlErrorText = "fragment support not currently implemented" }++-- | Defines a default document.+htmlDefaultDocument :: HTMLNode+htmlDefaultDocument = HTMLDocument+  { htmlDocumentName     = T.empty+  , htmlDocumentChildren = []+  }++-- | Defines a default document type.+htmlDefaultDoctype :: HTMLNode+htmlDefaultDoctype = HTMLDoctype+  { htmlDoctypeName     = T.empty+  , htmlDoctypePublicID = Nothing+  , htmlDoctypeSystemID = Nothing+  }++-- | Defines a default document fragment.+htmlDefaultFragment :: HTMLNode+htmlDefaultFragment = HTMLFragment+  { htmlFragmentName     = T.empty+  , htmlFragmentChildren = []+  }++-- | Defines a default element.+htmlDefaultElement :: HTMLNode+htmlDefaultElement = HTMLElement+  { htmlElementName       = T.empty+  , htmlElementNamespace  = HTMLNamespaceHTML+  , htmlElementAttributes = []+  , htmlElementChildren   = []+  }++-- | Defines a default template.+htmlDefaultTemplate :: HTMLNode+htmlDefaultTemplate = HTMLTemplate+  { htmlTemplateNamespace  = HTMLNamespaceHTML+  , htmlTemplateAttributes = []+  , htmlTemplateContents   = htmlDefaultFragment+  }++-- | Defines a default text.+htmlDefaultText :: HTMLNode+htmlDefaultText = HTMLText+  { htmlTextData = T.empty+  }++-- | Defines a default comment.+htmlDefaultComment :: HTMLNode+htmlDefaultComment = HTMLComment+  { htmlCommentData = T.empty+  }++-- | Makes an attribute.+htmlAttr :: Text -> Text -> HTMLAttr+htmlAttr n v = HTMLAttr n v HTMLAttrNamespaceNone++-- | Makes an element.+htmlElem :: Text -> [HTMLAttr] -> [HTMLNode] -> HTMLNode+htmlElem n a c = HTMLElement n HTMLNamespaceHTML a c++-- | Makes a text node.+htmlText :: Text -> HTMLNode+htmlText = HTMLText++-- | Converts a DOM document to an HTML document.+domToHTML :: DOM -> HTMLNode+domToHTML d = nodeToHTML d $ domDocument d++-- | Converts a DOM node to an HTML node.+nodeToHTML :: DOM -> DOMNode -> HTMLNode+nodeToHTML d = go where+  go DOMDocument {..} = HTMLDocument+    { htmlDocumentName     = t domDocumentName+    , htmlDocumentChildren = f domDocumentChildren+    }+  go DOMDoctype {..} = HTMLDoctype+    { htmlDoctypeName     = t domDoctypeName+    , htmlDoctypePublicID = t <$> domDoctypePublicID+    , htmlDoctypeSystemID = t <$> domDoctypeSystemID+    }+  go DOMFragment {..} = HTMLFragment+    { htmlFragmentName     = t domFragmentName+    , htmlFragmentChildren = f domFragmentChildren+    }+  go DOMElement {..} = HTMLElement+    { htmlElementName       = t domElementName+    , htmlElementNamespace  = domElementNamespace+    , htmlElementAttributes = h domElementAttributes+    , htmlElementChildren   = f domElementChildren+    }+  go DOMTemplate {..} = HTMLTemplate+    { htmlTemplateNamespace  = domTemplateNamespace+    , htmlTemplateAttributes = h domTemplateAttributes+    , htmlTemplateContents   = g domTemplateContents+    }+  go DOMText {..} = HTMLText+    { htmlTextData = t domTextData+    }+  go DOMComment {..} = HTMLComment+    { htmlCommentData = t domCommentData+    }+  f = map go . domMapID d . toList+  g = go . fromJust . domGetNode d+  h = map attr . toList+  t = T.decodeUtf8+  attr (DOMAttr n v s) = HTMLAttr (t n) (t v) s
+ src/Zenacy/HTML/Internal/Image.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines html image handling functions.+module Zenacy.HTML.Internal.Image+  ( HTMLSrcset(..)+  , HTMLSrcsetCandidate(..)+  , HTMLSrcsetDescriptor(..)+  , htmlSrcsetParse+  , htmlSrcsetParseCandidate+  , htmlSrcsetParseDescriptor+  , htmlSrcsetRender+  , htmlSrcsetRenderCandidate+  , htmlSrcsetRenderDescriptor+  , htmlSrcsetListURL+  , htmlSrcsetMapURL+  , htmlSrcsetImageMin+  , htmlSrcsetImageMax+  , htmlSrcsetDescriptorSize+  , htmlSrcsetCandidatePair+  , htmlSrcsetFilter+  ) where++import Zenacy.HTML.Internal.Core+import Control.Applicative+  ( (<|>)+  )+import qualified Data.IntMap as IntMap+  ( findMax+  , findMin+  , fromList+  )+import Data.Maybe+  ( catMaybes+  , fromJust+  )+import Data.Monoid+  ( (<>)+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( empty+  , intercalate+  , null+  , pack+  , splitOn+  , stripSuffix+  , words+  , unwords+  )++-- | Defines a srcset attribute value.+data HTMLSrcset = HTMLSrcset+  { htmlSrcsetCandidates :: ![HTMLSrcsetCandidate]+  } deriving (Show, Eq, Ord)++-- | Defines the image candidates.+data HTMLSrcsetCandidate = HTMLSrcsetCandidate+  { htmlSrcsetURL        :: !Text+  , htmlSrcsetDescriptor :: !HTMLSrcsetDescriptor+  } deriving (Show, Eq, Ord)++-- | Defines the srcset descriptor.+data HTMLSrcsetDescriptor+  = HTMLSrcsetWidth Int+  | HTMLSrcsetPixel Int+  | HTMLSrcsetNone+    deriving (Show, Eq, Ord)++-- | Parses a srcset attribute value.+htmlSrcsetParse :: Text -> HTMLSrcset+htmlSrcsetParse =+  ( HTMLSrcset+  . catMaybes+  . map htmlSrcsetParseCandidate+  . T.splitOn ","+  )++-- | Parses a srcset candidate value.+htmlSrcsetParseCandidate :: Text -> Maybe HTMLSrcsetCandidate+htmlSrcsetParseCandidate x =+  case T.words x of+    (u:d:[])   -> Just $ HTMLSrcsetCandidate u $ htmlSrcsetParseDescriptor d+    (u:[])     -> Just $ HTMLSrcsetCandidate u HTMLSrcsetNone+    _otherwise -> Nothing++-- | Parses a srcset descriptor value.+htmlSrcsetParseDescriptor :: Text -> HTMLSrcsetDescriptor+htmlSrcsetParseDescriptor x = fromJust $+  (HTMLSrcsetWidth <$> f "w")+  <|> (HTMLSrcsetPixel <$> f "x")+  <|> (Just HTMLSrcsetNone)+  where+    f s = T.stripSuffix s x >>= textReadDec++-- | Renders a srcset.+htmlSrcsetRender :: HTMLSrcset -> Text+htmlSrcsetRender =+  ( T.intercalate ","+  . map htmlSrcsetRenderCandidate+  . htmlSrcsetCandidates+  )++-- | Renders a srcset candidate.+htmlSrcsetRenderCandidate :: HTMLSrcsetCandidate -> Text+htmlSrcsetRenderCandidate (HTMLSrcsetCandidate u d) =+  T.unwords . filter (not . T.null) $ [ u, htmlSrcsetRenderDescriptor d ]++-- | Renders a srcset descriptor.+htmlSrcsetRenderDescriptor :: HTMLSrcsetDescriptor -> Text+htmlSrcsetRenderDescriptor = \case+  HTMLSrcsetWidth x -> T.pack $ show x <> "w"+  HTMLSrcsetPixel x -> T.pack $ show x <> "x"+  HTMLSrcsetNone -> T.empty++-- | Returns the URLs for a srcset.+htmlSrcsetListURL :: HTMLSrcset -> [Text]+htmlSrcsetListURL (HTMLSrcset c) =+  filter (not . T.null) $ map htmlSrcsetURL c++-- | Maps a function over the srcset URLs.+htmlSrcsetMapURL :: (Text -> Text) -> HTMLSrcset -> HTMLSrcset+htmlSrcsetMapURL f (HTMLSrcset c) = HTMLSrcset $ map g c+  where+    g (HTMLSrcsetCandidate u d) = HTMLSrcsetCandidate (f u) d++-- | Returns the smallest image in the srcset.+htmlSrcsetImageMin :: HTMLSrcset -> Text+htmlSrcsetImageMin (HTMLSrcset c) =+  ( snd+  . IntMap.findMin+  . IntMap.fromList+  . map htmlSrcsetCandidatePair+  ) c++-- | Returns the largest image in the srcset.+htmlSrcsetImageMax :: HTMLSrcset -> Text+htmlSrcsetImageMax (HTMLSrcset c) =+  ( snd+  . IntMap.findMax+  . IntMap.fromList+  . map htmlSrcsetCandidatePair+  ) c++-- | Gets the size of the descriptor.+htmlSrcsetDescriptorSize :: HTMLSrcsetDescriptor -> Int+htmlSrcsetDescriptorSize = \case+  HTMLSrcsetWidth x -> x+  HTMLSrcsetPixel x -> x+  HTMLSrcsetNone -> 1++-- | Converts a candidate to a pair.+htmlSrcsetCandidatePair :: HTMLSrcsetCandidate -> (Int, Text)+htmlSrcsetCandidatePair (HTMLSrcsetCandidate u d) =+  (htmlSrcsetDescriptorSize d, u)++-- | Filter candidates from a srcset.+htmlSrcsetFilter :: (HTMLSrcsetCandidate -> Bool) -> HTMLSrcset -> HTMLSrcset+htmlSrcsetFilter f (HTMLSrcset c) = HTMLSrcset $ filter f c
+ src/Zenacy/HTML/Internal/Lexer.hs view
@@ -0,0 +1,2315 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | The HTML Lexer.+module Zenacy.HTML.Internal.Lexer+  ( Lexer(..)+  , LexerOptions(..)+  , LexerSkip(..)+  , lexerNew+  , lexerSetRCDATA+  , lexerSetRAWTEXT+  , lexerSetPLAINTEXT+  , lexerSetScriptData+  , lexerSkipNextLF+  , lexerNext+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Buffer+import Zenacy.HTML.Internal.Char+import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.Entity+import Zenacy.HTML.Internal.Token+import Control.Monad+  ( forM+  , forM_+  , mapM+  , when+  )+import Control.Monad.Extra+  ( whenM+  , whenJust+  )+import Control.Monad.ST+  ( ST+  )+import Data.STRef+  ( STRef+  , newSTRef+  )+import Data.DList+  ( DList+  )+import qualified Data.DList as D+  ( empty+  , snoc+  , toList+  )+import Data.Map+  ( Map+  )+import qualified Data.Map as Map+  ( fromList+  , lookup+  )+import Data.Maybe+  ( isJust+  )+import Data.Word+  ( Word8+  )+import Data.Default+  ( Default(..)+  )+import Data.Vector.Storable.Mutable+  ( MVector(..)+  )+import qualified Data.Vector.Storable.Mutable as U+  ( new+  , length+  , read+  , write+  , grow+  )++import Debug.Trace (trace)+++-- | Lexer options type.+data LexerOptions = LexerOptions+  { lexerOptionInput          :: BS+  -- ^ The input to the lexer.+  , lexerOptionLogErrors      :: Bool+  -- ^ Indicates whether errors are logged.+  , lexerOptionIgnoreEntities :: Bool+  -- ^ Indicates that entities should not be tokenized.+  } deriving (Show)++-- | Defines the skip mode.+data LexerSkip+  = LexerSkipNone+  | LexerSkipLF+    deriving (Eq, Ord, Show)++-- | Defines the lexer state.+data Lexer s = Lexer+  { lexerData     :: BS+  -- ^ The lexer data.+  , lexerIgnore   :: Bool+  -- ^ Flag to ignore entity processing.+  , lexerLog      :: Bool+  -- ^ Flag to log errors.+  , lexerOffset   :: STRef s Int+  -- ^ The offset in the data for the next word to read.+  , lexerToken    :: STRef s (TokenBuffer s)+  -- ^ The token buffer.+  , lexerBuffer   :: STRef s (Buffer s)+  -- ^ The buffer is used to accumulate characters during+  --   some types of character processing.+  , lexerLast     :: STRef s [Word8]+  -- ^ The last start tag name to have been emitted.+  , lexerState    :: STRef s LexerState+  -- ^ The current lexer state in some cases.+  , lexerReturn   :: STRef s LexerState+  -- ^ The state to return to after character reference processing.+  , lexerSkip     :: STRef s LexerSkip+  -- ^ The skip next linefeed flag.+  , lexerErrors   :: STRef s (DList BS)+  -- ^ The lexer errors.+  , lexerCode     :: STRef s Int+  -- ^ The character reference code.+  }++-- | Default instance for lexer options.+instance Default LexerOptions where+  def = LexerOptions+    { lexerOptionInput          = bsEmpty+    , lexerOptionLogErrors      = False+    , lexerOptionIgnoreEntities = False+    }++-- | Defines the lexer state.+data LexerState+  = StateData+  | StateRCDATA+  | StateRAWTEXT+  | StateScriptData+  | StatePLAINTEXT+  | StateTagOpen+  | StateEndTagOpen+  | StateTagName+  | StateRCDATALessThan+  | StateRCDATAEndTagOpen+  | StateRCDATAEndTagName+  | StateRAWTEXTLessThan+  | StateRAWTEXTEndTagOpen+  | StateRAWTEXTEndTagName+  | StateScriptDataLessThan+  | StateScriptDataEndTagOpen+  | StateScriptDataEndTagName+  | StateScriptDataEscapeStart+  | StateScriptDataEscapeStartDash+  | StateScriptDataEscaped+  | StateScriptDataEscapedDash+  | StateScriptDataEscapedDashDash+  | StateScriptDataEscapedLessThan+  | StateScriptDataEscapedEndTagOpen+  | StateScriptDataEscapedEndTagName+  | StateScriptDataDoubleEscapedStart+  | StateScriptDataDoubleEscaped+  | StateScriptDataDoubleEscapedDash+  | StateScriptDataDoubleEscapedDashDash+  | StateScriptDataDoubleEscapedLessThan+  | StateScriptDataDoubleEscapeEnd+  | StateBeforeAttrName+  | StateAttrName+  | StateAfterAttrName+  | StateBeforeAttrValue+  | StateAttrValueDoubleQuoted+  | StateAttrValueSingleQuoted+  | StateAttrValueUnquoted+  | StateAfterAttrValue+  | StateSelfClosingStartTag+  | StateBogusComment+  | StateMarkupDeclarationOpen+  | StateCommentStart+  | StateCommentStartDash+  | StateComment+  | StateCommentLessThan+  | StateCommentLessThanBang+  | StateCommentLessThanBangDash+  | StateCommentLessThanBangDashDash+  | StateCommentEndDash+  | StateCommentEnd+  | StateCommentEndBang+  | StateDoctype+  | StateBeforeDoctypeName+  | StateDoctypeName+  | StateAfterDoctypeName+  | StateAfterDoctypePublicKeyword+  | StateBeforeDoctypePublicId+  | StateDoctypePublicIdDoubleQuoted+  | StateDoctypePublicIdSingleQuoted+  | StateAfterDoctypePublicId+  | StateBetweenDoctypePublicAndSystem+  | StateAfterDoctypeSystemKeyword+  | StateBeforeDoctypeSystemId+  | StateDoctypeSystemIdDoubleQuoted+  | StateDoctypeSystemIdSingleQuoted+  | StateAfterDoctypeSystemId+  | StateBogusDoctype+  | StateCDATASection+  | StateCDATASectionBracket+  | StateCDATASectionEnd+  | StateCharacterReference+  | StateNamedCharacterReference+  | StateAmbiguousAmpersand+  | StateNumericCharacterReference+  | StateHexCharacterReferenceStart+  | StateDecimalCharacterReferenceStart+  | StateHexCharacterReference+  | StateDecimalCharacterReference+  | StateNumericCharacterReferenceEnd+    deriving (Show, Eq, Ord)++lexerDispatch :: LexerState -> Lexer s -> ST s ()+lexerDispatch = \case+  StateData ->+    doData+  StateRCDATA ->+    doRCDATA+  StateRAWTEXT ->+    doRAWTEXT+  StateScriptData ->+    doScriptData+  StatePLAINTEXT ->+    doPLAINTEXT+  StateTagOpen ->+    doTagOpen+  StateEndTagOpen ->+    doEndTagOpen+  StateTagName ->+    doTagName+  StateRCDATALessThan ->+    doRCDATALessThan+  StateRCDATAEndTagOpen ->+    doRCDATAEndTagOpen+  StateRCDATAEndTagName ->+    doRCDATAEndTagName+  StateRAWTEXTLessThan ->+    doRAWTEXTLessThan+  StateRAWTEXTEndTagOpen ->+    doRAWTEXTEndTagOpen+  StateRAWTEXTEndTagName ->+    doRAWTEXTEndTagName+  StateScriptDataLessThan ->+    doScriptDataLessThan+  StateScriptDataEndTagOpen ->+    doScriptDataEndTagOpen+  StateScriptDataEndTagName ->+    doScriptDataEndTagName+  StateScriptDataEscapeStart ->+    doScriptDataEscapeStart+  StateScriptDataEscapeStartDash ->+    doScriptDataEscapeStartDash+  StateScriptDataEscaped ->+    doScriptDataEscaped+  StateScriptDataEscapedDash ->+    doScriptDataEscapedDash+  StateScriptDataEscapedDashDash ->+    doScriptDataEscapedDashDash+  StateScriptDataEscapedLessThan ->+    doScriptDataEscapedLessThan+  StateScriptDataEscapedEndTagOpen ->+    doScriptDataEscapedEndTagOpen+  StateScriptDataEscapedEndTagName ->+    doScriptDataEscapedEndTagName+  StateScriptDataDoubleEscapedStart ->+    doScriptDataDoubleEscapedStart+  StateScriptDataDoubleEscaped ->+    doScriptDataDoubleEscaped+  StateScriptDataDoubleEscapedDash ->+    doScriptDataDoubleEscapedDash+  StateScriptDataDoubleEscapedDashDash ->+    doScriptDataDoubleEscapedDashDash+  StateScriptDataDoubleEscapedLessThan ->+    doScriptDataDoubleEscapedLessThan+  StateScriptDataDoubleEscapeEnd ->+    doScriptDataDoubleEscapeEnd+  StateBeforeAttrName ->+    doBeforeAttrName+  StateAttrName ->+    doAttrName+  StateAfterAttrName ->+    doAfterAttrName+  StateBeforeAttrValue ->+    doBeforeAttrValue+  StateAttrValueDoubleQuoted ->+    doAttrValueDoubleQuoted+  StateAttrValueSingleQuoted ->+    doAttrValueSingleQuoted+  StateAttrValueUnquoted ->+    doAttrValueUnquoted+  StateAfterAttrValue ->+    doAfterAttrValue+  StateSelfClosingStartTag ->+    doSelfClosingStartTag+  StateBogusComment ->+    doBogusComment+  StateMarkupDeclarationOpen ->+    doMarkupDeclarationOpen+  StateCommentStart ->+    doCommentStart+  StateCommentStartDash ->+    doCommentStartDash+  StateComment ->+    doComment+  StateCommentLessThan ->+    doCommentLessThan+  StateCommentLessThanBang ->+    doCommentLessThanBang+  StateCommentLessThanBangDash ->+    doCommentLessThanBangDash+  StateCommentLessThanBangDashDash ->+    doCommentLessThanBangDashDash+  StateCommentEndDash ->+    doCommentEndDash+  StateCommentEnd ->+    doCommentEnd+  StateCommentEndBang ->+    doCommentEndBang+  StateDoctype ->+    doDoctype+  StateBeforeDoctypeName ->+    doBeforeDoctypeName+  StateDoctypeName ->+    doDoctypeName+  StateAfterDoctypeName ->+    doAfterDoctypeName+  StateAfterDoctypePublicKeyword ->+    doAfterDoctypePublicKeyword+  StateBeforeDoctypePublicId ->+    doBeforeDoctypePublicId+  StateDoctypePublicIdDoubleQuoted ->+    doDoctypePublicIdDoubleQuoted+  StateDoctypePublicIdSingleQuoted ->+    doDoctypePublicIdSingleQuoted+  StateAfterDoctypePublicId ->+    doAfterDoctypePublicId+  StateBetweenDoctypePublicAndSystem ->+    doBetweenDoctypePublicAndSystem+  StateAfterDoctypeSystemKeyword ->+    doAfterDoctypeSystemKeyword+  StateBeforeDoctypeSystemId ->+    doBeforeDoctypeSystemId+  StateDoctypeSystemIdDoubleQuoted ->+    doDoctypeSystemIdDoubleQuoted+  StateDoctypeSystemIdSingleQuoted ->+    doDoctypeSystemIdSingleQuoted+  StateAfterDoctypeSystemId ->+    doAfterDoctypeSystemId+  StateBogusDoctype ->+    doBogusDoctype+  StateCDATASection ->+    doCDATASection+  StateCDATASectionBracket ->+    doCDATASectionBracket+  StateCDATASectionEnd ->+    doCDATASectionEnd+  StateCharacterReference ->+    doCharacterReference+  StateNamedCharacterReference ->+    doNamedCharacterReference+  StateAmbiguousAmpersand ->+    doAmbiguousAmpersand+  StateNumericCharacterReference ->+    doNumericCharacterReference+  StateHexCharacterReferenceStart ->+    doHexCharacterReferenceStart+  StateDecimalCharacterReferenceStart ->+    doDecimalCharacterReferenceStart+  StateHexCharacterReference ->+    doHexCharacterReference+  StateDecimalCharacterReference ->+    doDecimalCharacterReference+  StateNumericCharacterReferenceEnd ->+    doNumericCharacterReferenceEnd++-- | Makes a new lexer.+lexerNew :: LexerOptions -> ST s (Either BS (Lexer s))+lexerNew o@LexerOptions{..}+  | Just i <- bsElemIndex 0 lexerOptionInput =+      pure $ Left $ bsConcat [ "input contains null at ", bcPack $ show i ]+  | otherwise =+      Right <$> lexerMake o++-- | Makes a new lexer.+lexerMake :: LexerOptions -> ST s (Lexer s)+lexerMake LexerOptions{..} = do+  offset <- newSTRef 0+  state  <- newSTRef StateData+  ret    <- newSTRef StateData+  token  <- tokenBuffer+  buffer <- bufferNew+  last   <- newSTRef []+  skip   <- newSTRef LexerSkipNone+  errors <- newSTRef D.empty+  code   <- newSTRef 0+  pure $ Lexer+    { lexerData   = lexerOptionInput+    , lexerIgnore = lexerOptionIgnoreEntities+    , lexerLog    = lexerOptionLogErrors+    , lexerOffset = offset+    , lexerToken  = token+    , lexerBuffer = buffer+    , lexerLast   = last+    , lexerState  = state+    , lexerReturn = ret+    , lexerSkip   = skip+    , lexerErrors = errors+    , lexerCode   = code+    }++-- | Sets the RCDATA mode.+lexerSetRCDATA :: Lexer s -> ST s ()+lexerSetRCDATA Lexer{..} = wref lexerState StateRCDATA++-- | Sets the raw text mode.+lexerSetRAWTEXT :: Lexer s -> ST s ()+lexerSetRAWTEXT Lexer{..} = wref lexerState StateRAWTEXT++-- | Sets the plain text mode.+lexerSetPLAINTEXT :: Lexer s -> ST s ()+lexerSetPLAINTEXT Lexer{..} = wref lexerState StatePLAINTEXT++-- | Sets the script data mode.+lexerSetScriptData :: Lexer s -> ST s ()+lexerSetScriptData Lexer{..} = wref lexerState StateScriptData++-- | Sets the skip next linefeed flag.+lexerSkipNextLF :: Lexer s -> ST s ()+lexerSkipNextLF Lexer{..} = wref lexerSkip LexerSkipLF++-- | Gets the next token from a lexer.+lexerNext :: Lexer s -> ST s Token+lexerNext x @ Lexer {..} =+  skip+  where+    skip = do+      t <- next+      case t of+        TChar 0x10 ->+          rref lexerSkip >>= \case+            LexerSkipLF ->+              wref lexerSkip LexerSkipNone >> skip+            LexerSkipNone ->+              pure t+        _otherwise ->+          pure t++    next = do+      i <- tokenNext lexerToken+      if i == 0+         then do+           tokenReset lexerToken+           s <- rref lexerState+           lexerDispatch s x+           i <- tokenFirst lexerToken+           if i == 0+              then pure TEOF+              else tokenPack i lexerToken+         else do+           tokenPack i lexerToken++-- | Gets the next word from a lexer.+nextWord :: Lexer s -> ST s Word8+nextWord x @ Lexer {..} = do+  offset <- rref lexerOffset+  if | offset < bsLen lexerData -> do+         wref lexerOffset (offset + 1)+         pure $ bsIndex lexerData offset+     | otherwise ->+         pure chrEOF++-- | Gets the next word from a lexer without advancing.+peekWord :: Lexer s -> ST s Word8+peekWord x @ Lexer {..} = do+  offset <- rref lexerOffset+  if | offset < bsLen lexerData ->+         pure $ bsIndex lexerData offset+     | otherwise ->+         pure chrEOF++-- | Moves the lexer back one word.+backWord :: Lexer s -> ST s ()+backWord x @ Lexer {..} = uref lexerOffset (subtract 1)++-- | Skips the specified number of words.+skipWord :: Lexer s -> Int -> ST s ()+skipWord x @ Lexer {..} n = uref lexerOffset (+n)++-- | Gets an indexing function from the current lexer offset.+dataIndexer :: Lexer s -> ST s (Int -> Word8)+dataIndexer x @ Lexer {..} = do+  offset <- rref lexerOffset+  pure $ \i -> bsIndex lexerData (offset + i)++-- | Gets the remaining number of words.+dataRemain :: Lexer s -> ST s Int+dataRemain x @ Lexer {..} = do+  offset <- rref lexerOffset+  pure $ bsLen lexerData - offset++-- | Emits the last token in the token buffer.+emit :: Lexer s -> ST s ()+emit x @ Lexer {..} = do+  tokenTail lexerToken >>= flip tokenTagStartName lexerToken >>= \case+    Just a  -> wref lexerLast a+    Nothing -> pure ()++-- | Emits a character token.+emitChar :: Lexer s -> Word8 -> ST s ()+emitChar x @ Lexer {..} w = do+  tokenCharInit w lexerToken+  emit x++-- | Emits the characters in the buffer.+emitBuffer :: Lexer s -> ST s ()+emitBuffer x @ Lexer {..} = do+  bufferApply (emitChar x) lexerBuffer+  bufferReset lexerBuffer++-- | Sets the lexer state.+state :: Lexer s -> LexerState -> ST s ()+state x @ Lexer {..} = wref lexerState++-- | Sets the lexer return state.+returnSet :: Lexer s -> LexerState -> ST s ()+returnSet x @ Lexer {..} = wref lexerReturn++-- | Gets the lexer return state.+returnGet :: Lexer s -> ST s LexerState+returnGet x @ Lexer {..} = rref lexerReturn++-- | Switches to the return state.+returnState :: Lexer s -> ST s ()+returnState x = returnGet x >>= flip lexerDispatch x++-- | Handles parse errors.+parseError :: Lexer s -> BS -> ST s ()+parseError x @ Lexer {..} =+  when lexerLog . (uref lexerErrors . flip D.snoc)++-- | Determines if the current token is an appropriate end tag.+appropriateEndTag :: Lexer s -> ST s Bool+appropriateEndTag x @ Lexer {..} = do+  tokenTail lexerToken >>= flip tokenTagEndName lexerToken >>= \case+    Just a  -> (==a) <$> rref lexerLast+    Nothing -> pure False++-- | Determines if an attribute value is currently being consumed.+consumingAttibute :: Lexer s -> ST s Bool+consumingAttibute x @ Lexer {..} = do+  a <- returnGet x+  pure $ any (==a)+    [ StateAttrValueDoubleQuoted+    , StateAttrValueSingleQuoted+    , StateAttrValueUnquoted+    ]++-- | Flushes the code points stored in the buffer.+flushCodePoints :: Lexer s -> ST s ()+flushCodePoints x @ Lexer {..} = do+  a <- consumingAttibute x+  if | a -> do+         bufferApply (flip tokenAttrValAppend lexerToken) lexerBuffer+         bufferReset lexerBuffer+     | otherwise -> do+         emitBuffer x++-- 12.2.5.1 Data state+doData :: Lexer s -> ST s ()+doData x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrAmpersand -> do+         returnSet x StateData+         doCharacterReference x+     | c == chrLess -> do+         doTagOpen x+     | c == chrEOF -> do+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doData x++-- 12.2.5.2 RCDATA state+doRCDATA :: Lexer s -> ST s ()+doRCDATA x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrAmpersand -> do+         returnSet x StateRCDATA+         doCharacterReference x+     | c == chrLess -> do+         doRCDATALessThan x+     | c == chrEOF -> do+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doRCDATA x++-- 12.2.5.3 RAWTEXT state+doRAWTEXT :: Lexer s -> ST s ()+doRAWTEXT x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrLess -> do+         doRAWTEXTLessThan x+     | c == chrEOF -> do+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doRAWTEXT x++-- 12.2.5.4 Script data state+doScriptData :: Lexer s -> ST s ()+doScriptData x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrLess -> do+         doScriptDataLessThan x+     | c == chrEOF -> do+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doScriptData x++-- 12.2.5.5 PLAINTEXT state+doPLAINTEXT :: Lexer s -> ST s ()+doPLAINTEXT x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrEOF -> do+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doPLAINTEXT x++-- 12.2.5.6 Tag open state+doTagOpen :: Lexer s -> ST s ()+doTagOpen x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrExclamation -> do+         doMarkupDeclarationOpen x+     | c == chrSolidus -> do+         doEndTagOpen x+     | chrASCIIAlpha c -> do+         tokenTagStartInit lexerToken+         backWord x+         doTagName x+     | c == chrQuestion -> do+         parseError x "unexpected-question-mark-instead-of-tag-name"+         tokenCommentInit lexerToken+         backWord x+         doBogusComment x+     | c == chrEOF -> do+         parseError x "eof-before-tag-name"+         tokenCharInit chrLess lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "invalid-first-character-of-tag-name"+         backWord x+         doData x++-- 12.2.5.7 End tag open state+doEndTagOpen :: Lexer s -> ST s ()+doEndTagOpen x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIAlpha c -> do+         tokenTagEndInit lexerToken+         backWord x+         doTagName x+     | c == chrGreater -> do+         parseError x "missing-end-tag-name"+         doData x+     | c == chrEOF -> do+         parseError x "eof-before-tag-name"+         tokenCharInit chrLess lexerToken+         tokenCharInit chrSolidus lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "invalid-first-character-of-tag-name"+         tokenCommentInit lexerToken+         backWord x+         doBogusComment x++-- 12.2.5.8 Tag name state+doTagName :: Lexer s -> ST s ()+doTagName x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeAttrName x+     | c == chrSolidus -> do+         doSelfClosingStartTag x+     | c == chrGreater -> do+         state x StateData+         emit x+     | chrASCIIUpperAlpha c -> do+         tokenTagNameAppend (chrToLower c) lexerToken+         doTagName x+     | c == chrEOF -> do+         parseError x "eof-in-tag"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenTagNameAppend c lexerToken+         doTagName x++-- 12.2.5.9 RCDATA less-than sign state+doRCDATALessThan :: Lexer s -> ST s ()+doRCDATALessThan x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrSolidus -> do+         bufferReset lexerBuffer+         doRCDATAEndTagOpen x+     | otherwise -> do+         tokenCharInit chrLess lexerToken+         backWord x+         doRCDATA x++-- 12.2.5.10 RCDATA end tag open state+doRCDATAEndTagOpen :: Lexer s -> ST s ()+doRCDATAEndTagOpen x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIAlpha c -> do+         tokenTagEndInit lexerToken+         backWord x+         doRCDATAEndTagName x+     | otherwise -> do+         tokenCharInit chrLess lexerToken+         tokenCharInit chrSolidus lexerToken+         backWord x+         doRCDATA x++-- 12.2.5.11 RCDATA end tag name state+doRCDATAEndTagName :: Lexer s -> ST s ()+doRCDATAEndTagName x @ Lexer {..} = do+  c <- nextWord x+  a <- appropriateEndTag x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         if a+         then do+           doBeforeAttrName x+         else do+           anythingElse+     | c == chrSolidus -> do+         if a+         then do+           doSelfClosingStartTag x+         else do+           anythingElse+     | c == chrGreater -> do+         if a+         then do+           state x StateData+           emit x+         else do+           anythingElse+     | chrASCIIUpperAlpha c -> do+         tokenTagNameAppend (chrToLower c) lexerToken+         bufferAppend c lexerBuffer+         doRCDATAEndTagName x+     | chrASCIILowerAlpha c -> do+         tokenTagNameAppend c lexerToken+         bufferAppend c lexerBuffer+         doRCDATAEndTagName x+     | otherwise -> do+         anythingElse+  where+    anythingElse = do+      tokenDrop lexerToken+      emitChar x chrLess+      emitChar x chrSolidus+      emitBuffer x+      backWord x+      doRCDATA x++-- 12.2.5.12 RAWTEXT less-than sign state+doRAWTEXTLessThan :: Lexer s -> ST s ()+doRAWTEXTLessThan x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrSolidus -> do+         bufferReset lexerBuffer+         doRAWTEXTEndTagOpen x+     | otherwise -> do+         tokenCharInit chrLess lexerToken+         backWord x+         doRAWTEXT x++-- 12.2.5.13 RAWTEXT end tag open state+doRAWTEXTEndTagOpen :: Lexer s -> ST s ()+doRAWTEXTEndTagOpen x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIAlpha c -> do+         tokenTagEndInit lexerToken+         backWord x+         doRAWTEXTEndTagName x+     | otherwise -> do+         emitChar x chrLess+         emitChar x chrSolidus+         backWord x+         doRAWTEXT x++-- 12.2.5.14 RAWTEXT end tag name state+doRAWTEXTEndTagName :: Lexer s -> ST s ()+doRAWTEXTEndTagName x @ Lexer {..} = do+  c <- nextWord x+  a <- appropriateEndTag x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         if a+         then do+           doBeforeAttrName x+         else do+           anythingElse+     | c == chrSolidus -> do+         if a+         then do+           doSelfClosingStartTag x+         else do+           anythingElse+     | c == chrGreater -> do+         if a+         then do+           state x StateData+           emit x+         else do+           anythingElse+     | chrASCIIUpperAlpha c -> do+         tokenTagNameAppend (chrToLower c) lexerToken+         bufferAppend c lexerBuffer+         doRAWTEXTEndTagName x+     | chrASCIILowerAlpha c -> do+         tokenTagNameAppend c lexerToken+         bufferAppend c lexerBuffer+         doRAWTEXTEndTagName x+     | otherwise -> do+         anythingElse+  where+    anythingElse = do+      tokenDrop lexerToken+      emitChar x chrLess+      emitChar x chrSolidus+      emitBuffer x+      backWord x+      doRAWTEXT x++-- 12.2.5.15 Script data less-than sign state+doScriptDataLessThan :: Lexer s -> ST s ()+doScriptDataLessThan x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrSolidus -> do+         bufferReset lexerBuffer+         doScriptDataEndTagOpen x+     | c == chrExclamation -> do+         tokenCharInit chrLess lexerToken+         tokenCharInit chrExclamation lexerToken+         doScriptDataEscapeStart x+     | otherwise -> do+         tokenCharInit chrLess lexerToken+         backWord x+         doScriptData x++-- 12.2.5.16 Script data end tag open state+doScriptDataEndTagOpen :: Lexer s -> ST s ()+doScriptDataEndTagOpen x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIAlpha c -> do+         tokenTagEndInit lexerToken+         backWord x+         doScriptDataEndTagName x+     | otherwise -> do+         emitChar x chrLess+         emitChar x chrSolidus+         backWord x+         doScriptData x++-- 12.2.5.17 Script data end tag name state+doScriptDataEndTagName :: Lexer s -> ST s ()+doScriptDataEndTagName x @ Lexer {..} = do+  c <- nextWord x+  a <- appropriateEndTag x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         if a+         then do+           doBeforeAttrName x+         else do+           anythingElse+     | c == chrSolidus -> do+         if a+         then do+           doSelfClosingStartTag x+         else do+           anythingElse+     | c == chrGreater -> do+         if a+         then do+           state x StateData+           emit x+         else do+           anythingElse+     | chrASCIIUpperAlpha c -> do+         tokenTagNameAppend (chrToLower c) lexerToken+         bufferAppend c lexerBuffer+         doScriptDataEndTagName x+     | chrASCIILowerAlpha c -> do+         tokenTagNameAppend c lexerToken+         bufferAppend c lexerBuffer+         doScriptDataEndTagName x+     | otherwise -> do+         anythingElse+  where+    anythingElse = do+      tokenDrop lexerToken+      emitChar x chrLess+      emitChar x chrSolidus+      emitBuffer x+      backWord x+      doScriptData x++-- 12.2.5.18 Script data escape start state+doScriptDataEscapeStart :: Lexer s -> ST s ()+doScriptDataEscapeStart x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         emitChar x chrHyphen+         doScriptDataEscapeStartDash x+     | otherwise -> do+         backWord x+         doScriptData x++-- 12.2.5.19 Script data escape start dash state+doScriptDataEscapeStartDash :: Lexer s -> ST s ()+doScriptDataEscapeStartDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         emitChar x chrHyphen+         doScriptDataEscapedDashDash x+     | otherwise -> do+         backWord x+         doScriptData x++-- 12.2.5.20 Script data escaped state+doScriptDataEscaped :: Lexer s -> ST s ()+doScriptDataEscaped x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         emitChar x chrHyphen+         doScriptDataEscapedDash x+     | c == chrLess -> do+         doScriptDataEscapedLessThan x+     | c == chrEOF -> do+         parseError x "eof-in-script-html-comment-like-text"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doScriptDataEscaped x++-- 12.2.5.21 Script data escaped dash state+doScriptDataEscapedDash :: Lexer s -> ST s ()+doScriptDataEscapedDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         emitChar x chrHyphen+         doScriptDataEscapedDashDash x+     | c == chrLess -> do+         doScriptDataEscapedLessThan x+     | c == chrEOF -> do+         parseError x "eof-in-script-html-comment-like-text"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doScriptDataEscaped x++-- 12.2.5.22 Script data escaped dash dash state+doScriptDataEscapedDashDash :: Lexer s -> ST s ()+doScriptDataEscapedDashDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         emitChar x c+         doScriptDataEscapedDashDash x+     | c == chrLess -> do+         doScriptDataEscapedLessThan x+     | c == chrGreater -> do+         emitChar x c+         doScriptData x+     | c == chrEOF -> do+         parseError x "eof-in-script-html-comment-like-text"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doScriptDataEscaped x++-- 12.2.5.23 Script data escaped less-than sign state+doScriptDataEscapedLessThan :: Lexer s -> ST s ()+doScriptDataEscapedLessThan x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrSolidus -> do+         bufferReset lexerBuffer+         doScriptDataEscapedEndTagOpen x+     | chrASCIIAlpha c -> do+         bufferReset lexerBuffer+         emitChar x chrLess+         backWord x+         doScriptDataDoubleEscapedStart x+     | otherwise -> do+         emitChar x chrLess+         backWord x+         doScriptDataEscaped x++-- 12.2.5.24 Script data escaped end tag open state+doScriptDataEscapedEndTagOpen :: Lexer s -> ST s ()+doScriptDataEscapedEndTagOpen x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIAlpha c -> do+         tokenTagEndInit lexerToken+         backWord x+         doScriptDataEscapedEndTagName x+     | otherwise -> do+         emitChar x chrLess+         emitChar x chrSolidus+         backWord x+         doScriptDataEscaped x++-- 12.2.5.25 Script data escaped end tag name state+doScriptDataEscapedEndTagName :: Lexer s -> ST s ()+doScriptDataEscapedEndTagName x @ Lexer {..} = do+  c <- nextWord x+  a <- appropriateEndTag x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         if a+         then do+           doBeforeAttrName x+         else do+           anythingElse+     | c == chrSolidus -> do+         if a+         then do+           doSelfClosingStartTag x+         else do+           anythingElse+     | c == chrGreater -> do+         if a+         then do+           state x StateData+           emit x+         else do+           anythingElse+     | chrASCIIUpperAlpha c -> do+         tokenTagNameAppend (chrToLower c) lexerToken+         bufferAppend c lexerBuffer+         doScriptDataEscapedEndTagName x+     | chrASCIILowerAlpha c -> do+         tokenTagNameAppend c lexerToken+         bufferAppend c lexerBuffer+         doScriptDataEscapedEndTagName x+     | otherwise -> do+         anythingElse+  where+    anythingElse = do+      tokenDrop lexerToken+      emitChar x chrLess+      emitChar x chrSolidus+      emitBuffer x+      backWord x+      state x StateScriptDataEscaped+      emit x++-- 12.2.5.26 Script data double escape start state+doScriptDataDoubleEscapedStart :: Lexer s -> ST s ()+doScriptDataDoubleEscapedStart x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace ||+       c == chrSolidus ||+       c == chrGreater -> do+         bufferContains (bsUnpack "script") lexerBuffer >>= \case+           True -> do+             doScriptDataDoubleEscaped x+           False -> do+             tokenCharInit c lexerToken+             state x StateScriptDataEscaped+             emit x+     | chrASCIIUpperAlpha c -> do+         bufferAppend (chrToLower c) lexerBuffer+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscapedStart+         emit x+     | chrASCIILowerAlpha c -> do+         bufferAppend c lexerBuffer+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscapedStart+         emit x+     | otherwise -> do+         backWord x+         doScriptDataEscaped x++-- 12.2.5.27 Script data double escaped state+doScriptDataDoubleEscaped :: Lexer s -> ST s ()+doScriptDataDoubleEscaped x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscapedDash+         emit x+     | c == chrLess -> do+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscapedLessThan+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-script-html-comment-like-text"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCharInit c lexerToken+         emit x++-- 12.2.5.28 Script data double escaped dash state+doScriptDataDoubleEscapedDash :: Lexer s -> ST s ()+doScriptDataDoubleEscapedDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscapedDashDash+         emit x+     | c == chrLess -> do+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscapedLessThan+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-script-html-comment-like-text"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscaped+         emit x++-- 12.2.5.29 Script data double escaped dash dash state+doScriptDataDoubleEscapedDashDash :: Lexer s -> ST s ()+doScriptDataDoubleEscapedDashDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         emitChar x c+         doScriptDataDoubleEscapedDashDash x+     | c == chrLess -> do+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscapedLessThan+         emit x+     | c == chrGreater -> do+         tokenCharInit c lexerToken+         state x StateScriptData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-script-html-comment-like-text"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscaped+         emit x++-- 12.2.5.30 Script data double escaped less-than sign state+doScriptDataDoubleEscapedLessThan :: Lexer s -> ST s ()+doScriptDataDoubleEscapedLessThan x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrSolidus -> do+         bufferReset lexerBuffer+         tokenCharInit c lexerToken+         state x StateScriptDataDoubleEscapeEnd+         emit x+     | otherwise -> do+         backWord x+         doScriptDataDoubleEscaped x++-- 12.2.5.31 Script data double escape end state+doScriptDataDoubleEscapeEnd :: Lexer s -> ST s ()+doScriptDataDoubleEscapeEnd x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace ||+       c == chrSolidus ||+       c == chrGreater -> do+         bufferContains (bsUnpack "script") lexerBuffer >>= \case+           True -> do+             doScriptDataEscaped x+           False -> do+             tokenCharInit c lexerToken+             state x StateScriptDataDoubleEscaped+             emit x+     | chrASCIIUpperAlpha c -> do+         bufferAppend (chrToLower c) lexerBuffer+         emitChar x c+         doScriptDataDoubleEscapeEnd x+     | chrASCIILowerAlpha c -> do+         bufferAppend c lexerBuffer+         emitChar x c+         doScriptDataDoubleEscapeEnd x+     | otherwise -> do+         backWord x+         doScriptDataDoubleEscaped x++-- 12.2.5.32 Before attribute name state+doBeforeAttrName :: Lexer s -> ST s ()+doBeforeAttrName x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeAttrName x+     | c == chrSolidus ||+       c == chrGreater ||+       c == chrEOF -> do+         backWord x+         doAfterAttrName x+     | c == chrEqual -> do+         parseError x "unexpected-equals-sign-before-attribute-name"+         tokenAttrInit lexerToken+         tokenAttrNameAppend c lexerToken+         doAttrName x+     | otherwise -> do+         tokenAttrInit lexerToken+         backWord x+         doAttrName x++-- 12.2.5.33 Attribute name state+doAttrName :: Lexer s -> ST s ()+doAttrName x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace ||+       c == chrSolidus ||+       c == chrGreater ||+       c == chrEOF -> do+         checkAttr+         backWord x+         doAfterAttrName x+     | c == chrEqual -> do+         checkAttr+         doBeforeAttrValue x+     | chrASCIIUpperAlpha c -> do+         tokenAttrNameAppend (chrToLower c) lexerToken+         doAttrName x+     | c == chrQuote ||+       c == chrApostrophe ||+       c == chrLess -> do+         parseError x "unexpected-character-in-attribute-name"+         tokenAttrNameAppend c lexerToken+         doAttrName x+     | otherwise -> do+         tokenAttrNameAppend c lexerToken+         doAttrName x+  where+    checkAttr = do+      i <- tokenTail lexerToken+      whenM (tokenAttrNamePrune i lexerToken) $ do+        parseError x "duplicate-attribute"++-- 12.2.5.34 After attribute name state+doAfterAttrName :: Lexer s -> ST s ()+doAfterAttrName x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doAfterAttrName x+     | c == chrSolidus -> do+         doSelfClosingStartTag x+     | c == chrEqual -> do+         doBeforeAttrValue x+     | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-tag"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenAttrInit lexerToken+         backWord x+         doAttrName x++-- 12.2.5.35 Before attribute value state+doBeforeAttrValue :: Lexer s -> ST s ()+doBeforeAttrValue x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeAttrValue x+     | c == chrQuote -> do+         doAttrValueDoubleQuoted x+     | c == chrApostrophe -> do+         doAttrValueSingleQuoted x+     | c == chrGreater -> do+         parseError x "missing-attribute-value"+         state x StateData+         emit x+     | otherwise -> do+         backWord x+         doAttrValueUnquoted x++-- 12.2.5.36 Attribute value (double-quoted) state+doAttrValueDoubleQuoted :: Lexer s -> ST s ()+doAttrValueDoubleQuoted x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrQuote -> do+         doAfterAttrValue x+     | c == chrAmpersand -> do+         returnSet x StateAttrValueDoubleQuoted+         doCharacterReference x+     | c == chrEOF -> do+         parseError x "eof-in-tag"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenAttrValAppend c lexerToken+         doAttrValueDoubleQuoted x++-- 12.2.5.37 Attribute value (single-quoted) state+doAttrValueSingleQuoted :: Lexer s -> ST s ()+doAttrValueSingleQuoted x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrApostrophe -> do+         doAfterAttrValue x+     | c == chrAmpersand -> do+         returnSet x StateAttrValueSingleQuoted+         doCharacterReference x+     | c == chrEOF -> do+         parseError x "eof-in-tag"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenAttrValAppend c lexerToken+         doAttrValueSingleQuoted x++-- 12.2.5.38 Attribute value (unquoted) state+doAttrValueUnquoted :: Lexer s -> ST s ()+doAttrValueUnquoted x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeAttrName x+     | c == chrAmpersand -> do+         returnSet x StateAttrValueUnquoted+         doCharacterReference x+     | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrQuote ||+       c == chrApostrophe ||+       c == chrLess ||+       c == chrEqual ||+       c == chrGrave -> do+         parseError x "unexpected-character-in-unquoted-attribute-value"+         tokenAttrValAppend c lexerToken+         doAttrValueUnquoted x+     | c == chrEOF -> do+         parseError x "eof-in-tag"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenAttrValAppend c lexerToken+         doAttrValueUnquoted x++-- 12.2.5.39 After attribute value (quoted) state+doAfterAttrValue :: Lexer s -> ST s ()+doAfterAttrValue x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeAttrName x+     | c == chrSolidus -> do+         doSelfClosingStartTag x+     | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-tag"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "missing-whitespace-between-attributes"+         backWord x+         doBeforeAttrName x++-- 12.2.5.40 Self-closing start tag state+doSelfClosingStartTag :: Lexer s -> ST s ()+doSelfClosingStartTag x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrGreater -> do+         tokenTagStartSetSelfClosing lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-tag"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "unexpected-solidus-in-tag"+         backWord x+         doBeforeAttrName x++-- 12.2.5.41 Bogus comment state+doBogusComment :: Lexer s -> ST s ()+doBogusComment x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrEOF -> do+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCommentAppend c lexerToken+         doBogusComment x++-- 12.2.5.42 Markup declaration open state+doMarkupDeclarationOpen :: Lexer s -> ST s ()+doMarkupDeclarationOpen x @ Lexer {..} = do+  f <- dataIndexer x+  n <- dataRemain x+  if | n > 1 &&+       f 0 == chrHyphen &&+       f 1 == chrHyphen -> do+         skipWord x 2+         tokenCommentInit lexerToken+         doCommentStart x+     | n > 6 &&+       (f 0 == 0x44 || f 0 == 0x64) &&    -- D or d+       (f 1 == 0x4F || f 1 == 0x6F) &&    -- O or o+       (f 2 == 0x43 || f 2 == 0x63) &&    -- C or c+       (f 3 == 0x54 || f 3 == 0x74) &&    -- T or t+       (f 4 == 0x59 || f 4 == 0x79) &&    -- Y or y+       (f 5 == 0x50 || f 5 == 0x70) &&    -- P or p+       (f 6 == 0x45 || f 6 == 0x65) -> do -- E or e+         skipWord x 7+         doDoctype x+     | n > 6 &&+       f 0 == 0x5B &&    -- [+       f 1 == 0x43 &&    -- C+       f 2 == 0x44 &&    -- D+       f 3 == 0x41 &&    -- A+       f 4 == 0x54 &&    -- T+       f 5 == 0x41 &&    -- A+       f 6 == 0x5B -> do -- [+         skipWord x 7+  -- The standard says to check if the parser has an adjusted current node+  -- that is not in the HTML namespace, and if so then CDATA sections are+  -- allowed.  For now we assume that condition is true and we do not+  -- check with the parser to verify.  CDATA sections in HTML are probably+  -- not common and in most cases they are going to be in the correct+  -- locations anyway.+         if True -- TODO+            then do+              state x StateCDATASection+              doCDATASection x+            else do+              parseError x "cdata-in-html-content"+              tokenCommentInit lexerToken+              mapM_ (flip tokenCommentAppend lexerToken)+                [ 0x5B, 0x43, 0x44, 0x41, 0x54, 0x41, 0x5B ]+              doBogusComment x+     | otherwise -> do+         parseError x "incorrectly-opened-comment"+         tokenCommentInit lexerToken+         doBogusComment x++-- 12.2.5.43 Comment start state+doCommentStart :: Lexer s -> ST s ()+doCommentStart x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         doCommentStartDash x+     | c == chrGreater -> do+         parseError x "abrupt-closing-of-empty-comment"+         state x StateData+         emit x+     | otherwise -> do+         backWord x+         doComment x++-- 12.2.5.44 Comment start dash state+doCommentStartDash :: Lexer s -> ST s ()+doCommentStartDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         doCommentEnd x+     | c == chrGreater -> do+         parseError x "abrupt-closing-of-empty-comment"+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-comment"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCommentAppend chrHyphen lexerToken+         backWord x+         doComment x++-- 12.2.5.45 Comment state+doComment :: Lexer s -> ST s ()+doComment x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrLess -> do+         tokenCommentAppend c lexerToken+         doCommentLessThan x+     | c == chrHyphen -> do+         doCommentEndDash x+     | c == chrEOF -> do+         parseError x "eof-in-comment"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCommentAppend c lexerToken+         doComment x++-- 12.2.5.46 Comment less-than sign state+doCommentLessThan :: Lexer s -> ST s ()+doCommentLessThan x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrExclamation -> do+         tokenCommentAppend c lexerToken+         doCommentLessThanBang x+     | c == chrLess -> do+         tokenCommentAppend c lexerToken+         doCommentLessThan x+     | otherwise -> do+         backWord x+         doComment x++-- 12.2.5.47 Comment less-than sign bang state+doCommentLessThanBang :: Lexer s -> ST s ()+doCommentLessThanBang x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         doCommentLessThanBangDash x+     | otherwise -> do+         backWord x+         doComment x++-- 12.2.5.48 Comment less-than sign bang dash state+doCommentLessThanBangDash :: Lexer s -> ST s ()+doCommentLessThanBangDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         doCommentLessThanBangDashDash x+     | otherwise -> do+         backWord x+         doCommentEndDash x++-- 12.2.5.49 Comment less-than sign bang dash dash state+doCommentLessThanBangDashDash :: Lexer s -> ST s ()+doCommentLessThanBangDashDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen ||+       c == chrEOF -> do+         backWord x+         doCommentEnd x+     | otherwise -> do+         parseError x "nested-comment"+         backWord x+         doCommentEnd x++-- 12.2.5.50 Comment end dash state+doCommentEndDash :: Lexer s -> ST s ()+doCommentEndDash x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrHyphen -> do+         doCommentEnd x+     | c == chrEOF -> do+         parseError x "eof-in-comment"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCommentAppend chrHyphen lexerToken+         backWord x+         doComment x++-- 12.2.5.51 Comment end state+doCommentEnd :: Lexer s -> ST s ()+doCommentEnd x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrExclamation -> do+         doCommentEndBang x+     | c == chrHyphen -> do+         tokenCommentAppend chrHyphen lexerToken+         doCommentEnd x+     | c == chrEOF -> do+         parseError x "eof-in-comment"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCommentAppend chrHyphen lexerToken+         tokenCommentAppend chrHyphen lexerToken+         backWord x+         doComment x++-- 12.2.5.52 Comment end bang state+doCommentEndBang :: Lexer s -> ST s ()+doCommentEndBang x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrHyphen -> do+         tokenCommentAppend chrHyphen lexerToken+         tokenCommentAppend chrHyphen lexerToken+         tokenCommentAppend chrExclamation lexerToken+         doCommentEndDash x+     | c == chrGreater -> do+         parseError x "incorrectly-closed-comment"+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-comment"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenCommentAppend chrHyphen lexerToken+         tokenCommentAppend chrHyphen lexerToken+         tokenCommentAppend chrExclamation lexerToken+         backWord x+         doComment x++-- 12.2.5.53 DOCTYPE state+doDoctype :: Lexer s -> ST s ()+doDoctype x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeDoctypeName x+     | c == chrGreater -> do+         backWord x+         doBeforeDoctypeName x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeInit lexerToken+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "missing-whitespace-before-doctype-name"+         backWord x+         doBeforeDoctypeName x++-- 12.2.5.54 Before DOCTYPE name state+doBeforeDoctypeName :: Lexer s -> ST s ()+doBeforeDoctypeName x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeDoctypeName x+     | chrASCIIUpperAlpha c -> do+         tokenDoctypeInit lexerToken+         tokenDoctypeNameAppend (chrToLower c) lexerToken+         doDoctypeName x+     | c == chrGreater -> do+         parseError x "missing-doctype-name"+         tokenDoctypeInit lexerToken+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeInit lexerToken+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenDoctypeInit lexerToken+         tokenDoctypeNameAppend c lexerToken+         doDoctypeName x++-- 12.2.5.55 DOCTYPE name state+doDoctypeName :: Lexer s -> ST s ()+doDoctypeName x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doAfterDoctypeName x+     | c == chrGreater -> do+         state x StateData+         emit x+     | chrASCIIUpperAlpha c -> do+         tokenDoctypeNameAppend (chrToLower c) lexerToken+         doDoctypeName x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenDoctypeNameAppend c lexerToken+         doDoctypeName x++-- 12.2.5.56 After DOCTYPE name state+doAfterDoctypeName :: Lexer s -> ST s ()+doAfterDoctypeName x @ Lexer {..} = do+  c <- nextWord x+  -- Get data indexer after the character.+  f <- dataIndexer x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doAfterDoctypeName x+     | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | (c == 0x50 || c == 0x70) &&        -- P or p+       (f 0 == 0x55 || f 0 == 0x75) &&    -- U or u+       (f 1 == 0x42 || f 1 == 0x62) &&    -- B or b+       (f 2 == 0x4C || f 2 == 0x6C) &&    -- L or l+       (f 3 == 0x49 || f 3 == 0x69) &&    -- I or i+       (f 4 == 0x43 || f 4 == 0x63) -> do -- C or c+         skipWord x 5+         doAfterDoctypePublicKeyword x+     | (c == 0x53 || c == 0x73) &&        -- S or s+       (f 0 == 0x59 || f 0 == 0x79) &&    -- Y or y+       (f 1 == 0x53 || f 1 == 0x73) &&    -- S or s+       (f 2 == 0x54 || f 2 == 0x74) &&    -- T or t+       (f 3 == 0x45 || f 3 == 0x65) &&    -- E or e+       (f 4 == 0x4D || f 4 == 0x6D) -> do -- M or m+         skipWord x 5+         doAfterDoctypeSystemKeyword x+     | otherwise -> do+         parseError x "invalid-character-sequence-after-doctype-name"+         tokenDoctypeSetForceQuirks lexerToken+         doBogusDoctype x++-- 12.2.5.57 After DOCTYPE public keyword state+doAfterDoctypePublicKeyword :: Lexer s -> ST s ()+doAfterDoctypePublicKeyword x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeDoctypePublicId x+     | c == chrQuote -> do+         parseError x "missing-whitespace-after-doctype-public-keyword"+         tokenDoctypePublicIdInit lexerToken+         doDoctypePublicIdDoubleQuoted x+     | c == chrApostrophe -> do+         parseError x "missing-whitespace-after-doctype-public-keyword"+         tokenDoctypePublicIdInit lexerToken+         doDoctypePublicIdSingleQuoted x+     | c == chrGreater -> do+         parseError x "missing-doctype-public-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "missing-quote-before-doctype-public-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         doBogusDoctype x++-- 12.2.5.58 Before DOCTYPE public identifier state+doBeforeDoctypePublicId :: Lexer s -> ST s ()+doBeforeDoctypePublicId x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeDoctypePublicId x+     | c == chrQuote -> do+         tokenDoctypePublicIdInit lexerToken+         doDoctypePublicIdDoubleQuoted x+     | c == chrApostrophe -> do+         tokenDoctypePublicIdInit lexerToken+         doDoctypePublicIdSingleQuoted x+     | c == chrGreater -> do+         parseError x "missing-doctype-public-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "missing-quote-before-doctype-public-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         doBogusDoctype x++-- 12.2.5.59 DOCTYPE public identifier (double-quoted) state+doDoctypePublicIdDoubleQuoted :: Lexer s -> ST s ()+doDoctypePublicIdDoubleQuoted x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrQuote -> do+         doAfterDoctypePublicId x+     | c == chrGreater -> do+         parseError x "abrupt-doctype-public-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenDoctypePublicIdAppend c lexerToken+         doDoctypePublicIdDoubleQuoted x++-- 12.2.5.60 DOCTYPE public identifier (single-quoted) state+doDoctypePublicIdSingleQuoted :: Lexer s -> ST s ()+doDoctypePublicIdSingleQuoted x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrApostrophe -> do+         doAfterDoctypePublicId x+     | c == chrGreater -> do+         parseError x "abrupt-doctype-public-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenDoctypePublicIdAppend c lexerToken+         doDoctypePublicIdSingleQuoted x++-- 12.2.5.61 After DOCTYPE public identifier state+doAfterDoctypePublicId :: Lexer s -> ST s ()+doAfterDoctypePublicId x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBetweenDoctypePublicAndSystem x+     | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrQuote -> do+         parseError x "missing-whitespace-between-doctype-public-and-system-identifiers"+         tokenDoctypeSystemIdInit lexerToken+         doDoctypeSystemIdDoubleQuoted x+     | c == chrApostrophe -> do+         parseError x "missing-whitespace-between-doctype-public-and-system-identifiers"+         tokenDoctypeSystemIdInit lexerToken+         doDoctypeSystemIdSingleQuoted x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "missing-quote-before-doctype-system-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         doBogusDoctype x++-- 12.2.5.62 Between DOCTYPE public and system identifiers state+doBetweenDoctypePublicAndSystem :: Lexer s -> ST s ()+doBetweenDoctypePublicAndSystem x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBetweenDoctypePublicAndSystem x+     | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrQuote -> do+         tokenDoctypeSystemIdInit lexerToken+         doDoctypeSystemIdDoubleQuoted x+     | c == chrApostrophe -> do+         tokenDoctypeSystemIdInit lexerToken+         doDoctypeSystemIdSingleQuoted x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "missing-quote-before-doctype-system-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         doBogusDoctype x++-- 12.2.5.63 After DOCTYPE system keyword state+doAfterDoctypeSystemKeyword :: Lexer s -> ST s ()+doAfterDoctypeSystemKeyword x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeDoctypeSystemId x+     | c == chrQuote -> do+         parseError x "missing-whitespace-after-doctype-system-keyword"+         tokenDoctypeSystemIdInit lexerToken+         doDoctypeSystemIdDoubleQuoted x+     | c == chrApostrophe -> do+         parseError x "missing-whitespace-after-doctype-system-keyword"+         tokenDoctypeSystemIdInit lexerToken+         doDoctypeSystemIdSingleQuoted x+     | c == chrGreater -> do+         parseError x "missing-doctype-system-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "missing-quote-before-doctype-system-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         doBogusDoctype x++-- 12.2.5.64 Before DOCTYPE system identifier state+doBeforeDoctypeSystemId :: Lexer s -> ST s ()+doBeforeDoctypeSystemId x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doBeforeDoctypeSystemId x+     | c == chrQuote -> do+         tokenDoctypeSystemIdInit lexerToken+         doDoctypeSystemIdDoubleQuoted x+     | c == chrApostrophe -> do+         tokenDoctypeSystemIdInit lexerToken+         doDoctypeSystemIdSingleQuoted x+     | c == chrGreater -> do+         parseError x "missing-doctype-system-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "missing-quote-before-doctype-system-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         doBogusDoctype x++-- 12.2.5.65 DOCTYPE system identifier (double-quoted) state+doDoctypeSystemIdDoubleQuoted :: Lexer s -> ST s ()+doDoctypeSystemIdDoubleQuoted x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrQuote -> do+         doAfterDoctypeSystemId x+     | c == chrGreater -> do+         parseError x "abrupt-doctype-system-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenDoctypeSystemIdAppend c lexerToken+         doDoctypeSystemIdDoubleQuoted x++-- 12.2.5.66 DOCTYPE system identifier (single-quoted) state+doDoctypeSystemIdSingleQuoted :: Lexer s -> ST s ()+doDoctypeSystemIdSingleQuoted x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrApostrophe -> do+         doAfterDoctypeSystemId x+     | c == chrGreater -> do+         parseError x "abrupt-doctype-system-identifier"+         tokenDoctypeSetForceQuirks lexerToken+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         tokenDoctypeSystemIdAppend c lexerToken+         doDoctypeSystemIdSingleQuoted x++-- 12.2.5.67 After DOCTYPE system identifier state+doAfterDoctypeSystemId :: Lexer s -> ST s ()+doAfterDoctypeSystemId x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrTab ||+       c == chrLF ||+       c == chrFF ||+       c == chrSpace -> do+         doAfterDoctypeSystemId x+     | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrEOF -> do+         parseError x "eof-in-doctype"+         tokenDoctypeSetForceQuirks lexerToken+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         parseError x "unexpected-character-after-doctype-system-identifier"+         doBogusDoctype x++-- 12.2.5.68 Bogus DOCTYPE state+doBogusDoctype :: Lexer s -> ST s ()+doBogusDoctype x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrGreater -> do+         state x StateData+         emit x+     | c == chrEOF -> do+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         doBogusDoctype x++-- 12.2.5.69 CDATA section state+doCDATASection :: Lexer s -> ST s ()+doCDATASection x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrBracketRight -> do+         doCDATASectionBracket x+     | c == chrEOF -> do+         parseError x "eof-in-cdata"+         tokenEOFInit lexerToken+         emit x+     | otherwise -> do+         emitChar x c+         doCDATASection x++-- 12.2.5.70 CDATA section bracket state+doCDATASectionBracket :: Lexer s -> ST s ()+doCDATASectionBracket x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrBracketRight -> do+         doCDATASectionEnd x+     | otherwise -> do+         tokenCharInit chrBracketRight lexerToken+         backWord x+         doCDATASection x++-- 12.2.5.71 CDATA section end state+doCDATASectionEnd :: Lexer s -> ST s ()+doCDATASectionEnd x @ Lexer {..} = do+  c <- nextWord x+  if | c == chrBracketRight -> do+         emitChar x c+         doCDATASectionEnd x+     | c == chrGreater -> do+         doData x+     | otherwise -> do+         emitChar x chrBracketRight+         emitChar x chrBracketRight+         backWord x+         doCDATASection x++-- 12.2.5.72 Character reference state+doCharacterReference :: Lexer s -> ST s ()+doCharacterReference x @ Lexer {..} = do+  bufferReset lexerBuffer+  bufferAppend chrAmpersand lexerBuffer+  c <- nextWord x+  if | lexerIgnore -> do+         flushCodePoints x+         backWord x+         returnState x+     | chrASCIIAlphanumeric c -> do+         backWord x+         doNamedCharacterReference x+     | c == chrNumberSign -> do+         bufferAppend c lexerBuffer+         doNumericCharacterReference x+     | otherwise -> do+         flushCodePoints x+         backWord x+         returnState x++-- 12.2.5.73 Named character reference state+doNamedCharacterReference :: Lexer s -> ST s ()+doNamedCharacterReference x @ Lexer {..} = do+  o <- rref lexerOffset+  case entityMatch (bsDrop o lexerData) of+    Just (p, v, _) -> do+      skipWord x $ bsLen p+      forM_ (bsUnpack p) $+        flip bufferAppend lexerBuffer+      attr <- consumingAttibute x+      semi <- pure $ bsLast p == Just chrSemicolon+      c    <- peekWord x+      if | attr+         , not semi+         , c == chrSemicolon || chrASCIIAlphanumeric c -> do+             flushCodePoints x+             returnState x+         | otherwise -> do+             when (not semi) $+               parseError x "missing-semicolon-after-character-reference"+             bufferReset lexerBuffer+             forM_ (bsUnpack v) $+               flip bufferAppend lexerBuffer+             flushCodePoints x+             returnState x+    Nothing -> do+      flushCodePoints x+      doAmbiguousAmpersand x++-- 12.2.5.74 Ambiguous ampersand state+doAmbiguousAmpersand :: Lexer s -> ST s ()+doAmbiguousAmpersand x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIAlphanumeric c -> do+         consumingAttibute x >>= \case+           True  -> tokenAttrValAppend c lexerToken+           False -> emitChar x c+         doAmbiguousAmpersand x+     | c == chrSemicolon -> do+         parseError x "unknown-named-character-reference"+         backWord x+         returnState x+     | otherwise -> do+         backWord x+         returnState x++-- 12.2.5.75 Numeric character reference state+doNumericCharacterReference :: Lexer s -> ST s ()+doNumericCharacterReference x @ Lexer {..} = do+  wref lexerCode 0+  c <- nextWord x+  if | c == chrUpperX || c == chrLowerX -> do+         bufferAppend c lexerBuffer+         doHexCharacterReferenceStart x+     | otherwise -> do+         backWord x+         doDecimalCharacterReference x++-- 12.2.5.76 Hexademical character reference start state+doHexCharacterReferenceStart :: Lexer s -> ST s ()+doHexCharacterReferenceStart x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIHexDigit c -> do+         backWord x+         doHexCharacterReference x+     | otherwise -> do+         parseError x "absence-of-digits-in-numeric-character-reference"+         flushCodePoints x+         backWord x+         returnState x++-- 12.2.5.77 Decimal character reference start state+doDecimalCharacterReferenceStart :: Lexer s -> ST s ()+doDecimalCharacterReferenceStart x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIDigit c -> do+         backWord x+         doDecimalCharacterReference x+     | otherwise -> do+         parseError x "absence-of-digits-in-numeric-character-reference"+         flushCodePoints x+         backWord x+         returnState x++-- 12.2.5.78 Hexademical character reference state+doHexCharacterReference :: Lexer s -> ST s ()+doHexCharacterReference x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIDigit c -> do+         uref lexerCode $ \y -> 16 * y + (fromIntegral c - 0x30)+         doHexCharacterReference x+     | chrASCIIUpperHexDigit c -> do+         uref lexerCode $ \y -> 16 * y + (fromIntegral c - 0x37)+         doHexCharacterReference x+     | chrASCIILowerHexDigit c -> do+         uref lexerCode $ \y -> 16 * y + (fromIntegral c - 0x57)+         doHexCharacterReference x+     | c == chrSemicolon -> do+         doNumericCharacterReferenceEnd x+     | otherwise -> do+         parseError x "missing-semicolon-after-character-reference"+         backWord x+         doNumericCharacterReferenceEnd x++-- 12.2.5.79 Decimal character reference state+doDecimalCharacterReference :: Lexer s -> ST s ()+doDecimalCharacterReference x @ Lexer {..} = do+  c <- nextWord x+  if | chrASCIIDigit c -> do+         uref lexerCode $ \y -> 10 * y + (fromIntegral c - 0x30)+         doDecimalCharacterReference x+     | c == chrSemicolon -> do+         doNumericCharacterReferenceEnd x+     | otherwise -> do+         parseError x "missing-semicolon-after-character-reference"+         backWord x+         doNumericCharacterReferenceEnd x++-- 12.2.5.80 Numeric character reference end state+doNumericCharacterReferenceEnd :: Lexer s -> ST s ()+doNumericCharacterReferenceEnd x @ Lexer {..} = do+  c <- rref lexerCode+  let n = fromIntegral c+  if | c == 0 -> do+         parseError x "null-character-reference"+         wref lexerCode 0xFFFD+     | c > 0x10FFFF -> do+         parseError x "character-reference-outside-unicode-range"+         wref lexerCode 0xFFFD+     | chrSurrogate c -> do+         parseError x "surrogate-character-reference"+         wref lexerCode 0xFFFD+     | chrNonCharacter c -> do+         parseError x "noncharacter-character-reference"+     | c == 0x0D || (chrWord8 c && chrControl n && not (chrWhitespace n)) -> do+         parseError x "control-character-reference"+         whenJust (Map.lookup c codeMap) $ wref lexerCode+     | otherwise ->+         pure ()+  bufferReset lexerBuffer+  forM_ (chrUTF8 c) $ flip bufferAppend lexerBuffer+  flushCodePoints x+  returnState x++-- | Character code map.+codeMap :: Map Int Int+codeMap = Map.fromList+  [ (0x80, 0x20AC)+  , (0x82, 0x201A)+  , (0x83, 0x0192)+  , (0x84, 0x201E)+  , (0x85, 0x2026)+  , (0x86, 0x2020)+  , (0x87, 0x2021)+  , (0x88, 0x02C6)+  , (0x89, 0x2030)+  , (0x8A, 0x0160)+  , (0x8B, 0x2039)+  , (0x8C, 0x0152)+  , (0x8E, 0x017D)+  , (0x91, 0x2018)+  , (0x92, 0x2019)+  , (0x93, 0x201C)+  , (0x94, 0x201D)+  , (0x95, 0x2022)+  , (0x96, 0x2013)+  , (0x97, 0x2014)+  , (0x98, 0x02DC)+  , (0x99, 0x2122)+  , (0x9A, 0x0161)+  , (0x9B, 0x203A)+  , (0x9C, 0x0153)+  , (0x9E, 0x017E)+  , (0x9F, 0x0178)+  ]
+ src/Zenacy/HTML/Internal/Oper.hs view
@@ -0,0 +1,533 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines operations on html data types.+module Zenacy.HTML.Internal.Oper+  ( htmlNodeIsElem+  , htmlNodeIsText+  , htmlNodeContent+  , htmlNodeContentSet+  , htmlNodeShow+  , htmlNodeFind+  , htmlNodeCount+  , htmlNodeCountM+  , htmlTextSpace+  , htmlTextAppend+  , htmlTextPrepend+  , htmlAttrHasName+  , htmlAttrRename+  , htmlElemAttr+  , htmlElemAttrCount+  , htmlElemAttrFind+  , htmlElemAttrFindName+  , htmlElemAttrApply+  , htmlElemAttrFilter+  , htmlElemAttrMap+  , htmlElemHasAttr+  , htmlElemHasAttrName+  , htmlElemHasAttrVal+  , htmlElemHasAttrValInfix+  , htmlElemAddAttr+  , htmlElemSetAttr+  , htmlElemGetAttr+  , htmlElemAttrRemove+  , htmlElemRemoveAllAttr+  , htmlElemAttrRename+  , htmlElemID+  , htmlElemIDSet+  , htmlElemHasID+  , htmlElemFindID+  , htmlElemClass+  , htmlElemClassSet+  , htmlElemClasses+  , htmlElemClassesSet+  , htmlElemClassesAdd+  , htmlElemClassesRemove+  , htmlElemClassesContains+  , htmlElemStyle+  , htmlElemStyles+  , htmlElemStyleParseURL+  , htmlElemContent+  , htmlElemContentSet+  , htmlElemHasContent+  , htmlElemNodeFirst+  , htmlElemNodeLast+  , htmlElemNodeCount+  , htmlElemName+  , htmlElemHasName+  , htmlElemRename+  , htmlElemFindElem+  , htmlElemFindElemNamed+  , htmlElemHasElem+  , htmlElemHasElemNamed+  , htmlElemContentApply+  , htmlElemContentMap+  , htmlElemContentFilter+  , htmlElemSearch+  , htmlElemText+  , htmlDocHtml+  , htmlDocBody+  , htmlDocHead+  , htmlDocTitle+  , htmlMapElem+  , htmlMapElemM+  , htmlElemCollapse+  , htmlElemCollapseM+  ) where++import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.HTML+import Control.Monad+  ( (>=>)+  )+import Control.Monad.Extra as X+  ( whenJust+  , whenJustM+  , concatMapM+  , ifM+  )+-- import Control.Monad.Identity+--   ( runIdentity+--   )+import Data.Char+  ( isSpace+  )+import Data.Functor.Identity+  ( runIdentity+  )+import Data.List+  ( find+  )+import Data.List.Extra+  ( firstJust+  )+import Data.Map+  ( Map+  )+import qualified Data.Map as Map+  ( empty+  , fromList+  , lookup+  )+import Data.Maybe+  ( listToMaybe+  , isJust+  )+import Data.Monoid+  ( (<>)+  )+import Data.Set+  ( Set+  )+import qualified Data.Set as Set+  ( delete+  , empty+  , fromList+  , insert+  , member+  , notMember+  , toList+  , union+  , unions+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( all+  , append+  , breakOn+  , concat+  , drop+  , dropAround+  , empty+  , isInfixOf+  , isPrefixOf+  , null+  , split+  , splitOn+  , strip+  , words+  , unwords+  )+import Data.Tuple.Extra+  ( first+  , second+  )++-- | Determines if a node is an element node.+htmlNodeIsElem :: HTMLNode -> Bool+htmlNodeIsElem HTMLElement {} = True+htmlNodeIsElem _ = False++-- | Determines if a node is a text node.+htmlNodeIsText :: HTMLNode -> Bool+htmlNodeIsText HTMLText {} = True+htmlNodeIsText _ = False++-- | Gets the content of a node.+htmlNodeContent :: HTMLNode -> [HTMLNode]+htmlNodeContent (HTMLDocument _ c) = c+htmlNodeContent (HTMLFragment _ c) = c+htmlNodeContent (HTMLElement _ _ _ c) = c+htmlNodeContent _ = []++-- | Sets the content of a node.+htmlNodeContentSet :: [HTMLNode] -> HTMLNode -> HTMLNode+htmlNodeContentSet x (HTMLDocument n c) = HTMLDocument n x+htmlNodeContentSet x (HTMLFragment n c) = HTMLFragment n x+htmlNodeContentSet x (HTMLElement n s a c) = HTMLElement n s a x+htmlNodeContentSet x y = y++-- | Shows the node without its content.+htmlNodeShow :: HTMLNode -> String+htmlNodeShow = show . htmlNodeContentSet []++-- | Finds a child node using a predicate.+htmlNodeFind :: (HTMLNode -> Bool) -> HTMLNode -> Maybe HTMLNode+htmlNodeFind p x = find p $ htmlNodeContent x++-- | Counts the number of nodes matching a predicate.+htmlNodeCount :: (HTMLNode -> Bool) -> HTMLNode -> Int+htmlNodeCount f = runIdentity . htmlNodeCountM (pure . f)++-- | Counts the number of nodes matching a predicate.+htmlNodeCountM :: Monad m => (HTMLNode -> m Bool) -> HTMLNode -> m Int+htmlNodeCountM f x = do+  n <- sum <$> mapM (htmlNodeCountM f) (htmlNodeContent x)+  ifM (f x) (pure $ 1 + n) (pure n)++-- | Determines if a node is a text node containing only whitespace.+htmlTextSpace :: HTMLNode -> Bool+htmlTextSpace (HTMLText x) = T.all isSpace x+htmlTextSpace _ = False++-- | Appends text to a text node.+htmlTextAppend :: Text -> HTMLNode -> HTMLNode+htmlTextAppend a (HTMLText x) = HTMLText $ T.append x a+htmlTextAppend a x = x++-- | Prepends text to a text node.+htmlTextPrepend :: Text -> HTMLNode -> HTMLNode+htmlTextPrepend a (HTMLText x) = HTMLText $ T.append a x+htmlTextPrepend a x = x++-- | A predicate for checking attribute names.+htmlAttrHasName :: Text -> HTMLAttr -> Bool+htmlAttrHasName x a = x == htmlAttrName a++-- | Renames an attribute.+htmlAttrRename :: Text -> HTMLAttr -> HTMLAttr+htmlAttrRename x (HTMLAttr n v s) = HTMLAttr x v s++-- | Gets the attributes for an element.+htmlElemAttr :: HTMLNode -> [HTMLAttr]+htmlElemAttr (HTMLElement _ _ a _) = a+htmlElemAttr _ = []++-- | Gets the number of attributes for an element.+htmlElemAttrCount :: HTMLNode -> Int+htmlElemAttrCount = length . htmlElemAttr++-- | Finds an attribute for an element.+htmlElemAttrFind :: (HTMLAttr -> Bool) -> HTMLNode -> Maybe HTMLAttr+htmlElemAttrFind f (HTMLElement _ _ a _) = find f a+htmlElemAttrFind _ _ = Nothing++-- | Finds an attribute by name for an element.+htmlElemAttrFindName :: Text -> HTMLNode -> Maybe HTMLAttr+htmlElemAttrFindName x = htmlElemAttrFind $ htmlAttrHasName x++-- | Applies a function to the attributes for an element.+htmlElemAttrApply :: ([HTMLAttr] -> [HTMLAttr]) -> HTMLNode -> HTMLNode+htmlElemAttrApply f (HTMLElement n s a c) = HTMLElement n s (f a) c+htmlElemAttrApply _ x = x++-- | Filters the attributes for an element.+htmlElemAttrFilter :: (HTMLAttr -> Bool) -> HTMLNode -> HTMLNode+htmlElemAttrFilter f = htmlElemAttrApply $ filter f++-- | Maps an endofunctor over an element attributes.+htmlElemAttrMap :: (HTMLAttr -> HTMLAttr) -> HTMLNode -> HTMLNode+htmlElemAttrMap f = htmlElemAttrApply $ map f++-- | Determines if the element has attributes.+htmlElemHasAttr :: HTMLNode -> Bool+htmlElemHasAttr x = htmlElemAttrCount x > 0++-- | Determines if an element has an attribute.+htmlElemHasAttrName :: Text -> HTMLNode -> Bool+htmlElemHasAttrName x = isJust . htmlElemAttrFindName x++-- | Determines if an element has an attribute value.+htmlElemHasAttrVal :: Text -> Text -> HTMLNode -> Bool+htmlElemHasAttrVal x y z =+  maybe False (\a -> y == htmlAttrVal a) $ htmlElemAttrFindName x z++-- | Determines if an element has part of an attribute value.+htmlElemHasAttrValInfix :: Text -> Text -> HTMLNode -> Bool+htmlElemHasAttrValInfix x y z =+  maybe False (\a -> y `T.isInfixOf` htmlAttrVal a) $ htmlElemAttrFindName x z++-- | Adds an attribute to an element.+htmlElemAddAttr :: HTMLAttr -> HTMLNode -> HTMLNode+htmlElemAddAttr x (HTMLElement n s a c) = HTMLElement n s (a <> [x]) c+htmlElemAddAttr x y = y++-- | Sets an attribute value.+htmlElemSetAttr :: Text -> Text -> HTMLNode -> HTMLNode+htmlElemSetAttr x v n =+  if htmlElemHasAttrName x n+     then htmlElemAttrMap f n+     else htmlElemAddAttr (htmlAttr x v) n+  where+    f a@(HTMLAttr an av as) =+      if an == x then (HTMLAttr an v as) else a++-- | Gets an attribute value.+htmlElemGetAttr :: Text -> HTMLNode -> Maybe Text+htmlElemGetAttr x n = htmlAttrVal <$> htmlElemAttrFindName x n++-- | Removes an attribute from an element.+htmlElemAttrRemove :: Text -> HTMLNode -> HTMLNode+htmlElemAttrRemove x (HTMLElement n s a c) = HTMLElement n s a' c+  where a' = filter (\y -> htmlAttrName y /= x) a+htmlElemAttrRemove x y = y++-- | Removes all attributes from an element.+htmlElemRemoveAllAttr :: HTMLNode -> HTMLNode+htmlElemRemoveAllAttr (HTMLElement n s a c) = HTMLElement n s [] c+htmlElemRemoveAllAttr x = x++-- | Renames an attribute for an element.+htmlElemAttrRename :: Text -> Text -> HTMLNode -> HTMLNode+htmlElemAttrRename old new = htmlElemAttrMap rename+  where+    rename x =+      if htmlAttrHasName old x+         then htmlAttrRename new x+         else x++-- | Gets the id attribute for an element.+htmlElemID :: HTMLNode -> Maybe Text+htmlElemID = htmlElemGetAttr "id"++-- | Sets the id attribute for an element.+htmlElemIDSet :: Text -> HTMLNode -> HTMLNode+htmlElemIDSet = htmlElemSetAttr "id"++-- | Determines if an element has an id.+htmlElemHasID :: Text -> HTMLNode -> Bool+htmlElemHasID x y = htmlElemID y == Just x++-- | Searches for an element with an id.+htmlElemFindID :: Text -> HTMLNode -> Maybe HTMLNode+htmlElemFindID x = htmlElemSearch $ htmlElemHasID x++-- | Gets the id attribute for an element.+htmlElemClass :: HTMLNode -> Maybe Text+htmlElemClass = htmlElemGetAttr "class"++-- | Sets the class attribute for an element.+htmlElemClassSet :: Text -> HTMLNode -> HTMLNode+htmlElemClassSet = htmlElemSetAttr "class"++-- | Gets the element classes.+htmlElemClasses :: HTMLNode -> Set Text+htmlElemClasses = maybe Set.empty (Set.fromList . T.words) . htmlElemClass++-- | Sets the element classes.+htmlElemClassesSet :: Set Text -> HTMLNode -> HTMLNode+htmlElemClassesSet s = htmlElemClassSet (T.unwords $ Set.toList s)++-- | Adds the class to the element's classes.+htmlElemClassesAdd :: Text -> HTMLNode -> HTMLNode+htmlElemClassesAdd c x =+  htmlElemClassesSet (Set.insert c $ htmlElemClasses x) x++-- | Removes a class from the element's classes.+htmlElemClassesRemove :: Text -> HTMLNode -> HTMLNode+htmlElemClassesRemove c x =+  htmlElemClassesSet (Set.delete c $ htmlElemClasses x) x++-- | Determines if the element contains a class.+htmlElemClassesContains :: Text -> HTMLNode -> Bool+htmlElemClassesContains c = Set.member c . htmlElemClasses++-- | Gets the style attribute for an element.+htmlElemStyle :: HTMLNode -> Maybe Text+htmlElemStyle = htmlElemGetAttr "style"++-- | Gets the styles for an element.+htmlElemStyles :: HTMLNode -> Map Text Text+htmlElemStyles =+  maybe Map.empty parse . htmlElemStyle+  where+    parse =+      ( Map.fromList+      . map+        ( first T.strip+        . second T.strip+        . second (T.drop 1)+        . T.breakOn ":"+        )+      . filter (not . T.null)+      . map T.strip+      . T.splitOn ";"+      )++-- | Parses and returns a url style value.+htmlElemStyleParseURL :: Text -> Maybe Text+htmlElemStyleParseURL x+  | "url" `T.isPrefixOf` x =+      ( T.strip+      . T.dropAround (=='\'')+      -- Only a stylesheet can have a double quote, but we check for it anyway.+      . T.dropAround (=='\"')+      . T.strip+      ) <$> textExtract "(" ")" x+  | otherwise = Nothing++-- | Gets the children for the element if the node is an element.+htmlElemContent :: HTMLNode -> [HTMLNode]+htmlElemContent (HTMLElement _ _ _ c) = c+htmlElemContent _ = []++-- | Sets the content for an element.+htmlElemContentSet :: [HTMLNode] -> HTMLNode -> HTMLNode+htmlElemContentSet x (HTMLElement n s a c) = HTMLElement n s a x+htmlElemContentSet x y = y++-- | Determines if the element has children.+htmlElemHasContent :: HTMLNode -> Bool+htmlElemHasContent (HTMLElement _ _ _ []) = False+htmlElemHasContent (HTMLElement _ _ _ (x:xs)) = True+htmlElemHasContent _ = False++-- | Gets the first child for an element.+htmlElemNodeFirst :: HTMLNode -> Maybe HTMLNode+htmlElemNodeFirst = listToMaybe . htmlElemContent++-- | Gets the last child for an element.+htmlElemNodeLast :: HTMLNode -> Maybe HTMLNode+htmlElemNodeLast =  listToMaybe . reverse . htmlElemContent++-- | Gets the number of children for an element.+htmlElemNodeCount :: HTMLNode -> Int+htmlElemNodeCount = length . htmlElemContent++-- | Gets the name of an element.+htmlElemName :: HTMLNode -> Text+htmlElemName (HTMLElement n _ _ _) = n+htmlElemName _ = T.empty++-- | Checks if the name of an element matches a specified name.+htmlElemHasName :: Text -> HTMLNode -> Bool+htmlElemHasName x y = htmlElemName y == x++-- | Sets the name of an element.+htmlElemRename :: Text -> HTMLNode -> HTMLNode+htmlElemRename n (HTMLElement _ s a c) = HTMLElement n s a c+htmlElemRename n x = x++-- | Finds a child element using a predicate.+htmlElemFindElem :: (HTMLNode -> Bool) -> HTMLNode -> Maybe HTMLNode+htmlElemFindElem p (HTMLElement _ _ _ c) = find p c+htmlElemFindElem _ _ = Nothing++-- | Finds a child element with a specified name.+htmlElemFindElemNamed :: Text -> HTMLNode -> Maybe HTMLNode+htmlElemFindElemNamed x = htmlElemFindElem $ htmlElemHasName x++-- | Determines if an element has a child.+htmlElemHasElem :: (HTMLNode -> Bool) -> HTMLNode -> Bool+htmlElemHasElem p = isJust . htmlElemFindElem p++-- | Determines if an element has a child.+htmlElemHasElemNamed :: Text -> HTMLNode -> Bool+htmlElemHasElemNamed x = isJust . htmlElemFindElemNamed x++-- | Modifies an elements children by applying a function.+htmlElemContentApply :: ([HTMLNode] -> [HTMLNode]) -> HTMLNode -> HTMLNode+htmlElemContentApply f (HTMLElement n s a c) = HTMLElement n s a $ f c+htmlElemContentApply _ x = x++-- | Modifies an elements children by mapping a function over them.+htmlElemContentMap :: (HTMLNode -> HTMLNode) -> HTMLNode -> HTMLNode+htmlElemContentMap f = htmlElemContentApply $ map f++-- | Modifies an elements children by filtering them.+htmlElemContentFilter :: (HTMLNode -> Bool) -> HTMLNode -> HTMLNode+htmlElemContentFilter f = htmlElemContentApply $ filter f++-- | Finds an element using a depth-first search.+htmlElemSearch :: (HTMLNode -> Bool) -> HTMLNode -> Maybe HTMLNode+htmlElemSearch f x = case x of+  HTMLElement _ _ _ c ->+    if f x then Just x else firstJust (htmlElemSearch f) c+  _otherwise -> Nothing++-- | Gets the text content for an element.+htmlElemText :: HTMLNode -> Maybe Text+htmlElemText (HTMLElement n s a c) =+  case filter htmlNodeIsText c of+    a@(x:xs) -> Just . T.concat . map htmlTextData $ a+    [] -> Nothing+htmlElemText _ = Nothing++-- | Finds the html element given a document.+htmlDocHtml :: HTMLNode -> Maybe HTMLNode+htmlDocHtml = htmlNodeFind $ htmlElemHasName "html"++-- | Finds the body element given a document.+htmlDocBody :: HTMLNode -> Maybe HTMLNode+htmlDocBody = htmlDocHtml >=> htmlElemFindElemNamed "body"++-- | Finds the head element given a document.+htmlDocHead :: HTMLNode -> Maybe HTMLNode+htmlDocHead = htmlDocHtml >=> htmlElemFindElemNamed "head"++-- | Finds the title for a document.+htmlDocTitle :: HTMLNode -> Maybe Text+htmlDocTitle = htmlDocHead+  >=> htmlElemFindElemNamed "title"+  >=> htmlElemText++-- | Maps a function over all the elements defined by a node.+htmlMapElem :: (HTMLNode -> HTMLNode) -> HTMLNode -> HTMLNode+htmlMapElem f = runIdentity . htmlMapElemM (pure . f)++-- | Maps a function over all the elements defined by a node.+htmlMapElemM :: Monad m => (HTMLNode -> m HTMLNode) -> HTMLNode -> m HTMLNode++-- htmlMapElemM f x@(HTMLElement {}) = do+--   HTMLElement n s a c <- f x+--   HTMLElement n s a <$> mapM (htmlMapElemM f) c+-- htmlMapElemM f x = pure x++htmlMapElemM f x =+  case x of+    HTMLElement {} -> do+      a <- f x+      case a of+        HTMLElement n s a c ->+          HTMLElement n s a <$> mapM (htmlMapElemM f) c+        _otherwise ->+          pure a+    _otherwise ->+      pure x++-- | Collapses a tree of elements based on a predicate.+htmlElemCollapse :: (HTMLNode -> Bool) -> HTMLNode -> [HTMLNode]+htmlElemCollapse f = runIdentity . htmlElemCollapseM (pure . f)++-- | Collapses a tree of elements based on a predicate.+htmlElemCollapseM :: Monad m => (HTMLNode -> m Bool) -> HTMLNode -> m [HTMLNode]+htmlElemCollapseM f x@(HTMLElement n s a c) = do+  c' <- concatMapM (htmlElemCollapseM f) c+  ifM (f x) (pure c') $ pure [ HTMLElement n s a c' ]+htmlElemCollapseM _ x = pure [x]
+ src/Zenacy/HTML/Internal/Parser.hs view
@@ -0,0 +1,3290 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | The HTML parser.+module Zenacy.HTML.Internal.Parser+  ( Parser(..)+  , ParserOptions(..)+  , ParserResult(..)+  , parseDocument+  , parseFragment+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Buffer+import Zenacy.HTML.Internal.Char+import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.DOM+import Zenacy.HTML.Internal.Lexer+import Zenacy.HTML.Internal.Token+import Zenacy.HTML.Internal.Types++import Control.Applicative+  ( liftA+  )+import Control.Monad+  ( when+  , unless+  , void+  )+import Control.Monad.Extra+  ( (||^)+  , (&&^)+  , anyM+  , notM+  , whenM+  , whenJustM+  , unlessM+  )+import Control.Monad.ST+  ( ST+  , runST+  )+import Data.Default+  ( Default(..)+  )+import Data.DList+  ( DList+  )+import qualified Data.DList as D+  ( append+  , empty+  , snoc+  , toList+  )+import Data.IntMap+  ( IntMap+  )+import qualified Data.IntMap as IntMap+  ( findWithDefault+  , lookup+  , insert+  , map+  , mapWithKey+  )+import Data.List+  ( find+  )+import Data.Map+  ( Map+  )+import qualified Data.Map as Map+  ( fromList+  , lookup+  )+import Data.Maybe+  ( fromJust+  , isJust+  , isNothing+  , listToMaybe+  , mapMaybe+  )+import Data.Monoid+  ( (<>)+  )+import Data.Sequence+  ( Seq+  )+import qualified Data.Sequence as Seq+  ( fromList+  )+import Data.Set+  ( Set+  )+import qualified Data.Set as Set+  ( fromList+  , member+  , notMember+  , union+  , unions+  )+import Data.STRef+  ( STRef+  , newSTRef+  , readSTRef+  , writeSTRef+  )+import Data.Word+  ( Word8+  )++-- | Parser processing state.+data Parser s = Parser+  { parserLexer             :: STRef s (Lexer s)+  -- ^ The lexer for token generation.+  , parserDOM               :: STRef s DOM+  -- ^ The parser DOM.+  , parserElementStack      :: STRef s [DOMID]+  -- ^ The element stack (section 12.2.3.2).+  , parserActiveFormatList  :: STRef s [ParserFormatItem]+  -- ^ The list of action formatting elements (section 12.2.3.3).+  , parserInsertionMode     :: STRef s ParserMode+  -- ^ The current insertion mode.+  , parserOriginalMode      :: STRef s ParserMode+  -- ^ The original insertion mode.+  , parserTemplateMode      :: STRef s [ParserMode]+  -- ^ The template insertion mode.+  , parserContextElement    :: STRef s (Maybe DOMID)+  -- ^ The context element.+  , parserHeadElement       :: STRef s (Maybe DOMID)+  -- ^ The head element pointer (section 12.2.3.4).+  , parserFormElement       :: STRef s (Maybe DOMID)+  -- ^ The form element pointer (section 12.2.3.4).+  , parserSelfClosingFlag   :: STRef s Bool+  -- ^ The self closing acknowledges flag.+  , parserFragmentMode      :: STRef s Bool+  -- ^ The flag indicating parser is in fragment mode.+  , parserFosterParenting   :: STRef s Bool+  -- ^ The foster parenting flag.+  , parserFrameSetOK        :: STRef s Bool+  -- ^ The frame-set ok flag (section 12.2.3.5).+  , parserDone              :: STRef s Bool+  -- ^ The parser done flag.+  , parserTableChars        :: STRef s [Token]+  -- ^ The pending table characters.+  , parserAdoptionAgency    :: STRef s (ParserAdoptionAgency s)+  -- ^ The adoption agency state.+  , parserErrors            :: STRef s (DList BS)+  -- ^ The parser errors.+  , parserIFrameSrcDoc      :: STRef s Bool+  -- ^ Indicates that the documnet is an iframe srcdoc.+  , parserTextMap           :: STRef s (IntMap (STRef s (Buffer s)))+  -- ^ Map of buffers for holding dom strings.+  , parserLogErrors         :: Bool+  -- ^ Flag to log errors.+  }++-- | Defines the parser mode.+data ParserMode+  = ModeInitial+  | ModeBeforeHtml+  | ModeBeforeHead+  | ModeInHead+  | ModeInHeadNoscript+  | ModeAfterHead+  | ModeInBody+  | ModeText+  | ModeInTable+  | ModeInTableText+  | ModeInCaption+  | ModeInColumnGroup+  | ModeInTableBody+  | ModeInRow+  | ModeInCell+  | ModeInSelect+  | ModeInSelectInTable+  | ModeInTemplate+  | ModeAfterBody+  | ModeInFrameset+  | ModeAfterFrameset+  | ModeAfterAfterBody+  | ModeAfterAfterFrameset+    deriving (Eq, Ord, Show)++-- | Parser options type.+data ParserOptions = ParserOptions+  { parserOptionInput          :: BS+  -- ^ The input to the lexer.+  , parserOptionLogErrors      :: Bool+  -- ^ Indicates whether warnings are logged.+  , parserOptionIgnoreEntities :: Bool+  -- ^ Indicates that entities should not be tokenized.+  } deriving (Eq, Ord, Show)++-- | Parser result type.+data ParserResult = ParserResult+  { parserResultDOM    :: DOM+  , parserResultErrors :: [BS]+  } deriving (Eq, Ord, Show)++-- | Defines an item in the list of active formatting elements.+data ParserFormatItem+  = ParserFormatElement DOMID Token+  | ParserFormatMarker+    deriving (Eq, Ord, Show)++-- | Defines element categories.+data ParserElementCategory+  = ElementCategorySpecial+  | ElementCategoryFormatting+  | ElementCategoryOrdinary+    deriving (Eq, Ord, Show)++-- | Defines detailed information for stack elements.+data ElementDetails = ElementDetails+  { elementDetailsIndex :: Int+  , elementDetailsID    :: DOMID+  , elementDetailsNode  :: DOMNode+  , elementDetailsType  :: DOMType+  } deriving (Eq, Ord, Show)++-- | Default instance for parser options.+instance Default ParserOptions where+  def = ParserOptions+    { parserOptionInput          = bsEmpty+    , parserOptionLogErrors      = False+    , parserOptionIgnoreEntities = False+    }++-- | Default instance for parser results.+instance Default ParserResult where+  def = ParserResult+    { parserResultDOM    = def+    , parserResultErrors = []+    }++-- | Parses an HTML document.+parseDocument :: ParserOptions -> Either BS ParserResult+parseDocument x =+  runST $ do+    parserNew x >>= \case+      Right p -> Right <$> parserRun p+      Left e -> Left <$> pure e++-- | Parses an HTML fragment.+parseFragment :: ParserOptions -> Either BS ParserResult+parseFragment x = Left "fragment support not yet implemented"++-- | Makes a new lexer.+parserNew :: ParserOptions -> ST s (Either BS (Parser s))+parserNew o@ParserOptions{..} = do+  a <- lexerNew def+    { lexerOptionInput          = parserOptionInput+    , lexerOptionLogErrors      = parserOptionLogErrors+    , lexerOptionIgnoreEntities = parserOptionIgnoreEntities+    }+  case a of+    Right lex -> Right <$> parserMake o lex+    Left err  -> Left <$> pure err++-- | Makes a new lexer.+parserMake :: ParserOptions -> Lexer s -> ST s (Parser s)+parserMake ParserOptions{..} lexer = do+  lexerRef <- newSTRef lexer+  dom      <- newSTRef def+  stack    <- newSTRef []+  fmtList  <- newSTRef []+  insMode  <- newSTRef ModeInitial+  orgMode  <- newSTRef ModeInitial+  tmpMode  <- newSTRef []+  ctxElem  <- newSTRef Nothing+  headElem <- newSTRef Nothing+  formElem <- newSTRef Nothing+  closing  <- newSTRef False+  fragMode <- newSTRef False+  foster   <- newSTRef False+  frameSet <- newSTRef True+  done     <- newSTRef False+  table    <- newSTRef []+  aa       <- defaultAA+  aaRef    <- newSTRef aa+  warn     <- newSTRef def+  iframe   <- newSTRef False+  textMap  <- newSTRef def+  pure $ Parser+    { parserLexer             = lexerRef+    , parserDOM               = dom+    , parserElementStack      = stack+    , parserActiveFormatList  = fmtList+    , parserInsertionMode     = insMode+    , parserOriginalMode      = orgMode+    , parserTemplateMode      = tmpMode+    , parserContextElement    = ctxElem+    , parserHeadElement       = headElem+    , parserFormElement       = formElem+    , parserSelfClosingFlag   = closing+    , parserFragmentMode      = fragMode+    , parserFosterParenting   = foster+    , parserFrameSetOK        = frameSet+    , parserDone              = done+    , parserTableChars        = table+    , parserAdoptionAgency    = aaRef+    , parserErrors            = warn+    , parserIFrameSrcDoc      = iframe+    , parserTextMap           = textMap+    , parserLogErrors         = parserOptionLogErrors+    }++-- | The parser main loop.+parserRun :: Parser s -> ST s ParserResult+parserRun p @ Parser {..} = do+  rref parserDone >>= \case+    True -> do+      Lexer{..} <- rref parserLexer+      e <- D.append <$> rref lexerErrors <*> rref parserErrors+      d <- textMapDOM p+      pure $ ParserResult d $ D.toList e+    False -> do+      t <- rref parserLexer >>= lexerNext+      selfClosingInit p t+      dispatchTreeConstruction p t+      whenM (selfClosingFlag p) $+        parseError p (Just t) "self closing not acknowledged for token"+      parserRun p++-- | Handles tree construction dispatch.+dispatchTreeConstruction :: Parser s -> Token -> ST s ()+dispatchTreeConstruction p @ Parser {..} t = do+  e <- elementStackEmpty p+  a <- adjustedCurrentNode p+  b <- pure $ case a of+    Just n -> domNodeIsHTML n+      || isMathMLIntegrationPoint n+         && isTokenStartNotNamed t ["mglyph", "malignmark"]+      || isMathMLIntegrationPoint n && tokenIsChar t+      || isMathMLElementNamed n "annotation-xml"+         && isTokenStartNamed t ["svg"]+      || isHtmlIntgrationPoint n && tokenIsStart t+      || isHtmlIntgrationPoint n && tokenIsChar t+    Nothing -> False+  if e || b || tokenIsEOF t+     then doHtmlContent p t+     else doForeignContent p t+  where+    tokenIsChar TChar {} = True+    tokenIsChar _ = False+    tokenIsStart TStart {} = True+    tokenIsStart _ = False+    tokenIsEOF TEOF = True+    tokenIsEOF _ = False++-- | Processes a token as HTML content.+doHtmlContent :: Parser s -> Token -> ST s ()+doHtmlContent p @ Parser {..} t = do+  m <- rref parserInsertionMode+  parserInserter m p t++-- | Reprocesses a token.+reprocess :: Parser s -> Token -> ST s ()+reprocess = doHtmlContent++-- | Gets the inserter for a parser mode.+parserInserter :: ParserMode -> Parser s -> Token -> ST s ()+parserInserter = \case+  ModeInitial            -> doModeInitial+  ModeBeforeHtml         -> doModeBeforeHtml+  ModeBeforeHead         -> doModeBeforeHead+  ModeInHead             -> doModeInHead+  ModeInHeadNoscript     -> doModeInHeadNoscript+  ModeAfterHead          -> doModeAfterHead+  ModeInBody             -> doModeInBody+  ModeText               -> doModeText+  ModeInTable            -> doModeInTable+  ModeInTableText        -> doModeInTableText+  ModeInCaption          -> doModeInCaption+  ModeInColumnGroup      -> doModeInColumnGroup+  ModeInTableBody        -> doModeInTableBody+  ModeInRow              -> doModeInRow+  ModeInCell             -> doModeInCell+  ModeInSelect           -> doModeInSelect+  ModeInSelectInTable    -> doModeInSelectInTable+  ModeInTemplate         -> doModeInTemplate+  ModeAfterBody          -> doModeAfterBody+  ModeInFrameset         -> doModeInFrameset+  ModeAfterFrameset      -> doModeAfterFrameset+  ModeAfterAfterBody     -> doModeAfterAfterBody+  ModeAfterAfterFrameset -> doModeAfterAfterFrameset++-- | Handles parse errors.+parseError :: Parser s -> Maybe Token -> BS -> ST s ()+parseError p @ Parser {..} t s =+  when parserLogErrors $+    uref parserErrors $ flip D.snoc e+  where+    e = s <> case t of+      Just (TDoctype {..}) -> ",doctype"+      Just (TStart {..})   -> ",tag-start," <> tStartName+      Just (TEnd {..})     -> ",tag-end," <> tEndName+      Just (TComment {..}) -> ",comment"+      Just (TChar {..})    -> ",chr," <> bsOnly tCharData+      Just TEOF           -> ",eof"+      Nothing             -> bsEmpty++-- | Detmermines if a token is a start token with a specified name.+isTokenStartNamed :: Token -> [BS] -> Bool+isTokenStartNamed TStart {..} names = tStartName `elem` names+isTokenStartNamed _ _ = False++-- | Detmermines if a token is a start token without a specified name.+isTokenStartNotNamed :: Token -> [BS] -> Bool+isTokenStartNotNamed TStart {..} names = not $ tStartName `elem` names+isTokenStartNotNamed _ _ = False++-- | Detmermines if a token is an end token with a specified name.+isTokenEndNamed :: Token -> [BS] -> Bool+isTokenEndNamed TEnd {..} names = tEndName `elem` names+isTokenEndNamed _ _ = False++-- | Detmermines if a token is an end token without a specified name.+isTokenEndNotNamed :: Token -> [BS] -> Bool+isTokenEndNotNamed TEnd {..} names = not $ tEndName `elem` names+isTokenEndNotNamed _ _ = False++-- | Determines if a node name matches a name.+elementName :: BS -> DOMNode -> Bool+elementName x y = domNodeElementName y == x++-- | Determines if a node name does not match a name.+elementNameNot :: BS -> DOMNode -> Bool+elementNameNot x = not . elementName x++-- | Determines if a node name is in a set of names.+elementNameIn :: [BS] -> DOMNode -> Bool+elementNameIn x y = domNodeElementName y `elem` x++-- | Determines if a node name is not in a set of names.+elementNameNotIn :: [BS] -> DOMNode -> Bool+elementNameNotIn x = not . elementNameIn x++-- | Gets the current element stack.+elementStack :: Parser s -> ST s [DOMID]+elementStack Parser {..} = readSTRef parserElementStack++-- | Detmermines if the element stack is empty.+elementStackEmpty :: Parser s -> ST s Bool+elementStackEmpty p @ Parser {..} = null <$> elementStack p++-- | Returns the size of the element stack.+elementStackSize :: Parser s -> ST s Int+elementStackSize p @ Parser {..} = length <$> elementStack p++-- | Modifies the element stack by applying a function.+elementStackModify :: Parser s -> ([DOMID] -> [DOMID]) -> ST s ()+elementStackModify p @ Parser {..} f = uref parserElementStack f++-- | Pushes an element on the element stack.+elementStackPush :: Parser s -> DOMID -> ST s ()+elementStackPush p @ Parser {..} x = elementStackModify p $ (x:)++-- | Pops an element off of the element stack.+elementStackPop :: Parser s -> ST s ()+elementStackPop p @ Parser {..} = elementStackModify p $ drop 1++-- | Pops nodes from the element stack while a predicate is true.+elementStackPopWhile :: Parser s -> (DOMNode -> Bool) -> ST s ()+elementStackPopWhile p @ Parser {..} f =+  currentNode p >>= \case+    Just a | f a -> elementStackPop p >> elementStackPopWhile p f+    _ -> pure ()++-- | Pops a nodes from the element stack if a predicate is true.+elementStackPopIf :: Parser s -> (DOMNode -> Bool) -> ST s ()+elementStackPopIf p @ Parser {..} f =+  currentNode p >>= \case+    Just a | f a -> elementStackPop p+    _ -> pure ()++-- | Pops elements from the stack until a specified element has been popped.+elementStackPopUntil :: Parser s -> (DOMType -> Bool) -> ST s ()+elementStackPopUntil p @ Parser {..} f = do+  elementStackPopWhile p (not . g)+  elementStackPopIf p g+  where+    g = f . domNodeType++-- | Pops elements from the stack until a specified ID has been popped.+elementStackPopUntilID :: Parser s -> DOMID -> ST s ()+elementStackPopUntilID p x = elementStackModify p $ drop 1 . dropWhile (/=x)++-- | Pops elements from the stack until a specified element has been popped.+elementStackPopUntilType :: Parser s -> DOMType -> ST s ()+elementStackPopUntilType p x = elementStackPopUntil p (==x)++-- | Pops elements from the stack until a specified element has been popped.+elementStackPopUntilTypeIn :: Parser s -> [DOMType] -> ST s ()+elementStackPopUntilTypeIn p x = elementStackPopUntil p $ flip elem x++-- | Gets the current element stack as a list of nodes.+elementStackNodes :: Parser s -> ST s [DOMNode]+elementStackNodes p = domMapID <$> getDOM p <*> elementStack p++-- | Gets the current element stack as a list of types.+elementStackTypes :: Parser s -> ST s [DOMType]+elementStackTypes p = map domNodeType <$> elementStackNodes p++-- | Applies a predicate to the element stack and returns whether+-- any element in the stack results in a true predicate.+elementStackAny :: Parser s -> (DOMNode -> Bool) -> ST s Bool+elementStackAny p f = any f <$> elementStackNodes p++-- | Applies a predicate to the element stack and returns whether+-- all elements in the stack result in a true predicate.+elementStackAll :: Parser s -> (DOMNode -> Bool) -> ST s Bool+elementStackAll p f = all f <$> elementStackNodes p++-- | Determines if the second element on the stack is a body element.+elementStackHasBody :: Parser s -> ST s Bool+elementStackHasBody p =+  liftA reverse (elementStackTypes p) >>= pure . \case+    (_:x:_)    -> x == domMakeTypeHTML "body"+    _otherwise -> False++-- | Determines if the element stack has a template element.+elementStackHasTemplate :: Parser s -> ST s Bool+elementStackHasTemplate p = elementStackAny p domNodeIsTemplate++-- | Determines if the element stack does not have any template elements.+elementStackMissingTemplate :: Parser s -> ST s Bool+elementStackMissingTemplate p = elementStackAll p $ not . domNodeIsTemplate++-- | Removes a node ID from the element stack.+elementStackRemove :: Parser s -> DOMID -> ST s ()+elementStackRemove p x = elementStackModify p $ filter (/=x)++-- | Replaces an ID in the element stack with another ID.+elementStackReplace :: Parser s -> DOMID -> DOMID -> ST s ()+elementStackReplace p x y =+  elementStackModify p $ map (\i -> if i == x then y else i)++-- | Finds the successor for an entry in the element stack.+elementStackSucc :: Parser s -> DOMID -> ST s (Maybe DOMID)+elementStackSucc p x = findSucc (==x) <$> elementStack p++-- | Inserts a node before another node in the element stack.+elementStackInsertBefore :: Parser s -> DOMID -> DOMID -> ST s ()+elementStackInsertBefore p x y = elementStackModify p $ insertBefore (==x) y++-- | Gets the element stack details.+elementStackDetails :: Parser s -> ST s [ElementDetails]+elementStackDetails p = g <$> getDOM p <*> elementStack p+  where+    g d x = mapMaybe (f d) $ zip [1..] x+    f d (i, x) =+      case domGetNode d x of+        Nothing -> Nothing+        Just a -> Just $ ElementDetails i x a $ domNodeType a++-- | Finds element stack details.+elementStackFind :: Parser s -> (ElementDetails -> Bool) -> ST s (Maybe ElementDetails)+elementStackFind p f = liftA (find f) $ elementStackDetails p++-- | Special element types.+elementTypesSpecial :: Set DOMType+elementTypesSpecial = Set.unions+  [ Set.fromList $ domTypesHTML+    [ "address", "applet", "area", "article", "aside",+      "base", "basefont", "bgsound", "blockquote", "body",+      "br", "button", "caption", "center", "col", "colgroup",+      "dd", "details", "dir", "div", "dl", "dt", "embed",+      "fieldset", "figcaption", "figure", "footer", "form",+      "frame", "frameset", "h1", "h2", "h3", "h4", "h5", "h6",+      "head", "header", "hgroup", "hr", "html", "iframe",+      "img", "input", "isindex", "li", "link", "listing",+      "main", "marquee", "menu", "menuitem", "meta", "nav",+      "noembed", "noframes", "noscript", "object", "ol",+      "p", "param", "plaintext", "pre", "script", "section",+      "select", "source", "style", "summary", "table",+      "tbody", "td", "template", "textarea", "tfoot",+      "th", "thead", "title", "tr", "track", "ul", "wbr" ]+  , Set.fromList $ domTypesMathML+    [ "mi", "mo", "mn", "ms", "mtext", "annotation-xml" ]+  , Set.fromList $ domTypesSVG+    [ "foreignObject", "desc", "title" ]+  ]++-- | Formatting element types.+elementTypesFormatting :: Set DOMType+elementTypesFormatting =+  Set.fromList $ domTypesHTML+  [ "a", "b", "big", "code", "em", "font", "i", "nobr",+    "s", "small", "strike", "strong", "tt", "u"]++-- | Returns the element category for an element type.+elementCategory :: DOMType -> ParserElementCategory+elementCategory x+  | Set.member x elementTypesSpecial = ElementCategorySpecial+  | Set.member x elementTypesFormatting = ElementCategoryFormatting+  | otherwise = ElementCategoryOrdinary++-- | Detmermines if an element is in the special category.+elementIsSpecial :: DOMType -> Bool+elementIsSpecial x = elementCategory x == ElementCategorySpecial++-- | Determines if an element is in specific scope.+-- Algorithm from section 12.2.3.2 is specification.+elementInSpecificScope :: Parser s -> Bool -> Set DOMType -> DOMType -> ST s Bool+elementInSpecificScope p include types target =+  f <$> elementStackTypes p+  where+    f :: [DOMType] -> Bool+    f [] = False+    f (x:xs)+      | x == target = True+      | include == True && Set.member x types == True = False+      | include == False && Set.member x types == False = False+      | otherwise = f xs++-- | Default element scopes.+elementScopes :: Set DOMType+elementScopes = Set.unions+  [ Set.fromList $ domTypesHTML+    [ "applet", "caption", "html", "table", "td", "th"+    , "marquee", "object", "template" ]+  , Set.fromList $ domTypesMathML+    [ "mi", "mo", "mn", "ms", "mtext", "annotation-xml" ]+  , Set.fromList $ domTypesSVG+    [ "foreignObject", "desc", "title" ]+  ]++-- | Determines if an element is in scope.+elementInScope :: Parser s -> DOMType -> ST s Bool+elementInScope p = elementInSpecificScope p True elementScopes++-- | Determines if an element is in list scope.+elementInListScope :: Parser s -> DOMType -> ST s Bool+elementInListScope p =+  elementInSpecificScope p True $+    Set.union elementScopes $ Set.fromList $+      domTypesHTML [ "ol", "ul" ]++-- | Determines if an element is in button scope.+elementInButtonScope :: Parser s -> DOMType -> ST s Bool+elementInButtonScope p =+  elementInSpecificScope p True $+    Set.union elementScopes $ Set.fromList [ domMakeTypeHTML "button" ]++-- | Determines if an element is in table scope.+elementInTableScope :: Parser s -> DOMType -> ST s Bool+elementInTableScope p =+  elementInSpecificScope p True $+    Set.fromList $ domTypesHTML [ "html", "table", "template" ]++-- | Determines if an element is in select scope.+elementInSelectScope :: Parser s -> DOMType -> ST s Bool+elementInSelectScope p =+  elementInSpecificScope p False $+    Set.fromList $ domTypesHTML [ "optgroup", "option" ]++-- | Creates a new ID for a node.+newID :: Parser s -> DOMNode -> ST s DOMID+newID p x = do+  (d, i) <- flip domNewID x <$> getDOM p+  setDOM p d+  pure i++-- | Converts a node ID to a node.+getNode :: Parser s -> DOMID -> ST s (Maybe DOMNode)+getNode p @ Parser {..} x = flip domGetNode x <$> getDOM p++-- -- | Gets the element name for a node ID.+nodeElementName :: Parser s -> DOMID -> ST s BS+nodeElementName p @ Parser {..} x = do+  d <- getDOM p+  pure $ case domGetNode d x of+    Just a -> domNodeElementName a+    Nothing -> bsEmpty++-- | Gets the last node ID.+lastNodeID :: Parser s -> ST s (Maybe DOMID)+lastNodeID p @ Parser {..} = listToMaybe . reverse <$> elementStack p++-- | Gets the current node ID.+currentNodeID :: Parser s -> ST s (Maybe DOMID)+currentNodeID p @ Parser {..} = listToMaybe <$> elementStack p++-- | Gets the current node.+currentNode :: Parser s -> ST s (Maybe DOMNode)+currentNode p = currentNodeID p >>= maybe (pure Nothing) (getNode p)++-- | Determines if the current node has a specified type.+currentNodeHasType :: Parser s -> DOMType -> ST s Bool+currentNodeHasType p x =+  currentNode p >>= pure . \case+    Just a -> domNodeType a == x+    Nothing -> False++-- | Determines if the current node has a specified type.+currentNodeHasHTMLType :: Parser s -> BS -> ST s Bool+currentNodeHasHTMLType p = currentNodeHasType p . domMakeTypeHTML++-- | Determines if the current node has a specified type.+currentNodeHasTypeIn :: Parser s -> [DOMType] -> ST s Bool+currentNodeHasTypeIn p x =+  currentNode p >>= pure . \case+    Just a -> domNodeType a `elem` x+    Nothing -> False++-- | Determines if the current node has a specified type.+currentNodeHasHTMLTypeIn :: Parser s -> [BS] -> ST s Bool+currentNodeHasHTMLTypeIn p = currentNodeHasTypeIn p . domTypesHTML++-- | Gets the adjusted current node ID.+adjustedCurrentNodeID :: Parser s -> ST s (Maybe DOMID)+adjustedCurrentNodeID p @ Parser {..} = do+  f <- rref parserFragmentMode+  n <- elementStackSize p+  if f && n == 1+     then rref parserContextElement+     else currentNodeID p++-- | Gets the adjusted current node.+adjustedCurrentNode :: Parser s -> ST s (Maybe DOMNode)+adjustedCurrentNode p =+  adjustedCurrentNodeID p >>= maybe (pure Nothing) (getNode p)++-- | Determines if a node is a named MathML element.+isMathMLElementNamed :: DOMNode -> BS -> Bool+isMathMLElementNamed x n = domNodeIsMathML x && domElementName x == n++-- | Determines if a node is a MathML integration point.+isMathMLIntegrationPoint :: DOMNode -> Bool+isMathMLIntegrationPoint x+  | domNodeIsElement x =+      domNodeIsMathML x && Set.member (domElementName x) s+  | otherwise =+      False+  where+    s = Set.fromList [ "mi", "mo", "mn", "ms", "mtext" ]++-- | Determines if a node is a MathML integration point.+isHtmlIntgrationPoint :: DOMNode -> Bool+isHtmlIntgrationPoint x+  | domNodeIsElement x = s || m+  | otherwise = False+  where+    s = domNodeIsSVG x+        && Set.member (domElementName x) s0+    m = domNodeIsMathML x+        && domElementName x == "annotation-xml"+        && case domElementFindAttr x "encoding" of+             Just (DOMAttr n v s) ->+               Set.member (bsLower v) s1+             _otherwise -> False+    s0 = Set.fromList [ "foreignObject", "desc", "title" ]+    s1 = Set.fromList [ "text/html", "application/xhtml+xml" ]++-- | Gets the DOM.+getDOM :: Parser s -> ST s DOM+getDOM Parser {..} = rref parserDOM++-- | Sets the DOM.+setDOM :: Parser s -> DOM -> ST s ()+setDOM Parser {..} = wref parserDOM++-- | Modifies the DOM.+modifyDOM :: Parser s -> (DOM -> DOM) -> ST s ()+modifyDOM p @ Parser {..} = uref parserDOM++-- | Sets the insertion mode.+setMode :: Parser s -> ParserMode -> ST s ()+setMode Parser {..} = wref parserInsertionMode++-- | Saves the mode as the original mode.+saveMode :: Parser s -> ST s ()+saveMode Parser {..} = rref parserInsertionMode >>= wref parserOriginalMode++-- | Restore the insertion mode from the saved original mode.+restoreMode :: Parser s -> ST s ()+restoreMode Parser {..} = do+  rref parserOriginalMode >>= wref parserInsertionMode+  wref parserOriginalMode ModeInitial++-- | Sets the current head element.+setHeadID :: Parser s -> Maybe DOMID -> ST s ()+setHeadID Parser {..} = wref parserHeadElement++-- | Gets the current head element.+getHeadID :: Parser s -> ST s (Maybe DOMID)+getHeadID Parser {..} = rref parserHeadElement++-- | Gets the current head element.+getHeadElement :: Parser s -> ST s (Maybe DOMNode)+getHeadElement p = getHeadID p >>= maybe (pure Nothing) (getNode p)++-- | Saves the current node as the head element.+saveHead :: Parser s -> ST s ()+saveHead p = currentNodeID p >>= setHeadID p++-- | Sets the current form element.+setFormID :: Parser s -> Maybe DOMID -> ST s ()+setFormID Parser {..} = wref parserFormElement++-- | Gets the current form element ID.+getFormID :: Parser s -> ST s (Maybe DOMID)+getFormID Parser {..} = rref parserFormElement++-- | Gets the current form element.+getFormElement :: Parser s -> ST s (Maybe DOMNode)+getFormElement p = getFormID p >>= maybe (pure Nothing) (getNode p)++-- | Gets the current form element type.+getFormType :: Parser s -> ST s (Maybe DOMType)+getFormType p @ Parser {..} =+  getFormElement p >>= pure . maybe Nothing (Just . domNodeType)++-- | Saves the current node as the form element.+saveForm :: Parser s -> ST s ()+saveForm p = currentNodeID p >>= setFormID p++-- | Determines if the form element reference is defined.+formNotNull :: Parser s -> ST s Bool+formNotNull p = isJust <$> getFormID p++-- | Initializes the self closing flag.+selfClosingInit :: Parser s -> Token -> ST s ()+selfClosingInit p @ Parser {..} t =+  wref parserSelfClosingFlag $+    case t of+      TStart {..} -> tStartClosed+      _otherwise -> False++-- | Acknowledges the parser self closing flag.+selfClosingAcknowledge :: Parser s -> ST s ()+selfClosingAcknowledge Parser {..} = wref parserSelfClosingFlag False++-- | Gets the self closing flag.+selfClosingFlag :: Parser s -> ST s Bool+selfClosingFlag Parser {..} = rref parserSelfClosingFlag++-- | Gets the foster parenting flag.+fosterParenting :: Parser s -> ST s Bool+fosterParenting Parser {..} = rref parserFosterParenting++-- | Sets the foster parenting flag.+fosterParentingSet :: Parser s -> ST s ()+fosterParentingSet Parser {..} = wref parserFosterParenting True++-- | Clear the foster parenting flag.+fosterParentingClear :: Parser s -> ST s ()+fosterParentingClear Parser {..} = wref parserFosterParenting False++-- | Sets the frameset flag to not OK.+frameSetNotOK :: Parser s -> ST s ()+frameSetNotOK Parser {..} = wref parserFrameSetOK False++-- | Gets the iframe srcdoc flag.+iframeSrcDoc :: Parser s -> ST s Bool+iframeSrcDoc Parser {..} = rref parserIFrameSrcDoc++-- | Sets the done flag.+parserSetDone :: Parser s -> ST s ()+parserSetDone Parser {..} = wref parserDone True++-- | Gets the active format list.+activeFormatList :: Parser s -> ST s [ParserFormatItem]+activeFormatList Parser {..} = rref parserActiveFormatList++-- | Gets the names of the active format elements.+activeFormatNames :: Parser s -> ST s [BS]+activeFormatNames p = do+  d <- getDOM p+  map (f d) <$> activeFormatList p+  where f d ParserFormatMarker = "marker"+        f d (ParserFormatElement i t) =+          domElementName $ fromJust $ domGetNode d i++-- | Adds a marker to the list of active format elements.+activeFormatAddMarker :: Parser s -> ST s ()+activeFormatAddMarker Parser {..} =+  uref parserActiveFormatList (ParserFormatMarker:)++-- | Adds an element to the list of active format elements.+activeFormatAddElement :: Parser s -> Token -> DOMID -> ST s ()+activeFormatAddElement p @ Parser {..} t x = do+  d <- getDOM p+  a <- activeFormatList p+  let match (ParserFormatElement y _) = domMatch d x y+      b = takeWhile (not . formatItemIsMarker) a+      n = (foldr (\i z -> z + if match i then 1 else 0) 0 b) :: Int+      a' = if n < 3 then a else removeFirst match a+      e' = ParserFormatElement x t : a'+  wref parserActiveFormatList e'++-- | Adds the current node to the list of active format elements.+activeFormatAddCurrentNode :: Parser s -> Token -> ST s ()+activeFormatAddCurrentNode p @ Parser {..} t =+  whenJustM (currentNodeID p) $ activeFormatAddElement p t++-- | Determines if any format elements up to a marker satisfy a predicate.+activeFormatAny :: Parser s -> (DOMNode -> Bool) -> ST s Bool+activeFormatAny p @ Parser {..} f = do+  d <- getDOM p+  a <- activeFormatList p+  pure $+    ( any f+    . domMapID d+    . map (\(ParserFormatElement x _) -> x)+    . takeWhile (not . formatItemIsMarker)+    ) a++-- | Determines if the active format list contains an element.+activeFormatContains :: Parser s -> DOMID -> ST s Bool+activeFormatContains p x = any (formatItemHasID x) <$> activeFormatList p++-- | Finds a format item with a specified tag name.+activeFormatFindTag :: Parser s -> BS -> ST s (Maybe ParserFormatItem)+activeFormatFindTag p @ Parser {..} x = do+  d <- getDOM p+  a <- activeFormatList p+  pure $+    ( find (formatItemHasTag d x)+    . takeWhile (not . formatItemIsMarker)+    ) a++-- | Finds the token for a node ID.+activeFormatFindToken :: Parser s -> DOMID -> ST s (Maybe Token)+activeFormatFindToken p @ Parser {..} x =+  activeFormatList p >>= f+  where+    f [] = pure Nothing+    f ((ParserFormatMarker):xs) = f xs+    f ((ParserFormatElement i t):xs)+      | x == i = pure $ Just t+      | otherwise = f xs++-- | Reconstructs the list of active format elements.+activeFormatReconstruct :: Parser s -> ST s ()+activeFormatReconstruct p = do+  e <- elementStack p+  a <- activeFormatList p+  case a of+    [] -> pure ()+    (x:xs)+      | isOpen e x -> pure ()+      | otherwise -> do+          let b = reverse . takeWhile (not . isOpen e) $ a+              a' = drop (length b) a+          reopen p b a'++-- | Determines is a format item is open.+isOpen :: [DOMID] -> ParserFormatItem -> Bool+isOpen x = \case+   ParserFormatMarker -> True+   ParserFormatElement i _ -> i `elem` x++-- | Reopens a format item.+reopen :: Parser s -> [ParserFormatItem] -> [ParserFormatItem] -> ST s ()+reopen p @ Parser {..} b a =+  case b of+    [] ->+      wref parserActiveFormatList a+    ((ParserFormatMarker):xs) ->+      reopen p xs a+    ((ParserFormatElement _ t):xs) -> do+      insertHtmlElement p t+      i <- fromJust <$> currentNodeID p+      reopen p xs $ ParserFormatElement i t : a++-- | Clears the list of active format elements up to last marker.+activeFormatClear :: Parser s -> ST s ()+activeFormatClear p =+  activeFormatModify p $ drop 1 . dropWhile (not . formatItemIsMarker)++-- | Removes a node from the active format element list.+activeFormatRemove :: Parser s -> DOMID -> ST s ()+activeFormatRemove p x =+  activeFormatModify p $ filter $ not . formatItemHasID x++-- | Replaces an ID in the active format list.+activeFormatReplace :: Parser s -> DOMID -> DOMID -> ST s ()+activeFormatReplace p x y =+  activeFormatModify p $ map f+  where+    f z@(ParserFormatMarker) = z+    f z@(ParserFormatElement i t)+      | i == x = ParserFormatElement y t+      | otherwise = z++-- | Modifies the active format list.+activeFormatModify :: Parser s -> ([ParserFormatItem] -> [ParserFormatItem]) -> ST s ()+activeFormatModify Parser {..} = uref parserActiveFormatList++-- | Gets the active format successor for an ID.+activeFormatSucc :: Parser s -> DOMID -> ST s (Maybe DOMID)+activeFormatSucc p x =+  f <$> activeFormatList p+  where+    f a = case findSucc (formatItemHasID x) a of+      Just (ParserFormatElement i _) -> Just i+      _otherwise -> Nothing++-- | Inserts an element in the active format list.+activeFormatInsertElement :: Parser s -> DOMID -> Token -> Maybe DOMID -> ST s ()+activeFormatInsertElement p x t y =+  case y of+    Just a -> activeFormatModify p $ insertBefore (formatItemHasID a) e+    Nothing -> activeFormatModify p (<>[e])+  where+    e = ParserFormatElement x t++-- | Determines if a format item is a marker.+formatItemIsMarker :: ParserFormatItem -> Bool+formatItemIsMarker ParserFormatMarker = True+formatItemIsMarker (ParserFormatElement _ _) = False++-- | Determines if a format item has the specified ID.+formatItemHasID :: DOMID -> ParserFormatItem -> Bool+formatItemHasID x ParserFormatMarker = False+formatItemHasID x (ParserFormatElement i _) = i == x++-- | Determines if a format item has a certain tag name.+formatItemHasTag :: DOM -> BS -> ParserFormatItem -> Bool+formatItemHasTag d n ParserFormatMarker = False+formatItemHasTag d n (ParserFormatElement i _) =+  case domGetNode d i of+    Just x -> domNodeElementName x == n+    Nothing -> False++-- | Gets the current template insertion mode.+templateModeCurrent :: Parser s -> ST s (Maybe ParserMode)+templateModeCurrent p @ Parser {..} = listToMaybe <$> rref parserTemplateMode++-- | Pushes an insertion mode onto the stack of template insertion modes.+templateModePush :: Parser s -> ParserMode -> ST s ()+templateModePush p @ Parser {..} x = uref parserTemplateMode (x:)++-- | Pops an insertion mode off of the stack of template insertion modes.+templateModePop :: Parser s -> ST s ()+templateModePop p @ Parser {..} =+  rref parserTemplateMode >>= \case+    (x:xs) -> wref parserTemplateMode xs+    []     -> parseError p Nothing "attempt to pop empty template mode stack"++-- | Gets the current number of template modes.+templateModeCount :: Parser s -> ST s Int+templateModeCount p @ Parser {..} = length <$> rref parserTemplateMode++-- | Gets the appropriate insertion location.+appropriateInsertionLocation :: Parser s -> Maybe DOMID -> ST s DOMPos+appropriateInsertionLocation p @ Parser {..} override = do+  -- (1) Check for override target.+  target <- case override of+    Just a -> pure a+    Nothing -> maybe domRoot id <$> currentNodeID p+  getNode p target >>= \case+    Nothing ->+      pure $ DOMPos domRoot Nothing+    Just n -> do+      f <- fosterParenting p+      -- (2) Determine the adjusted insertion location.+      adjusted <-+        if f && domNodeElementName n `elem`+          [ "table", "tbody", "tfoot", "thead", "tr" ]+        then do+          -- (2.1) Get last template in element stack.+          lastTemplate <- elementStackFind p $ \x ->+            elementDetailsType x == domMakeTypeHTML "template"+          -- (2.2) Get last table in element stack.+          lastTable <- elementStackFind p $ \x ->+            elementDetailsType x == domMakeTypeHTML "table"+          let Just (ElementDetails i1 x1 n1 _) = lastTemplate+              Just (ElementDetails i2 x2 n2 _) = lastTable+          -- (2.3) Check for template and no table.+          if | isJust lastTemplate && (isNothing lastTable || (i1 < i2)) ->+                 pure $ DOMPos (domTemplateContents n1) Nothing+             -- (2.4) If no last table then use first element.+             | isNothing lastTable -> do+                 j <- fromJust <$> lastNodeID p+                 pure $ DOMPos j Nothing+             -- (2.5) Check last table parent node.+             | domNodeParent n2 /= domNull ->+                 pure $ DOMPos (domNodeParent n2) $ Just x2+             | otherwise -> do+                 -- (2.6) Previous element is above last table.+                 prev <- fromJust <$> elementStackSucc p x2+                 -- (2.7) Location is after previous element last child.+                 pure $ DOMPos prev Nothing+        else+          pure $ DOMPos target Nothing+      getNode p (domPosParent adjusted) >>= \case+        Just DOMTemplate{..} ->+          -- (3) Use template contents instead.+          pure $ DOMPos domTemplateContents Nothing+        _ ->+          -- (4) Return adjusted insertion location.+          pure adjusted++-- | Gets the appropriate insertion location.+insertionLocation :: Parser s -> ST s DOMPos+insertionLocation p = appropriateInsertionLocation p Nothing++-- | Creates an element for a token.+-- The standard describes a much more involved process than+-- what is used here (refer to 12.2.5.1).+createElementForToken :: Parser s -> Token -> HTMLNamespace -> ST s DOMID+createElementForToken p t s+  | tStartName t == "template" = do+      i <- newID p $ domDefaultFragment+      j <- newID p $ domDefaultTemplate+        { domTemplateNamespace = s+        , domTemplateContents  = i+        }+      modifyDOM p $ domSetParent i j+      pure j+  | otherwise = do+      i <- newID p $ domDefaultElement+        { domElementName       = tStartName t+        , domElementAttributes = Seq.fromList $ map f (tStartAttr t)+        , domElementNamespace  = s+        }+      pure i+  where+    f (TAttr n v s) = DOMAttr n v s++-- | Inserts a foreign element into the document.+insertForeignElement :: Parser s -> HTMLNamespace -> Token -> ST s ()+insertForeignElement p n =+  withStartToken $ \t -> do+    i <- createElementForToken p t n+    x <- insertionLocation p+    modifyDOM p $ domInsert x i+    elementStackPush p i++-- | Inserts an HTML element into the document.+insertHtmlElement :: Parser s -> Token -> ST s ()+insertHtmlElement p = insertForeignElement p HTMLNamespaceHTML++-- | Inserts a MathML element into the document.+insertMathMLElement :: Parser s -> Token -> ST s ()+insertMathMLElement p = insertForeignElement p HTMLNamespaceMathML++-- | Inserts an SVG element into the document.+insertSvgElement :: Parser s -> Token -> ST s ()+insertSvgElement p = insertForeignElement p HTMLNamespaceSVG++-- | Inserts an HTML element into the document.+insertHtmlElementNamed :: Parser s -> BS -> ST s ()+insertHtmlElementNamed p x = insertHtmlElement p $ TStart x False []++-- | Adjusts the MathML attributes for a token.+adjustAttrMathML :: Token -> Token+adjustAttrMathML t =+  case t of+    TStart {} -> t { tStartAttr = map f $ tStartAttr t }+    _otherwise -> t+  where+    f (TAttr n v s) = TAttr (g n) v s+    g x = if x == "definitionurl" then "definitionUrl" else x++-- | Adjusts the SVG attributes for a token.+adjustAttrSVG :: Token -> Token+adjustAttrSVG t =+  t { tStartAttr = map f $ tStartAttr t }+  where+    f t@(TAttr n v s) =+      case Map.lookup n svgAttributeMap of+        Just n' -> TAttr n' v s+        Nothing -> t++-- | Adjusts the foreign attributes for a token.+adjustAttrForeign :: Token -> Token+adjustAttrForeign t =+  t { tStartAttr = map f $ tStartAttr t }+  where+    f t@(TAttr n v s) =+      case Map.lookup n foreignAttributeMap of+        Just (n', s') -> TAttr n' v s'+        Nothing -> t++-- | Adjusts the element name for an SVG element.+adjustElemSVG :: Token -> Token+adjustElemSVG t =+  case Map.lookup (tStartName t) svgElementMap of+    Just x -> t { tStartName = x }+    Nothing -> t++-- | Adjustable SVG attribute map.+svgAttributeMap :: Map BS BS+svgAttributeMap = Map.fromList+  [ ("attributename", "attributeName")+  , ("attributetype", "attributeType")+  , ("basefrequency", "baseFrequency")+  , ("baseprofile", "baseProfile")+  , ("calcmode", "calcMode")+  , ("clippathunits", "clipPathUnits")+  , ("diffuseconstant", "diffuseConstant")+  , ("edgemode", "edgeMode")+  , ("filterunits", "filterUnits")+  , ("glyphref", "glyphRef")+  , ("gradienttransform", "gradientTransform")+  , ("gradientunits", "gradientUnits")+  , ("kernelmatrix", "kernelMatrix")+  , ("kernelunitlength", "kernelUnitLength")+  , ("keypoints", "keyPoints")+  , ("keysplines", "keySplines")+  , ("keytimes", "keyTimes")+  , ("lengthadjust", "lengthAdjust")+  , ("limitingconeangle", "limitingConeAngle")+  , ("markerheight", "markerHeight")+  , ("markerunits", "markerUnits")+  , ("markerwidth", "markerWidth")+  , ("maskcontentunits", "maskContentUnits")+  , ("maskunits", "maskUnits")+  , ("numoctaves", "numOctaves")+  , ("pathlength", "pathLength")+  , ("patterncontentunits", "patternContentUnits")+  , ("patterntransform", "patternTransform")+  , ("patternunits", "patternUnits")+  , ("pointsatx", "pointsAtX")+  , ("pointsaty", "pointsAtY")+  , ("pointsatz", "pointsAtZ")+  , ("preservealpha", "preserveAlpha")+  , ("preserveaspectratio", "preserveAspectRatio")+  , ("primitiveunits", "primitiveUnits")+  , ("refx", "refX")+  , ("refy", "refY")+  , ("repeatcount", "repeatCount")+  , ("repeatdur", "repeatDur")+  , ("requiredextensions", "requiredExtensions")+  , ("requiredfeatures", "requiredFeatures")+  , ("specularconstant", "specularConstant")+  , ("specularexponent", "specularExponent")+  , ("spreadmethod", "spreadMethod")+  , ("startoffset", "startOffset")+  , ("stddeviation", "stdDeviation")+  , ("stitchtiles", "stitchTiles")+  , ("surfacescale", "surfaceScale")+  , ("systemlanguage", "systemLanguage")+  , ("tablevalues", "tableValues")+  , ("targetx", "targetX")+  , ("targety", "targetY")+  , ("textlength", "textLength")+  , ("viewbox", "viewBox")+  , ("viewtarget", "viewTarget")+  , ("xchannelselector", "xChannelSelector")+  , ("ychannelselector", "yChannelSelector")+  , ("zoomandpan", "zoomAndPan")+  ]++-- | Adjustable SVG element map.+svgElementMap :: Map BS BS+svgElementMap = Map.fromList+  [ ("altglyph", "altGlyph")+  , ("altglyphdef", "altGlyphDef")+  , ("altglyphitem", "altGlyphItem")+  , ("animatecolor", "animateColor")+  , ("animatemotion", "animateMotion")+  , ("animatetransform", "animateTransform")+  , ("clippath", "clipPath")+  , ("feblend", "feBlend")+  , ("fecolormatrix", "feColorMatrix")+  , ("fecomponenttransfer", "feComponentTransfer")+  , ("fecomposite", "feComposite")+  , ("feconvolvematrix", "feConvolveMatrix")+  , ("fediffuselighting", "feDiffuseLighting")+  , ("fedisplacementmap", "feDisplacementMap")+  , ("fedistantlight", "feDistantLight")+  , ("fedropshadow", "feDropShadow")+  , ("feflood", "feFlood")+  , ("fefunca", "feFuncA")+  , ("fefuncb", "feFuncB")+  , ("fefuncg", "feFuncG")+  , ("fefuncr", "feFuncR")+  , ("fegaussianblur", "feGaussianBlur")+  , ("feimage", "feImage")+  , ("femerge", "feMerge")+  , ("femergenode", "feMergeNode")+  , ("femorphology", "feMorphology")+  , ("feoffset", "feOffset")+  , ("fepointlight", "fePointLight")+  , ("fespecularlighting", "feSpecularLighting")+  , ("fespotlight", "feSpotLight")+  , ("fetile", "feTile")+  , ("feturbulence", "feTurbulence")+  , ("foreignobject", "foreignObject")+  , ("glyphref", "glyphRef")+  , ("lineargradient", "linearGradient")+  , ("radialgradient", "radialGradient")+  , ("textpath", "textPath")+  ]++-- | Map of foreign attribute adjustments.+foreignAttributeMap :: Map BS (BS, HTMLAttrNamespace)+foreignAttributeMap = Map.fromList+  [ ("xlink:actuate", ("actuate", HTMLAttrNamespaceXLink))+  , ("xlink:arcrole", ("arcrole", HTMLAttrNamespaceXLink))+  , ("xlink:href", ("href", HTMLAttrNamespaceXLink))+  , ("xlink:role", ("role", HTMLAttrNamespaceXLink))+  , ("xlink:show", ("show", HTMLAttrNamespaceXLink))+  , ("xlink:title", ("title", HTMLAttrNamespaceXLink))+  , ("xlink:type", ("type", HTMLAttrNamespaceXLink))+  , ("xml:lang", ("lang", HTMLAttrNamespaceXML))+  , ("xml:space", ("space", HTMLAttrNamespaceXML))+  , ("xmlns", ("xmlns", HTMLAttrNamespaceXMLNS))+  , ("xmlns:xlink", ("xlink", HTMLAttrNamespaceXMLNS))+  ]++-- | Inserts a node as a child of another node.+insertNode :: Parser s -> DOMPos -> DOMID -> ST s ()+insertNode p @ Parser {..} i x = modifyDOM p $ domInsert i x++-- | Inserts a new node as a child of another node.+insertNewNode :: Parser s -> DOMPos -> DOMNode -> ST s DOMID+insertNewNode p @ Parser {..} i x = do+  d <- getDOM p+  let (d', j) = domInsertNew i x d+  setDOM p d'+  pure j++-- | Inserts a node as a child of the document.+insertDocumentNode :: Parser s -> DOMID -> ST s ()+insertDocumentNode p @ Parser {..} = insertNode p domRootPos++-- | Inserts a new node as a child of the document.+insertNewDocumentNode :: Parser s -> DOMNode -> ST s ()+insertNewDocumentNode p @ Parser {..} = void . insertNewNode p domRootPos++-- | Makes a comment node.+commentMake :: Parser s -> Token -> ST s DOMNode+commentMake p @ Parser {..} t =+  pure $ domDefaultComment { domCommentData = tCommentData t }++-- | Makes a document type node.+doctypeMake :: Parser s -> Token -> ST s DOMNode+doctypeMake p @ Parser {..} TDoctype {..} =+  pure $ domDefaultDoctype+    { domDoctypeName     = tDoctypeName+    , domDoctypePublicID = tDoctypePublic+    , domDoctypeSystemID = tDoctypeSystem+    }++-- | Inserts a new comment in the document.+insertComment :: Parser s -> Token -> ST s ()+insertComment p @ Parser {..} t =+  insertionLocation p >>= \x ->+    commentMake p t >>= void . insertNewNode p x++-- | Inserts a new comment as child of the document node.+insertDocComment :: Parser s -> Token -> ST s ()+insertDocComment p @ Parser {..} t =+  commentMake p t >>= void . insertNewNode p domRootPos++-- | Inserts a new character in the document.+insertChar :: Parser s -> Token -> ST s ()+insertChar p @ Parser {..} =+  withCharToken $ \w -> do+    pos <- insertionLocation p+    let i = domPosParent pos+    when (i /= domRoot) $ do+      d <- getDOM p+      case domLastChild d i of+        Nothing -> do+          j <- insertNewNode p pos domDefaultText+          textMapAppend p j w+        Just x ->+          case domGetNode d x of+            Just n@DOMText{..} ->+              textMapAppend p domTextID w+            Just n -> do+              j <- insertNewNode p pos domDefaultText+              textMapAppend p j w+            Nothing ->+              parseError p Nothing $ "insert char bad id: " <> bcPack (show x)++-- | Appends a word to a text node buffer.+textMapAppend :: Parser s -> DOMID -> Word8 -> ST s ()+textMapAppend Parser {..} i w = do+  m <- rref parserTextMap+  case IntMap.lookup i m of+    Just b ->+      bufferAppend w b+    Nothing -> do+      b <- bufferNew+      bufferAppend w b+      wref parserTextMap $ IntMap.insert i b m++-- | Finds a buffered string in the text map.+textMapLookup :: Parser s -> DOMID -> ST s BS+textMapLookup Parser {..} i = do+  m <- rref parserTextMap+  case IntMap.lookup i m of+    Just b  -> bufferPack b+    Nothing -> pure bsEmpty++-- | Returns a dom with the text nodes populated with text values.+textMapDOM :: Parser s -> ST s DOM+textMapDOM p @ Parser {..} = do+  DOM{..} <- getDOM p+  m <- rref parserTextMap >>= mapM bufferPack+  let f x = IntMap.findWithDefault bsEmpty x m+      a = flip IntMap.mapWithKey domNodes $ \i n ->+             case n of+               DOMText{} -> n { domTextData = f i }+               _otherwise -> n+  pure $ DOM a domNextID++-- | Invokes processing for a start tag token token.+withStartToken :: (Token -> ST s ()) -> Token -> ST s ()+withStartToken f = \case+  t@TStart {} -> f t+  _otherwise -> pure ()++-- -- | Invokes processing for a character token.+withCharToken :: (Word8 -> ST s ()) -> Token -> ST s ()+withCharToken f = \case+  TChar w    -> f w+  _otherwise -> pure ()++-- | Updates the parser lexer using a combinator.+parserLexerUpdate :: Parser s -> (Lexer s -> ST s ()) -> ST s ()+parserLexerUpdate Parser {..} f = rref parserLexer >>= f++-- | Sets the lexer to skip next linefeed.+parserSkipNextLF :: Parser s -> ST s ()+parserSkipNextLF p = parserLexerUpdate p lexerSkipNextLF++-- | Sets the lexer to RCDATA mode.+parserSetRCDATA :: Parser s -> ST s ()+parserSetRCDATA p = parserLexerUpdate p lexerSetRCDATA++-- | Sets the lexer to raw text mode.+parserSetRAWTEXT :: Parser s -> ST s ()+parserSetRAWTEXT p = parserLexerUpdate p lexerSetRAWTEXT++-- | Sets the lexer to plaintext mode.+parserSetPLAINTEXT :: Parser s -> ST s ()+parserSetPLAINTEXT p = parserLexerUpdate p lexerSetPLAINTEXT++-- | Sets the lexer to script data mode.+parserSetScriptData :: Parser s -> ST s ()+parserSetScriptData p = parserLexerUpdate p lexerSetScriptData++-- | Inserts an RCDATA text element.+insertElementRCDATA :: Parser s -> Token -> ST s ()+insertElementRCDATA p t = do+  insertHtmlElement p t+  parserSetRCDATA p+  saveMode p+  setMode p ModeText++-- | Inserts a raw text element.+insertElementRAWTEXT :: Parser s -> Token -> ST s ()+insertElementRAWTEXT p t = do+  insertHtmlElement p t+  parserSetRAWTEXT p+  saveMode p+  setMode p ModeText++-- | Generates the implied end tags.+generateImpliedEndTags :: Parser s -> ST s ()+generateImpliedEndTags p = generateImpliedEndTagsExcept p bsEmpty++-- | Generates the implied end tags with an exception.+generateImpliedEndTagsExcept :: Parser s -> BS -> ST s ()+generateImpliedEndTagsExcept p x =+  elementStackPopWhile p $ elementNameIn $+    filter (/=x) [ "dd", "dt", "li", "menuitem", "optgroup",+                   "option", "p", "rb", "rp", "rt", "rtc" ]++-- | Generates the implied end tags.+generateImpliedEndTagsThoroughly :: Parser s -> ST s ()+generateImpliedEndTagsThoroughly p =+  elementStackPopWhile p $ elementNameIn+    [ "caption", "colgroup", "dd", "dt", "li", "optgroup",+      "option", "p", "rb", "rp", "rt", "rtc",+      "tbody", "td", "tfoot", "th", "thead", "tr" ]++-- | Resets the insertion mode appropriately.+resetInsertionMode :: Parser s -> ST s ()+resetInsertionMode p @ Parser {..} =+  elementStackNodes p >>= f+  where+    f [] = pure ()+    f (x:xs) = do+      x' <- node+      case (domNodeElementName x', lastNode) of+        ("select", _)   -> g (x':xs)+        ("td", False)   -> setMode p ModeInCell+        ("th", False)   -> setMode p ModeInCell+        ("tr", _)       -> setMode p ModeInRow+        ("tbody", _)    -> setMode p ModeInTableBody+        ("thead", _)    -> setMode p ModeInTableBody+        ("tfoot", _)    -> setMode p ModeInTableBody+        ("caption", _)  -> setMode p ModeInCaption+        ("colgroup", _) -> setMode p ModeInColumnGroup+        ("table", _)    -> setMode p ModeInTable+        ("head", False) -> setMode p ModeInHead+        ("body", _)     -> setMode p ModeInBody+        ("frameset", _) -> setMode p ModeInFrameset+        ("template", _) -> templateModeCurrent p >>= \case+                             Just m  -> setMode p m+                             Nothing -> pure ()+        ("html", _)     -> getHeadID p >>= \case+                             Nothing -> setMode p ModeBeforeHead+                             Just _  -> setMode p ModeAfterHead+        (_, True)       -> setMode p ModeInBody+        (_, False)      -> f xs+      where+        lastNode = length xs == 0+        node = do+          a <- rref parserFragmentMode+          c <- rref parserContextElement+          n <- getNode p $ fromJust c+          pure $+            if lastNode && a && isJust c+               then fromJust $ n+               else x++    g (x:[]) =+      setMode p ModeInSelect+    g (x:y:ys) =+      case domNodeElementName y of+        "template" -> setMode p ModeInSelect+        "table"    -> setMode p ModeInSelectInTable+        _otherwise -> g (y:ys)++-- | Closes a P element.+closeElementP :: Parser s -> ST s ()+closeElementP p = do+  let t = domMakeTypeHTML "p"+  generateImpliedEndTagsExcept p "p"+  unlessM (currentNodeHasType p t) $+    parseError p Nothing "current node not p when closing p element"+  elementStackPopUntilType p t++-- | Defines the adoption agency state.+data ParserAdoptionAgency s = ParserAdoptionAgency+  { aaSubject            :: BS+  , aaOuterLoopCount     :: Int+  , aaInnerLoopCount     :: Int+  , aaNode               :: DOMID+  , aaLastNode           :: DOMID+  , aaNextNode           :: DOMID+  , aaFormattingElement  :: DOMID+  , aaCommonAncestor     :: DOMID+  , aaFurthestBlock      :: DOMID+  , aaBookmark           :: (Maybe DOMID)+  , aaAnyOtherEndTag     :: ST s ()+  }++-- | Defines the default adoption agency state.+defaultAA :: ST s (ParserAdoptionAgency s)+defaultAA =+  pure $ ParserAdoptionAgency+    { aaSubject            = bsEmpty+    , aaOuterLoopCount     = 0+    , aaInnerLoopCount     = 0+    , aaNode               = domNull+    , aaLastNode           = domNull+    , aaNextNode           = domNull+    , aaFormattingElement  = domNull+    , aaCommonAncestor     = domNull+    , aaFurthestBlock      = domNull+    , aaBookmark           = Nothing+    , aaAnyOtherEndTag     = pure ()+    }++-- | Modifies the adoption agency state.+modifyAA :: Parser s -> (ParserAdoptionAgency s -> ParserAdoptionAgency s) -> ST s ()+modifyAA Parser {..} = uref parserAdoptionAgency++-- | Gets the adoption agency state.+getAA :: Parser s -> ST s (ParserAdoptionAgency s)+getAA Parser {..} = rref parserAdoptionAgency++-- | Gets a field from the adoption agency state.+getsAA :: Parser s -> (ParserAdoptionAgency s -> a) -> ST s a+getsAA p f = f <$> getAA p++-- | Runs the adoption agency algorithm.+adoptionAgencyRun :: Parser s -> BS -> ST s () -> ST s ()+adoptionAgencyRun p @ Parser {..} subject anyOther = do+  a <- currentNodeHasType p $ domMakeTypeHTML subject+  b <- currentNodeID p >>= \case+    Just i -> notM $ activeFormatContains p i+    Nothing -> pure True+  unless (a && b) $ do+    aa <- defaultAA+    modifyAA p $ const aa+      { aaSubject        = subject+      , aaAnyOtherEndTag = anyOther+      }+    adoptionAgencyOuterLoop p++-- | Runs the outer loop portion of the adoption agency algorithm.+adoptionAgencyOuterLoop :: Parser s -> ST s ()+adoptionAgencyOuterLoop p = do+  i <- getsAA p aaOuterLoopCount+  -- (3) Check outer loop counter.+  when (i < 8) $ do+    -- (4) Increment outer loop counter.+    modifyAA p $ \a -> a { aaOuterLoopCount = aaOuterLoopCount a + 1 }+    -- (5) Find the formatting element.+    liftA aaSubject (getAA p) >>= activeFormatFindTag p >>= \case+      Nothing -> do+        doAnyOtherEndTag <- getsAA p aaAnyOtherEndTag+        doAnyOtherEndTag+      Just (ParserFormatElement fe t) -> do+        modifyAA p $ \a -> a { aaFormattingElement = fe }+        -- Geting formatting node+        x <- fromJust <$> getNode p fe+        let name = domElementName x+        -- (6) Check if formatting element is not in element stack.+        (elementStackAny p ((==) fe . domNodeID)) >>= \case+          False -> do+            parseError p Nothing $+              "element stack missing " <> name+              <> "(ID:" <> bcPack (show fe) <> ") during adoption"+            activeFormatRemove p fe+          True ->+            -- (7) Check if formatting element is not in scope.+            (elementInScope p $ domNodeType x) >>= \case+              False ->+                parseError p Nothing $+                  "element " <> name <> " not in scope during adoption"+              True -> do+                -- (8) Check if formatting element is not current node.+                unlessM (maybe False (==fe) <$> currentNodeID p) $+                  parseError p Nothing $ "element " <> name+                    <> " is not the current ID during adoption"+                -- (9) Find the furthest block.+                d <- getDOM p+                f <- pure $ find $ elementIsSpecial+                  . domNodeType . fromJust . domGetNode d+                liftA (f . reverse . takeWhile (/=fe)) (elementStack p) >>= \case+                  Nothing -> do+                    -- (10) There was no furthest block.+                    elementStackPopUntilID p fe+                    activeFormatRemove p fe+                  Just fb -> do+                    -- (11) Find the common ancestor.+                    ca <- fromJust <$> elementStackSucc p fe+                    -- (12) Bookmark notes position of formatting element.+                    bm <- activeFormatSucc p fe+                    modifyAA p $ \a -> a+                      { aaNode = fb+                      , aaLastNode = fb+                      , aaCommonAncestor = ca+                      , aaFurthestBlock = fb+                      , aaBookmark = bm+                      }+                    adoptionAgencyInnerLoop p++-- | Runs the inner loop portion of the adoption agency algorithm.+adoptionAgencyInnerLoop :: Parser s -> ST s ()+adoptionAgencyInnerLoop p = do+  -- (13.2) Increment inner loop counter.+  modifyAA p $ \a -> a { aaInnerLoopCount = aaInnerLoopCount a + 1 }+  -- (13.3) Move to the next node.+  n <- getsAA p aaNode+  m <- getsAA p aaNextNode+  node <- maybe m id <$> elementStackSucc p n+  -- (13.4) Check if node is the formatting element.+  f <- getsAA p aaFormattingElement+  if node == f+     then adoptionAgencyPostLoop p+     else do+       -- (13.5) Check the inner loop counter.+       ic <- getsAA p aaInnerLoopCount+       ac <- activeFormatContains p node+       when (ic > 3 && ac) $ activeFormatRemove p node+       -- (13.6) Check if node is in the active format list.+       unlessM (activeFormatContains p node) $ do+         m <- fromJust <$> elementStackSucc p node+         modifyAA p $ \a -> a { aaNextNode = m }+         elementStackRemove p node+         adoptionAgencyInnerLoop p+       -- (13.7) Create an element for the token for node.+       t <- fromJust <$> activeFormatFindToken p node+       e <- createElementForToken p t HTMLNamespaceHTML+       c <- getsAA p aaCommonAncestor+       modifyDOM p $ domAppend c e+       activeFormatReplace p node e+       elementStackReplace p node e+       modifyAA p $ \a -> a { aaNode = e }+       -- (13.8) Check if node is the furthest block.+       x <- getsAA p aaLastNode+       b <- getsAA p aaFurthestBlock+       when (x == b) $ do+         bm <- activeFormatSucc p e+         modifyAA p $ \a -> a { aaBookmark = bm }+       -- (13.9) Insert last node into node.+       modifyDOM p $ domMove x e+       -- (13.10) Set last node to be node.+       modifyAA p $ \a -> a { aaLastNode = e }+       -- (13.11) Repeat inner loop.+       adoptionAgencyInnerLoop p++-- | Runs the post-loop portion of the adoption agency algorithm.+adoptionAgencyPostLoop :: Parser s -> ST s ()+adoptionAgencyPostLoop p = do+  -- (14) Insert last node with common ancestor as target.+  c <- getsAA p aaCommonAncestor+  n <- getsAA p aaLastNode+  i <- appropriateInsertionLocation p $ Just c+  modifyDOM p $ domMove n $ domPosParent i+  -- (15) Create element for token.+  f <- getsAA p aaFormattingElement+  t <- fromJust <$> activeFormatFindToken p f+  e <- createElementForToken p t HTMLNamespaceHTML+  -- (16) Move furthest block children to new element.+  b <- getsAA p aaFurthestBlock+  modifyDOM p $ domMoveChildren b e+  -- (17) Append new element to furthest block.+  modifyDOM p $ domAppend b e+  -- (18) Remove formatting element and insert new element.+  activeFormatRemove p f+  getsAA p aaBookmark >>= activeFormatInsertElement p e t+  -- (19) Remove formatting element and insert new element.+  elementStackRemove p f+  elementStackInsertBefore p b e+  -- (20) Jump back to outer loop.+  adoptionAgencyOuterLoop p++-- | Initializes the pending table characters.+pendingTableCharInit :: Parser s -> ST s ()+pendingTableCharInit Parser {..} = wref parserTableChars []++-- | Appends a character to the pending table characters.+pendingTableCharAppend :: Parser s -> Token -> ST s ()+pendingTableCharAppend Parser {..} t = uref parserTableChars (<>[t])++-- | Gets the pending table characters.+pendingTableChars :: Parser s -> ST s [Token]+pendingTableChars Parser {..} = rref parserTableChars++-- | Checks the DOCTYPE token for validity.+doctypeTokenCheck :: Parser s -> Token -> ST s ()+doctypeTokenCheck parser@Parser {..} t@(TDoctype n q p s) =+  when (n /= "html"+    || p /= Nothing+    || s /= Nothing && s /= Just "about:legacy-compat") $+    parseError parser (Just t) "doctype error"++-- | Determines if the doctype token represents quirks mode.+tokenQuirks :: Token -> Bool+tokenQuirks (TDoctype n True p s) = True+tokenQuirks (TDoctype n False p s) =+  or+  [ n /= "html"+  , idMatch p "-//W3O//DTD W3 HTML Strict 3.0//EN//"+  , idMatch p "-/W3C/DTD HTML 4.0 Transitional/EN"+  , idMatch p "HTML"+  , idMatch s "http://www.ibm.com/data/dtd/v11/ibmxhtml1-transitional.dtd"+  , anyPrefix p publicIdPrefix+  , and+    [ s == Nothing+    , anyPrefix p+      [ "-//W3C//DTD HTML 4.01 Frameset//"+      , "-//W3C//DTD HTML 4.01 Transitional//"+      ]+    ]+  ]++-- | Public ID prefixes.+publicIdPrefix :: [BS]+publicIdPrefix =+  [ "+//Silmaril//dtd html Pro v0r11 19970101//"+  , "-//AS//DTD HTML 3.0 asWedit + extensions//"+  , "-//AdvaSoft Ltd//DTD HTML 3.0 asWedit + extensions//"+  , "-//IETF//DTD HTML 2.0 Level 1//"+  , "-//IETF//DTD HTML 2.0 Level 2//"+  , "-//IETF//DTD HTML 2.0 Strict Level 1//"+  , "-//IETF//DTD HTML 2.0 Strict Level 2//"+  , "-//IETF//DTD HTML 2.0 Strict//"+  , "-//IETF//DTD HTML 2.0//"+  , "-//IETF//DTD HTML 2.1E//"+  , "-//IETF//DTD HTML 3.0//"+  , "-//IETF//DTD HTML 3.2 Final//"+  , "-//IETF//DTD HTML 3.2//"+  , "-//IETF//DTD HTML 3//"+  , "-//IETF//DTD HTML Level 0//"+  , "-//IETF//DTD HTML Level 1//"+  , "-//IETF//DTD HTML Level 2//"+  , "-//IETF//DTD HTML Level 3//"+  , "-//IETF//DTD HTML Strict Level 0//"+  , "-//IETF//DTD HTML Strict Level 1//"+  , "-//IETF//DTD HTML Strict Level 2//"+  , "-//IETF//DTD HTML Strict Level 3//"+  , "-//IETF//DTD HTML Strict//"+  , "-//IETF//DTD HTML//"+  , "-//Metrius//DTD Metrius Presentational//"+  , "-//Microsoft//DTD Internet Explorer 2.0 HTML Strict//"+  , "-//Microsoft//DTD Internet Explorer 2.0 HTML//"+  , "-//Microsoft//DTD Internet Explorer 2.0 Tables//"+  , "-//Microsoft//DTD Internet Explorer 3.0 HTML Strict//"+  , "-//Microsoft//DTD Internet Explorer 3.0 HTML//"+  , "-//Microsoft//DTD Internet Explorer 3.0 Tables//"+  , "-//Netscape Comm. Corp.//DTD HTML//"+  , "-//Netscape Comm. Corp.//DTD Strict HTML//"+  , "-//O'Reilly and Associates//DTD HTML 2.0//"+  , "-//O'Reilly and Associates//DTD HTML Extended 1.0//"+  , "-//O'Reilly and Associates//DTD HTML Extended Relaxed 1.0//"+  , "-//SQ//DTD HTML 2.0 HoTMetaL + extensions//"+  , "-//SoftQuad Software//DTD HoTMetaL PRO 6.0::19990601::extensions to HTML 4.0//"+  , "-//SoftQuad//DTD HoTMetaL PRO 4.0::19971010::extensions to HTML 4.0//"+  , "-//Spyglass//DTD HTML 2.0 Extended//"+  , "-//Sun Microsystems Corp.//DTD HotJava HTML//"+  , "-//Sun Microsystems Corp.//DTD HotJava Strict HTML//"+  , "-//W3C//DTD HTML 3 1995-03-24//"+  , "-//W3C//DTD HTML 3.2 Draft//"+  , "-//W3C//DTD HTML 3.2 Final//"+  , "-//W3C//DTD HTML 3.2//"+  , "-//W3C//DTD HTML 3.2S Draft//"+  , "-//W3C//DTD HTML 4.0 Frameset//"+  , "-//W3C//DTD HTML 4.0 Transitional//"+  , "-//W3C//DTD HTML Experimental 19960712//"+  , "-//W3C//DTD HTML Experimental 970421//"+  , "-//W3C//DTD W3 HTML//"+  , "-//W3O//DTD W3 HTML 3.0//"+  , "-//WebTechs//DTD Mozilla HTML 2.0//"+  , "-//WebTechs//DTD Mozilla HTML//"+  ]++-- | Determines if the doctype token represents limited quirks mode.+tokenLimitedQuirks :: Token -> Bool+tokenLimitedQuirks TDoctype {..} =+  or+  [ anyPrefix tDoctypePublic+    [ "-//W3C//DTD XHTML 1.0 Frameset//"+    , "-//W3C//DTD XHTML 1.0 Transitional//"+    ]+  , and+    [ isJust tDoctypeSystem+    , anyPrefix tDoctypePublic+      [ "-//W3C//DTD HTML 4.01 Frameset//"+      , "-//W3C//DTD HTML 4.01 Transitional//"+      ]+    ]+  ]++-- | Determines if a DOCTYPE ID matches a value.+idMatch :: Maybe BS -> BS -> Bool+idMatch (Just x) y = bsLower x == bsLower y+idMatch Nothing y = False++-- | Determines if a text has any prefix from a list.+anyPrefix :: Maybe BS -> [BS] -> Bool+anyPrefix (Just x) ys = any (\y -> y `bsPrefixCI` x) ys+anyPrefix Nothing ys = False++-- | Handle the initial insertion mode.+doModeInitial :: Parser s -> Token -> ST s ()+doModeInitial p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData -> do+      pure ()+    TComment {} -> do+      insertDocComment p t+    TDoctype {} -> do+      doctypeTokenCheck p t+      doctypeMake p t >>= insertNewDocumentNode p+      iframe <- iframeSrcDoc p+      when (not iframe && tokenQuirks t) $ do+        modifyDOM p $ domQuirksSet DOMQuirksMode+      when (not iframe && tokenLimitedQuirks t) $ do+        modifyDOM p $ domQuirksSet DOMQuirksLimited+      setMode p ModeBeforeHtml+    _otherwise -> do+      whenM (notM $ iframeSrcDoc p) $ do+        parseError p (Just t) "initial unexpected token"+        modifyDOM p $ domQuirksSet DOMQuirksMode+      setMode p ModeBeforeHtml+      reprocess p t++-- | Handle the before html insertion mode.+doModeBeforeHtml :: Parser s -> Token -> ST s ()+doModeBeforeHtml p @ Parser {..} t =+  case t of+    TDoctype {} ->+      parseError p (Just t) "before html doctype"+    TComment {} ->+      insertDocComment p t+    TChar {..} | chrWhitespace tCharData ->+      pure ()+    TStart { tStartName = "html" } -> do+      insertHtmlElement p t+      setMode p ModeBeforeHead+    TEnd { tEndName = x }+      | elem x [ "head", "body", "html", "br" ] -> do+          insertHtmlElementNamed p "html"+          setMode p ModeBeforeHead+          reprocess p t+    TEnd {} ->+      parseError p (Just t) "before html end tag"+    _otherwise -> do+      insertHtmlElementNamed p "html"+      setMode p ModeBeforeHead+      reprocess p t++-- | Handle the before head insertion mode.+doModeBeforeHead :: Parser s -> Token -> ST s ()+doModeBeforeHead p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData ->+      pure ()+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      parseError p (Just t) "before head doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TStart { tStartName = "head" } -> do+      insertHtmlElement p t+      saveHead p+      setMode p ModeInHead+    TEnd { tEndName = x }+      | elem x [ "head", "body", "html", "br" ] -> do+          insertHtmlElementNamed p "head"+          saveHead p+          setMode p ModeInHead+          reprocess p t+    TEnd {} ->+      parseError p (Just t) "before head end tag"+    _otherwise -> do+      insertHtmlElementNamed p "head"+      saveHead p+      setMode p ModeInHead+      reprocess p t++-- | Handles the in-head parser mode.+doModeInHead :: Parser s -> Token -> ST s ()+doModeInHead p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData ->+      insertChar p t+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TStart { tStartName = x }+      | elem x [ "base", "basefont", "bgsound", "link" ] -> do+          insertHtmlElement p t+          elementStackPop p+          selfClosingAcknowledge p+    TStart { tStartName = "meta" } -> do+      insertHtmlElement p t+      elementStackPop p+      selfClosingAcknowledge p+      -- The standard normally requires running the encoding determination+      -- algorithm here, but we should not need it since the content should+      -- be known to be UTF-16.+    TStart { tStartName = "title" } ->+      insertElementRCDATA p t+    TStart { tStartName = "noframes" } ->+      insertElementRAWTEXT p t+    TStart { tStartName = "style" } ->+      insertElementRAWTEXT p t+    TStart { tStartName = "noscript" } -> do+      insertHtmlElement p t+      setMode p ModeInHeadNoscript+    TStart { tStartName = "script" } -> do+      insertHtmlElement p t+      parserSetScriptData p+      saveMode p+      setMode p ModeText+    TEnd { tEndName = "head" } -> do+      elementStackPop p+      setMode p ModeAfterHead+    TEnd { tEndName = x }+      | elem x [ "body", "html", "br" ] -> do+          elementStackPop p+          setMode p ModeAfterHead+          reprocess p t+    TStart { tStartName = "template" } -> do+      insertHtmlElement p t+      activeFormatAddMarker p+      frameSetNotOK p+      setMode p ModeInTemplate+      templateModePush p ModeInTemplate+    TEnd { tEndName = x@"template" } -> do+      let a = domMakeTypeHTML x+      -- Make sure a template element is on the stack.+      elementStackHasTemplate p >>= \case+        False ->+          warn "template start tag missing"+        True -> do+          -- (1) Generate implied end tags thoroughly.+          generateImpliedEndTagsThoroughly p+          -- (2) Make sure template is the current node.+          unlessM (currentNodeHasType p a) $+            parseError p Nothing "template not current node"+          -- (3) Pop elements until a template has been popped.+          elementStackPopUntilType p a+          -- (4) Clear list of active formatting elements up to last marker.+          activeFormatClear p+          -- (5) Pop the current template insertion mode.+          templateModePop p+          -- (6) Reset the insertion mode appropriately.+          resetInsertionMode p+    TStart { tStartName = "head" } ->+      warn "head"+    TEnd {} ->+      warn "unexpected end tag"+    _otherwise -> do+      elementStackPop p+      setMode p ModeAfterHead+      reprocess p t+  where+    warn x = parseError p (Just t) $ "in head " <> x++-- | Handles the in head no script parser mode.+doModeInHeadNoscript :: Parser s -> Token -> ST s ()+doModeInHeadNoscript p @ Parser {..} t =+  case t of+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TEnd { tEndName = "noscript" } -> do+      elementStackPop p+      setMode p ModeInHead+    TChar {..} | chrWhitespace tCharData ->+      doModeInHead p t+    TComment {} ->+      doModeInHead p t+    TStart { tStartName = x }+      | elem x [ "basefont", "bgsound", "link",+                 "meta", "noframes", "style" ] ->+          doModeInHead p t+    TEnd { tEndName = "br" } -> do+      warn "br"+      elementStackPop p+      setMode p ModeInHead+      reprocess p t+    TStart { tStartName = "head" } ->+      warn "head"+    TStart { tStartName = "noscript" } ->+      warn "noscript"+    TEnd {} ->+      warn "end tag"+    _otherwise -> do+      warn "bad token"+      elementStackPop p+      setMode p ModeInHead+      reprocess p t+  where+    warn x = parseError p (Just t) $ "in head noscript " <> x++-- | Handles the after head parser mode.+doModeAfterHead :: Parser s -> Token -> ST s ()+doModeAfterHead p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData ->+      insertChar p t+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      parseError p (Just t) "after head doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TStart { tStartName = "body" } -> do+      insertHtmlElement p t+      frameSetNotOK p+      setMode p ModeInBody+    TStart { tStartName = "frameset" } -> do+      insertHtmlElement p t+      setMode p ModeInFrameset+    TStart { tStartName = x }+      | elem x [ "base", "basefont", "bgsound", "link", "meta", "noframes",+                 "script", "style", "template", "title", "head" ] -> do+          parseError p (Just t) "AfterHead bad start tag"+          Just h <- getHeadID p+          elementStackPush p h+          doModeInHead p t+          elementStackRemove p h+    TEnd { tEndName = "template" } ->+      doModeInHead p t+    TEnd { tEndName = x }+      | elem x [ "body", "html", "br" ] -> do+          insertHtmlElementNamed p "body"+          setMode p ModeInBody+          reprocess p t+    TStart { tStartName = "head" } ->+      parseError p (Just t) "after head head"+    TEnd {} ->+      parseError p (Just t) "after head end tag"+    _otherwise -> do+      insertHtmlElementNamed p "body"+      setMode p ModeInBody+      reprocess p t++-- | Handles the in body parser mode.+doModeInBody :: Parser s -> Token -> ST s ()+doModeInBody p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData -> do+      activeFormatReconstruct p+      insertChar p t+    TChar {} -> do+      activeFormatReconstruct p+      insertChar p t+      frameSetNotOK p+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = x@"html" } -> do+      warn x+      unlessM (elementStackHasTemplate p) $ do+        Just i <- lastNodeID p+        modifyDOM p $ domAttrMerge i $ Seq.fromList $+          map (\(TAttr n v s) -> DOMAttr n v s) $ tStartAttr t+    TStart { tStartName = x }+      | elem x ["base", "basefont", "bgsound", "link", "meta",+                "noframes", "script", "style", "template", "title"] ->+          doModeInHead p t+    TEnd { tEndName = "template" } ->+      doModeInHead p t+    TStart { tStartName = x@"body" } -> do+      warn x+      unlessM (notM (elementStackHasBody p)+        ||^ liftA (==1) (elementStackSize p)+        ||^ (elementStackHasTemplate p)) $ do+          frameSetNotOK p+          Just i <- listToMaybe . drop 1 . reverse <$> elementStack p+          modifyDOM p $ domAttrMerge i $ Seq.fromList $+            map (\(TAttr n v s) -> DOMAttr n v s) $ tStartAttr t+    TStart { tStartName = x@"frameset" } -> do+      warn x+      unlessM (liftA (==1) (elementStackSize p)+        ||^ notM (elementStackHasBody p)+        ||^ notM (rref parserFrameSetOK)) $ do+          Just n <- listToMaybe . drop 1 . reverse <$> elementStackNodes p+          modifyDOM p $ domRemoveChild (domNodeParent n) $ domNodeID n+          elementStackPopWhile p $ \n ->+            domNodeType n /= domMakeTypeHTML "html"+          insertHtmlElement p t+          setMode p ModeInFrameset+    TEOF -> do+      n <- templateModeCount p+      if n > 0+      then doModeInTemplate p t+      else do+        whenM (elementStackAny p $ elementNameNotIn+          ["dd", "dt", "li", "menuitem", "optgroup",+           "option", "p", "rb", "rp", "rt", "rtc",+           "tbody", "td", "tfoot", "th", "thead", "tr",+           "body", "html"]) $+          warn "bad element on stack"+        parserSetDone p+    TEnd { tEndName = x@"body" } -> do+      let a = domMakeTypeHTML x+      elementInScope p a >>= \case+        False ->+          warn "no body element in scope"+        True -> do+          whenM (elementStackAny p $ elementNameNotIn+            ["dd", "dt", "li", "menuitem", "optgroup",+             "option", "p", "rb", "rp", "rt", "rtc",+             "tbody", "td", "tfoot", "th", "thead", "tr",+             "body", "html"]) $+            warn "bad element on stack"+          setMode p ModeAfterBody+    TEnd { tEndName = x@"html" } -> do+      let a = domMakeTypeHTML x+      elementInScope p a >>= \case+        False ->+          warn "no body element in scope"+        True -> do+          whenM (elementStackAny p $ elementNameNotIn+            ["dd", "dt", "li", "menuitem", "optgroup",+             "option", "p", "rb", "rp", "rt", "rtc",+             "tbody", "td", "tfoot", "th", "thead", "tr",+             "body", "html"]) $+            warn "bad element on stack"+          setMode p ModeAfterBody+          reprocess p t+    TStart { tStartName = x } | elem x+      ["address", "article", "aside", "blockquote",+       "center", "details", "dialog", "dir", "div", "dl",+       "fieldset", "figcaption", "figure", "footer", "header",+       "hgroup", "main", "nav", "ol", "p", "section",+       "summary", "ul"] -> do+      closeP+      insertHtmlElement p t+    TStart { tStartName = "menu" } -> do+      closeP+      popMenuitem+      insertHtmlElement p t+    TStart { tStartName = x }+      | elem x ["h1", "h2", "h3", "h4", "h5", "h6"] -> do+        closeP+        whenM (currentNodeHasTypeIn p $ domTypesHTML+          ["h1", "h2", "h3", "h4", "h5", "h6"]) $ do+          warn "bad header tag on stack"+          elementStackPop p+        insertHtmlElement p t+    TStart { tStartName = x } | elem x ["pre", "listing"] -> do+      closeP+      insertHtmlElement p t+      parserSkipNextLF p+      frameSetNotOK p+    TStart { tStartName = "form" } -> do+      (formNotNull p &&^ elementStackMissingTemplate p) >>= \case+        True ->+          warn "form without template"+        False -> do+          closeP+          insertHtmlElement p t+          whenM (elementStackMissingTemplate p) $ saveForm p+    TStart { tStartName = x@"li" } -> do+      let a = domMakeTypeHTML x+          s = Set.fromList $ domTypesHTML [ "address", "div", "p" ]+          f [] = pure ()+          f (y:ys)+            | y == a = do+                generateImpliedEndTagsExcept p x+                unlessM (currentNodeHasType p a) $+                  warn "current node is not li"+                elementStackPopUntilType p a+            | elementIsSpecial y && Set.notMember y s = pure ()+            | otherwise = f ys+      frameSetNotOK p+      elementStackTypes p >>= f+      closeP+      insertHtmlElement p t+    TStart { tStartName = x } | elem x ["dd", "dt"] -> do+      let dd = domMakeTypeHTML "dd"+          dt = domMakeTypeHTML "dt"+          s = Set.fromList $ domTypesHTML [ "address", "div", "p" ]+          f [] = pure ()+          f (y:ys)+            | y == dd || y == dt = do+                generateImpliedEndTagsExcept p $ domTypeName y+                unlessM (currentNodeHasType p y) $+                  warn "current node is not dd or dt"+                elementStackPopUntilType p y+            | elementIsSpecial y && Set.notMember y s = pure ()+            | otherwise = f ys+      frameSetNotOK p+      elementStackTypes p >>= f+      closeP+      insertHtmlElement p t+    TStart { tStartName = "plaintext" } -> do+      closeP+      insertHtmlElement p t+      parserSetPLAINTEXT p+    TStart { tStartName = x@"button" } -> do+      let a = domMakeTypeHTML x+      whenM (elementInScope p a) $ do+        warn "button element in scope"+        generateImpliedEndTags p+        elementStackPopUntilType p a+      activeFormatReconstruct p+      insertHtmlElement p t+      frameSetNotOK p+    TEnd { tEndName = x }+      | elem x ["address", "article", "aside", "blockquote", "button",+                "center", "details", "dialog", "dir", "div", "dl",+                "fieldset", "figcaption", "figure", "footer", "header",+                "hgroup", "listing", "main", "menu", "nav", "ol",+                "pre", "section", "summary", "ul"] -> do+          let a = domMakeTypeHTML x+          elementInScope p a >>= \case+            False ->+              warn "element not in scope"+            True -> do+              generateImpliedEndTags p+              unlessM (currentNodeHasType p a) $+                warn "current node wrong type"+              elementStackPopUntilType p a+    TEnd { tEndName = x@"form" } ->+      elementStackHasTemplate p >>= \case+        False -> do+          getFormID p >>= \case+            Nothing ->+              warn "form not defined"+            Just n -> do+              a <- fromJust <$> getFormType p+              setFormID p Nothing+              elementInScope p a >>= \case+                False ->+                  warn "form not in scope"+                True -> do+                  generateImpliedEndTags p+                  unlessM (liftA (==(Just n)) (currentNodeID p)) $+                    warn "current node is wrong node"+                  elementStackRemove p n+        True -> do+          let a = domMakeTypeHTML x+          elementInScope p a >>= \case+            False ->+              warn "form not in scope"+            True -> do+              generateImpliedEndTags p+              unlessM (currentNodeHasType p a) $+                warn "current node is not a form"+              elementStackPopUntilType p a+    TEnd { tEndName = x@"p" } -> do+      let a = domMakeTypeHTML x+      unlessM (elementInButtonScope p a) $ do+        warn "no p in button scope"+        insertHtmlElementNamed p x+      closeElementP p+    TEnd { tEndName = x@"li" } -> do+      let a = domMakeTypeHTML x+      elementInListScope p a >>= \case+        False ->+          warn "no li in list scope"+        True -> do+          generateImpliedEndTagsExcept p x+          unlessM (currentNodeHasType p a) $+            warn "current node not an li element"+          elementStackPopUntilType p a+    TEnd { tEndName = x } | elem x ["dd", "dt"] -> do+      let a = domMakeTypeHTML x+      elementInListScope p a >>= \case+        False ->+          warn "no dd or dt in list scope"+        True -> do+          generateImpliedEndTagsExcept p x+          unlessM (currentNodeHasType p a) $+            warn "current not is not a dd or dt"+          elementStackPopUntilType p a+    TEnd { tEndName = x }+      | elem x ["h1", "h2", "h3", "h4", "h5", "h6"] -> do+          let h = domTypesHTML ["h1", "h2", "h3", "h4", "h5", "h6"]+          anyM (elementInScope p) h >>= \case+            False ->+              warn "header element not in scope"+            True -> do+              generateImpliedEndTags p+              unlessM (currentNodeHasType p $ domMakeTypeHTML x) $+                warn "current node not a header type"+              elementStackPopUntilTypeIn p h+    TEnd { tEndName = "sarcasm" } ->+      doAnyOtherEndTag+    TStart { tStartName = x@"a" } -> do+      let a = domMakeTypeHTML x+      activeFormatFindTag p x >>= \case+        Nothing -> pure ()+        Just (ParserFormatElement i _) -> do+          warn "active format already has anchor"+          runAA x+          elementStackRemove p i+          activeFormatRemove p i+      activeFormatReconstruct p+      insertHtmlElement p t+      activeFormatAddCurrentNode p t+    TStart { tStartName = x } | elem x+      ["b", "big", "code", "em", "font", "i", "s",+       "small", "strike", "strong", "tt", "u"] -> do+      activeFormatReconstruct p+      insertHtmlElement p t+      activeFormatAddCurrentNode p t+    TStart { tStartName = x@"nobr" } -> do+      let a = domMakeTypeHTML x+      activeFormatReconstruct p+      whenM (elementInScope p a) $ do+        warn "nobr tag when nobr element already in scope"+        runAA x+        activeFormatReconstruct p+      insertHtmlElement p t+      activeFormatAddCurrentNode p t+    TEnd { tEndName = x } | elem x+      ["a", "b", "big", "code", "em", "font", "i", "nobr",+       "s", "small", "strike", "strong", "tt", "u"] ->+      runAA x+    TStart { tStartName = x } | elem x+      ["applet", "marquee", "object"] -> do+      activeFormatReconstruct p+      insertHtmlElement p t+      activeFormatAddMarker p+      frameSetNotOK p+    TEnd { tEndName = x } | elem x+      ["applet", "marquee", "object"] -> do+      let a = domMakeTypeHTML x+      elementInScope p a >>= \case+        False ->+          warn "element scope missing"+        True -> do+          generateImpliedEndTags p+          unlessM (currentNodeHasType p a) $+            warn "current node is wring type"+          elementStackPopUntilType p a+          activeFormatClear p+    TStart { tStartName = "table" } -> do+      q <- domQuirksGet <$> getDOM p+      when (q /= DOMQuirksMode) closeP+      insertHtmlElement p t+      frameSetNotOK p+      setMode p ModeInTable+    TEnd { tEndName = "br" } -> do+      warn "br end tag"+      activeFormatReconstruct p+      insertHtmlElement p $ TStart "br" False []+      elementStackPop p+      selfClosingAcknowledge p+      frameSetNotOK p+    TStart { tStartName = x } | elem x+      ["area", "br", "embed", "img", "keygen", "wbr"] -> do+      activeFormatReconstruct p+      insertHtmlElement p t+      elementStackPop p+      selfClosingAcknowledge p+      frameSetNotOK p+    TStart { tStartName = "input" } -> do+      activeFormatReconstruct p+      insertHtmlElement p t+      elementStackPop p+      selfClosingAcknowledge p+      case tokenGetAttrVal "type" t of+        Just v -> when (bsLower v /= "hidden") $ frameSetNotOK p+        Nothing -> frameSetNotOK p+    TStart { tStartName = x } | elem x+      ["param", "source", "track"] -> do+      insertHtmlElement p t+      elementStackPop p+      selfClosingAcknowledge p+    TStart { tStartName = "hr" } -> do+      closeP+      popMenuitem+      insertHtmlElement p t+      elementStackPop p+      selfClosingAcknowledge p+      frameSetNotOK p+    TStart { tStartName = "image" } -> do+      warn "image"+      let t' = t { tStartName = "img" }+      reprocess p t'+    TStart { tStartName = "textarea" } -> do+      insertHtmlElement p t+      parserSkipNextLF p+      parserSetRCDATA p+      saveMode p+      frameSetNotOK p+      setMode p ModeText+    TStart { tStartName = "xmp" } -> do+      closeP+      activeFormatReconstruct p+      frameSetNotOK p+      insertElementRAWTEXT p t+    TStart { tStartName = "iframe" } -> do+      frameSetNotOK p+      insertElementRAWTEXT p t+    TStart { tStartName = "noembed" } ->+      insertElementRAWTEXT p t+    TStart { tStartName = "select" } -> do+      activeFormatReconstruct p+      insertHtmlElement p t+      frameSetNotOK p+      s <- pure $ Set.fromList+        [ ModeInTable, ModeInCaption, ModeInTableBody,+          ModeInRow, ModeInCell ]+      rref parserInsertionMode >>= \x -> setMode p $+        if Set.member x s+           then ModeInSelectInTable+           else ModeInSelect+    TStart { tStartName = x } | elem x+      ["optgroup", "option"] -> do+      elementStackPopIf p $ elementName "option"+      activeFormatReconstruct p+      insertHtmlElement p t+    TStart { tStartName = "menuitem" } -> do+      popMenuitem+      insertHtmlElement p t+    TStart { tStartName = x } | elem x ["rb", "rtc"] -> do+      let a = domMakeTypeHTML "ruby"+      whenM (elementInScope p a) $ do+        generateImpliedEndTags p+        unlessM (currentNodeHasType p a) $+          warn "ruby element not in scope"+      insertHtmlElement p t+    TStart { tStartName = x } | elem x ["rp", "rt"] -> do+      let a = domMakeTypeHTML "ruby"+          b = domMakeTypeHTML "rtc"+      whenM (elementInScope p a) $ do+        generateImpliedEndTagsExcept p "rtc"+        unlessM (currentNodeHasType p a ||^ currentNodeHasType p b) $+          warn "ruby or rtc element not in scope"+      insertHtmlElement p t+    TStart { tStartName = "math" } -> do+      activeFormatReconstruct p+      insertMathMLElement p . adjustAttrForeign . adjustAttrMathML $ t+      when (tStartClosed t) $ do+        elementStackPop p+        selfClosingAcknowledge p+    TStart { tStartName = "svg" } -> do+      activeFormatReconstruct p+      insertSvgElement p . adjustAttrForeign . adjustAttrSVG $ t+      when (tStartClosed t) $ do+        elementStackPop p+        selfClosingAcknowledge p+    TStart { tStartName = x } | elem x+      ["caption", "col", "colgroup", "frame", "head",+       "tbody", "td", "tfoot", "th", "thead", "tr"] ->+      warn "bad start token"+    TStart {} -> do+      activeFormatReconstruct p+      insertHtmlElement p t+    TEnd {} ->+      doAnyOtherEndTag+  where+    closeP = do+      let a = domMakeTypeHTML "p"+      whenM (elementInButtonScope p a) $ closeElementP p+    popMenuitem =+      elementStackPopIf p $ elementName "menuitem"+    runAA =+      flip (adoptionAgencyRun p) doAnyOtherEndTag+    doAnyOtherEndTag =+      elementStackTypes p >>= f+      where+        n = tEndName t+        a = domMakeTypeHTML n+        f [] = pure ()+        f (x:xs)+          | x == a = do+              generateImpliedEndTagsExcept p n+              unlessM (currentNodeHasType p x) $+                warn "current node has wrong type"+              elementStackPop p+          | elementIsSpecial x = do+              warn "special element in stack"+          | otherwise = f xs+    warn x =+      parseError p (Just t) $ "in body " <> x++-- | Handle the text insertion mode.+doModeText :: Parser s -> Token -> ST s ()+doModeText p @ Parser {..} t =+  case t of+    TChar {} ->+      insertChar p t+    TEOF -> do+      parseError p (Just t) "text eof"+      elementStackPop p+      restoreMode p+      reprocess p t+    TEnd { tEndName = "script" } -> do+      elementStackPop p+      restoreMode p+      -- The standard explains how to execute the script+      -- at this point, but we are just parsing.+    _otherwise -> do+      elementStackPop p+      restoreMode p++-- | Handle the in-table insertion mode.+doModeInTable :: Parser s -> Token -> ST s ()+doModeInTable p @ Parser {..} t =+  case t of+    TChar {} -> do+      a <- currentNodeHasTypeIn p $ domTypesHTML+        ["table", "tbody", "tfoot", "thead", "tr"]+      if a+      then do+        pendingTableCharInit p+        saveMode p+        setMode p ModeInTableText+        reprocess p t+      else do+        -- Because of the way the check is implmented, perform the+        -- steps for anything else here.+        anythingElse+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = "caption" } -> do+      clearToTableContext+      activeFormatAddMarker p+      insertHtmlElement p t+      setMode p ModeInCaption+    TStart { tStartName = "colgroup" } -> do+      clearToTableContext+      insertHtmlElement p t+      setMode p ModeInColumnGroup+    TStart { tStartName = x@"col" } -> do+      clearToTableContext+      insertHtmlElementNamed p x+      setMode p ModeInColumnGroup+      reprocess p t+    TStart { tStartName = x } | elem x+      ["tbody", "tfoot", "thead"] -> do+      clearToTableContext+      insertHtmlElement p t+      setMode p ModeInTableBody+    TStart { tStartName = x } | elem x+      ["td", "th", "tr"] -> do+      clearToTableContext+      insertHtmlElementNamed p "tbody"+      setMode p ModeInTableBody+      reprocess p t+    TStart { tStartName = x@"table" } -> do+      warn "table start tag"+      let a = domMakeTypeHTML x+      unlessM (elementInTableScope p a) $ do+        elementStackPopUntilType p a+        resetInsertionMode p+        reprocess p t+    TEnd { tEndName = x@"table" } -> do+      let a = domMakeTypeHTML x+      elementInTableScope p a >>= \case+        False ->+          warn "no table in scope"+        True -> do+          elementStackPopUntilType p a+          resetInsertionMode p+    TStart { tStartName = x } | elem x+      ["body", "caption", "col", "colgroup", "html",+       "tbody", "td", "tfoot", "th", "thead", "tr"] ->+      warn "unexpected start tag"+    TStart { tStartName = x } | elem x+     ["style", "script", "template"] ->+      doModeInHead p t+    TEnd { tEndName = "template" } ->+      doModeInHead p t+    TStart { tStartName = "input" } -> do+      if case tokenGetAttr "type" t of+        Nothing -> True+        Just a -> bsLower (tAttrName a) /= "hidden"+      then anythingElse+      else do+        warn "hidden input"+        insertHtmlElement p t+        elementStackPop p+        selfClosingAcknowledge p+    TStart { tStartName = "form" } -> do+      warn "form start tag"+      unlessM (elementStackHasTemplate p ||^ formNotNull p) $ do+        insertHtmlElement p t+        saveForm p+        elementStackPop p+    TEOF ->+      doModeInBody p t+    _otherwise ->+      anythingElse+  where+    clearToTableContext =+      elementStackPopWhile p $ \x -> not $ elem (domNodeType x) $+        domTypesHTML ["table", "template", "html"]+    anythingElse = do+      warn "unexpected token"+      fosterParentingSet p+      doModeInBody p t+      fosterParentingClear p+    warn x =+      parseError p (Just t) $ "in table " <> x++-- | Handle the in-table-text insertion mode.+doModeInTableText :: Parser s -> Token -> ST s ()+doModeInTableText p @ Parser {..} t =+  case t of+    TChar {} ->+      pendingTableCharAppend p t+    _otherwise -> do+      a <- pendingTableChars p+      if any (not . chrWhitespace . tCharData) a+      then do+        warn "unexpected character"+        fosterParentingSet p+        mapM_ (doModeInBody p) a+        fosterParentingClear p+      else do+        mapM_ (insertChar p) a+      restoreMode p+      reprocess p t+  where+    warn x =+      parseError p (Just t) $ "in table text " <> x++-- | Handle the in-caption insertion mode.+doModeInCaption :: Parser s -> Token -> ST s ()+doModeInCaption p @ Parser {..} t =+  case t of+    TEnd { tEndName = x@"caption" } ->+      processCaption+    TStart { tStartName = x } | elem x+      ["caption", "col", "colgroup",+       "tbody", "td", "tfoot", "th", "thead", "tr"] -> do+      processCaption+      reprocess p t+    TEnd { tEndName = "table" } -> do+      processCaption+      reprocess p t+    TEnd { tEndName = x } | elem x+      ["body", "col", "colgroup", "html",+       "tbody", "td", "tfoot", "th", "thead", "tr"] ->+      warn "unexpected end tag"+    _otherwise ->+      doModeInBody p t+  where+    processCaption = do+      let a = domMakeTypeHTML "caption"+      elementInTableScope p a >>= \case+        False ->+          warn "no caption in table scope"+        True -> do+          generateImpliedEndTags p+          unlessM (currentNodeHasType p a) $+            warn "current node is not a caption"+          elementStackPopUntilType p a+          activeFormatClear p+          setMode p ModeInTable+    warn x =+      parseError p (Just t) $ "in caption " <> x++-- | Handle the in-column-group insertion mode.+doModeInColumnGroup :: Parser s -> Token -> ST s ()+doModeInColumnGroup p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData ->+      insertChar p t+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TStart { tStartName = "col" } -> do+      insertHtmlElement p t+      elementStackPop p+      selfClosingAcknowledge p+    TEnd { tEndName = x@"colgroup" } -> do+      let a = domMakeTypeHTML x+      currentNodeHasType p a >>= \case+        False ->+          warn "current node not colgroup end"+        True -> do+          elementStackPop p+          setMode p ModeInTable+    TEnd { tEndName = "col" } ->+      warn "col end tag"+    TStart { tStartName = "template" } ->+      doModeInHead p t+    TEnd { tEndName = "template" } ->+      doModeInHead p t+    TEOF ->+      doModeInBody p t+    _otherwise -> do+      let a = domMakeTypeHTML "colgroup"+      currentNodeHasType p a >>= \case+        False ->+          warn "current node not colgroup end"+        True -> do+          elementStackPop p+          setMode p ModeInTable+          reprocess p t+  where+    warn x =+      parseError p (Just t) $ "in column group " <> x++-- | Handle the in-table-body insertion mode.+doModeInTableBody :: Parser s -> Token -> ST s ()+doModeInTableBody p @ Parser {..} t =+  case t of+    TStart { tStartName = "tr" } -> do+      clearToTableBodyContext+      insertHtmlElement p t+      setMode p ModeInRow+    TStart { tStartName = x } | elem x ["th", "td"] -> do+      warn "th or td missing tr"+      clearToTableBodyContext+      insertHtmlElementNamed p "tr"+      setMode p ModeInRow+      reprocess p t+    TEnd { tEndName = x } | elem x+      ["tbody", "tfoot", "thead"] -> do+      let a = domMakeTypeHTML x+      elementInTableScope p a >>= \case+        False ->+          warn "element not in table scope"+        True -> do+          clearToTableBodyContext+          elementStackPop p+          setMode p ModeInTable+    TStart { tStartName = x } | elem x+      ["caption", "col", "colgroup", "tbody", "tfoot", "thead"] ->+      processElements+    TEnd { tEndName = "table" } ->+      processElements+    TEnd { tEndName = x } | elem x+      ["body", "caption", "col", "colgroup", "html", "td", "th", "tr"] ->+      warn "unexpected end tag"+    _otherwise ->+      doModeInTable p t+  where+    processElements = do+      anyM (elementInTableScope p . domMakeTypeHTML)+        ["tbody", "tfoot", "thead"] >>= \case+        False ->+          warn "element not in table scope"+        True -> do+          clearToTableBodyContext+          elementStackPop p+          setMode p ModeInTable+          reprocess p t+    clearToTableBodyContext =+      elementStackPopWhile p $ \x -> not $ elem (domNodeType x) $+        domTypesHTML ["tbody", "tfoot", "thead", "template", "html"]+    warn x =+      parseError p (Just t) $ "in table body " <> x++-- | Handle the in-row insertion mode.+doModeInRow :: Parser s -> Token -> ST s ()+doModeInRow p @ Parser {..} t =+  case t of+    TStart { tStartName = x } | elem x ["th", "td"] -> do+      clearToTableRowContext+      insertHtmlElement p t+      setMode p ModeInCell+      activeFormatAddMarker p+    TEnd { tEndName = "tr" } ->+      processTr+    TStart { tStartName = x } | elem x+      ["caption", "col", "colgroup", "tbody", "tfoot", "thead", "tr"] -> do+      processTr+      reprocess p t+    TEnd { tEndName = "table" } -> do+      processTr+      reprocess p t+    TEnd { tEndName = x } | elem x+      ["tbody", "tfoot", "thead"] -> do+      let a = domMakeTypeHTML x+          b = domMakeTypeHTML "tr"+      elementInTableScope p a >>= \case+        False ->+          warn "element not in table scope"+        True ->+          whenM (elementInTableScope p b) $ do+            clearToTableRowContext+            elementStackPop p+            setMode p ModeInTableBody+            reprocess p t+    TEnd { tEndName = x } | elem x+      ["body", "caption", "col", "colgroup", "html", "td", "th"] ->+      warn "unexpected end tag"+    _otherwise ->+      doModeInTable p t+  where+    processTr = do+      let a = domMakeTypeHTML "tr"+      elementInTableScope p a >>= \case+        False ->+          warn "element not in table scope"+        True -> do+          clearToTableRowContext+          elementStackPop p+          setMode p ModeInTableBody+    clearToTableRowContext =+      elementStackPopWhile p $ \x -> not $ elem (domNodeType x) $+        domTypesHTML ["tr", "template", "html"]+    warn x =+      parseError p (Just t) $ "in row " <> x++-- | Handle the in-cell insertion mode.+doModeInCell :: Parser s -> Token -> ST s ()+doModeInCell p @ Parser {..} t =+  case t of+    TEnd { tEndName = x } | elem x ["td", "th"] -> do+      let a = domMakeTypeHTML x+      elementInTableScope p a >>= \case+        False ->+          warn "element not in table scope"+        True -> do+          generateImpliedEndTags p+          unlessM (currentNodeHasType p a) $+            warn $ "current node not " <> x+          elementStackPopUntilType p a+          activeFormatClear p+          setMode p ModeInRow+    TStart { tStartName = x } | elem x+      ["caption", "col", "colgroup",+       "tbody", "td", "tfoot", "th", "thead", "tr"] -> do+      anyM (elementInTableScope p . domMakeTypeHTML) ["td", "th"] >>= \case+        False ->+          warn "td or th not in table scope"+        True -> do+          closeCell+          reprocess p t+    TEnd { tEndName = x } | elem x+      ["body", "caption", "col", "colgroup", "html"] ->+      warn "unexpected end tag"+    TEnd { tEndName = x } | elem x+      ["table", "tbody", "tfoot", "thead", "tr"] -> do+      let a = domMakeTypeHTML x+      elementInTableScope p a >>= \case+        False ->+          warn "element not in table scope"+        True -> do+          closeCell+          reprocess p t+    _otherwise ->+      doModeInBody p t+  where+    closeCell = do+      let a = domTypesHTML ["td", "th"]+      generateImpliedEndTags p+      unlessM (currentNodeHasTypeIn p a) $+        warn "current node is not td or th"+      elementStackPopUntilTypeIn p a+      activeFormatClear p+      setMode p ModeInRow+    warn x =+      parseError p (Just t) $ "in cell " <> x++-- | Handle the in-select insertion mode.+doModeInSelect :: Parser s -> Token -> ST s ()+doModeInSelect p @ Parser {..} t =+  case t of+    TChar {} ->+      insertChar p t+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TStart { tStartName = x@"option" } -> do+      elementStackPopIf p $ elementName x+      insertHtmlElement p t+    TStart { tStartName = x@"optgroup" } -> do+      elementStackPopIf p $ elementName "option"+      elementStackPopIf p $ elementName x+      insertHtmlElement p t+    TEnd { tEndName = x@"optgroup" } -> do+      let a = domMakeTypeHTML "option"+          b = domMakeTypeHTML x+      y <- take 2 <$> elementStackTypes p+      when (y == [a,b]) $ elementStackPop p+      currentNodeHasType p b >>= \case+        False ->+          warn $ "current node not " <> x+        True ->+          elementStackPop p+    TEnd { tEndName = x@"option" } -> do+      currentNodeHasType p (domMakeTypeHTML x) >>= \case+        False ->+          warn $ "current node not " <> x+        True ->+          elementStackPop p+    TEnd { tEndName = x@"select" } -> do+      let a = domMakeTypeHTML x+      elementInSelectScope p a >>= \case+        False ->+          warn "no select in select scope"+        True -> do+          elementStackPopUntilType p a+          resetInsertionMode p+    TStart { tStartName = x@"select" } -> do+      warn "unexpected start tag"+      let a = domMakeTypeHTML x+      whenM (elementInSelectScope p a) $ do+        elementStackPopUntilType p a+        resetInsertionMode p+    TStart { tStartName = x } | elem x+      ["input", "keygen", "textarea"] -> do+      warn "unexpected start tag"+      let a = domMakeTypeHTML x+      whenM (elementInSelectScope p a) $ do+        elementStackPopUntilType p a+        resetInsertionMode p+        reprocess p t+    TStart { tStartName = x } | elem x+     ["script", "template"] ->+      doModeInHead p t+    TEnd { tEndName = "template" } ->+      doModeInHead p t+    TEOF ->+      doModeInBody p t+    _otherwise ->+      warn "unexpected token"+  where+    warn x =+      parseError p (Just t) $ "in select " <> x++-- | Handle the in-select-in-table insertion mode.+doModeInSelectInTable :: Parser s -> Token -> ST s ()+doModeInSelectInTable p @ Parser {..} t =+  case t of+    TStart { tStartName = x } | elem x+      ["caption", "table", "tbody", "tfoot",+       "thead", "tr", "td", "th"] -> do+      warn "unexpected start tag"+      elementStackPopUntilType p $ domMakeTypeHTML "select"+      resetInsertionMode p+      reprocess p t+    TEnd { tEndName = x } | elem x+      ["caption", "table", "tbody", "tfoot",+       "thead", "tr", "td", "th"] -> do+      warn "unexpected end tag"+      whenM (elementInTableScope p $ domMakeTypeHTML x) $ do+        elementStackPopUntilType p $ domMakeTypeHTML "select"+        resetInsertionMode p+        reprocess p t+    _otherwise ->+      doModeInSelect p t+  where+    warn x =+      parseError p (Just t) $ "in select in table " <> x++-- | Handle the in-template insertion mode.+doModeInTemplate :: Parser s -> Token -> ST s ()+doModeInTemplate p @ Parser {..} t =+  case t of+    TChar {} ->+      doModeInBody p t+    TComment {} ->+      doModeInBody p t+    TDoctype {} ->+      doModeInBody p t+    TStart { tStartName = x } | elem x+      ["base", "basefont", "bgsound", "link", "meta",+       "noframes", "script", "style", "template", "title"] ->+      doModeInHead p t+    TEnd { tEndName = "template" } ->+      doModeInHead p t+    TStart { tStartName = x } | elem x+      ["caption", "col", "tbody", "tfoot", "thead"] -> do+      templateModePop p+      templateModePush p ModeInTable+      setMode p ModeInTable+      reprocess p t+    TStart { tStartName = "col" } -> do+      templateModePop p+      templateModePush p ModeInColumnGroup+      setMode p ModeInColumnGroup+      reprocess p t+    TStart { tStartName = "tr" } -> do+      templateModePop p+      templateModePush p ModeInTableBody+      setMode p ModeInTableBody+      reprocess p t+    TStart { tStartName = x } | elem x ["td", "th"] -> do+      templateModePop p+      templateModePush p ModeInRow+      setMode p ModeInRow+      reprocess p t+    TStart {} -> do+      templateModePop p+      templateModePush p ModeInBody+      setMode p ModeInBody+      reprocess p t+    TEnd {} ->+      warn "unexpected end tag"+    TEOF ->+      elementStackMissingTemplate p >>= \case+        True ->+          parserSetDone p+        False -> do+          warn "template on stack"+          activeFormatClear p+          templateModePop p+          resetInsertionMode p+          reprocess p t+  where+    warn x =+      parseError p (Just t) $ "in template " <> x++-- | Handle the after-body insertion mode.+doModeAfterBody :: Parser s -> Token -> ST s ()+doModeAfterBody p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData ->+      doModeInBody p t+    TComment {} -> do+      x <- domPos . fromJust <$> lastNodeID p+      commentMake p t >>= void . insertNewNode p x+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TEnd { tEndName = "html" } ->+      rref parserFragmentMode >>= \case+        True ->+          warn "html end tag"+        False ->+          setMode p ModeAfterAfterBody+    TEOF ->+      parserSetDone p+    _otherwise -> do+      warn "unexpected token"+      setMode p ModeInBody+      reprocess p t+  where+    warn x =+      parseError p (Just t) $ "after body " <> x++-- | Handle the in-frameset insertion mode.+doModeInFrameset :: Parser s -> Token -> ST s ()+doModeInFrameset p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData ->+      insertChar p t+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TStart { tStartName = "frameset" } ->+      insertHtmlElement p t+    TEnd { tEndName = "frameset" } -> do+      currentNodeHasHTMLType p "html" >>= \case+        True ->+          warn "current node is html"+        False -> do+          elementStackPop p+          whenM (notM (rref parserFragmentMode) &&^+            notM (currentNodeHasHTMLType p "frameset")) $+            setMode p ModeAfterFrameset+    TStart { tStartName = "frame" } -> do+      insertHtmlElement p t+      elementStackPop p+      selfClosingAcknowledge p+    TStart { tStartName = "noframes" } ->+      doModeInHead p t+    TEOF -> do+      unlessM (currentNodeHasHTMLType p "html") $+        warn "current node is not html"+      parserSetDone p+    _ ->+      warn "unexpected token"+  where+    warn x =+      parseError p (Just t) $ "in frameset " <> x++-- | Handle the after-frameset insertion mode.+doModeAfterFrameset :: Parser s -> Token -> ST s ()+doModeAfterFrameset p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData ->+      insertChar p t+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TEnd { tEndName = "html" } ->+      setMode p ModeAfterAfterFrameset+    TStart { tStartName = "noframes" } ->+      doModeInHead p t+    TEOF ->+      parserSetDone p+    _ ->+      warn "unexpected token"+    where+      warn x =+        parseError p (Just t) $ "after frameset " <> x++-- | Handle the after-after-body insertion mode.+doModeAfterAfterBody :: Parser s -> Token -> ST s ()+doModeAfterAfterBody p @ Parser {..} t =+  case t of+    TComment {} ->+      insertDocComment p t+    TDoctype {} ->+      doModeInBody p t+    TChar {..} | chrWhitespace tCharData ->+      doModeInBody p t+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TEOF ->+      parserSetDone p+    _otherwise -> do+      warn "unexpected token"+      setMode p ModeInBody+      reprocess p t+    where+      warn x =+        parseError p (Just t) $ "after after body " <> x++-- | Handle the after-after-frameset insertion mode.+doModeAfterAfterFrameset :: Parser s -> Token -> ST s ()+doModeAfterAfterFrameset p @ Parser {..} t =+  case t of+    TComment {} ->+      insertDocComment p t+    TDoctype {} ->+      doModeInBody p t+    TChar {..} | chrWhitespace tCharData ->+      doModeInBody p t+    TStart { tStartName = "html" } ->+      doModeInBody p t+    TEOF ->+      parserSetDone p+    TStart { tStartName = "noframes" } ->+      doModeInHead p t+    _otherwise -> do+      warn "unexpected token"+    where+      warn x =+        parseError p (Just t) $ "after after frameset " <> x++-- | Handle foreign content.+doForeignContent :: Parser s -> Token -> ST s ()+doForeignContent p @ Parser {..} t =+  case t of+    TChar {..} | chrWhitespace tCharData ->+      insertChar p t+    TChar {} -> do+      insertChar p t+      frameSetNotOK p+    TComment {} ->+      insertComment p t+    TDoctype {} ->+      warn "doctype"+    TStart { tStartName = x } | elem x+      ["b", "big", "blockquote", "body", "br", "center",+       "code", "dd", "div", "dl", "dt", "em", "embed",+       "h1", "h2", "h3", "h4", "h5", "h6", "head",+       "hr", "i", "img", "li", "listing", "menu",+       "meta", "nobr", "ol", "p", "pre", "ruby", "s",+       "small", "span", "strong", "strike", "sub",+       "sup", "table", "tt", "u", "ul", "var"]+      || x == "font" &&+         any (flip tokenHasAttr t) ["color","face","size"] -> do+      warn "unexpected start tag"+      rref parserFragmentMode >>= \case+        True ->+          anyOtherStartTag+        False -> do+          elementStackPop p+          elementStackPopWhile p $ \n ->+            not (isMathMLIntegrationPoint n+                 || isHtmlIntgrationPoint n+                 || domNodeIsHTML n)+          reprocess p t+    TStart {} ->+      anyOtherStartTag+    TEnd {} -> do+      let s = "script"+          a = domMakeTypeSVG s+          n = tEndName t+      svg <- maybe False ((==) a . domNodeType) <$> currentNode p+      if n == s && svg+      then doScriptEndTag+      else do+        node <- fromJust <$> currentNode p+        let h = bsLower . domNodeElementName+            nodeName = h node+        when (nodeName /= n) $+          warn $+            "bad end tag in foreign content ("+            <> nodeName <> " /= " <> bcPack (show n) <> ")"+        let f (x:[]) = pure ()+            f (x:y:ys)+              | h x == n =+                  elementStackPopUntilID p $ domNodeID node+              | domNodeIsHTML y =+                  doHtmlContent p t+              | otherwise =+                  f (y:ys)+        elementStackNodes p >>= f+  where+    anyOtherStartTag = do+      (t', n) <- adjustedCurrentNode p >>= \case+        Just a+          | domNodeIsMathML a ->+              pure ( adjustAttrMathML t+                   , domNodeElementNamespace a+                   )+          | domNodeIsSVG a ->+              pure ( adjustElemSVG $ adjustAttrSVG t+                   , domNodeElementNamespace a+                   )+        Nothing ->+          pure (t, HTMLNamespaceHTML)+      insertForeignElement p n $ adjustAttrForeign t'+      when (tStartClosed t) $ do+        svg <- maybe False domNodeIsSVG <$> currentNode p+        if tStartName t == "script" && svg+        then do+          selfClosingAcknowledge p+          doScriptEndTag+        else do+          elementStackPop p+          selfClosingAcknowledge p+    doScriptEndTag = do+      elementStackPop p+    warn x =+      parseError p (Just t) $ "foreign content " <> x
+ src/Zenacy/HTML/Internal/Query.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | A basic query facility.+module Zenacy.HTML.Internal.Query+  ( HTMLQuery+  , htmlQueryRun+  , htmlQueryExec+  , htmlQueryTry+  , htmlQueryStop+  , htmlQueryCont+  , htmlQuerySucc+  , htmlQueryZipper+  , htmlQueryNode+  , htmlQueryFirst+  , htmlQueryLast+  , htmlQueryNext+  , htmlQueryPrev+  , htmlQueryUp+  , htmlQueryTest+  , htmlQueryName+  , htmlQueryIsFirst+  , htmlQueryIsLast+  , htmlQuerySave+  , htmlQueryGet+  , htmlQueryGetZipper+  , htmlQuerySrc+  , htmlQueryAttr+  , htmlQueryAttrVal+  , htmlQueryId+  , htmlQueryHasClass+  , htmlQueryOnly+  ) where++import Prelude+import Zenacy.HTML.Internal.HTML+import Zenacy.HTML.Internal.Oper+import Zenacy.HTML.Internal.Zip+import Control.Monad.State+  ( MonadState+  , State+  , evalState+  , modify+  , gets+  )+import Control.Monad.Trans.Maybe+  ( MaybeT(..)+  , runMaybeT+  )+import Data.Bool+  ( bool+  )+import Data.IntMap+  ( IntMap+  )+import qualified Data.IntMap as IntMap+  ( fromList+  , lookup+  , insert+  )+import Data.Maybe+  ( fromMaybe+  , isNothing+  )+import Data.Text+  ( Text+  )++-- | Defines the query state.+type QueryState = (HTMLZipper, IntMap HTMLZipper)++-- | Defines the type for a query.+newtype HTMLQuery a = HTMLQuery { htmlQueryState :: MaybeT (State QueryState) a }+  deriving (Functor, Applicative, Monad, MonadState QueryState)++-- | Runs a query and returns a result.+htmlQueryRun :: HTMLNode -> HTMLQuery a -> Maybe a+htmlQueryRun x q = evalState (runMaybeT $ htmlQueryState q) s+  where+    z = htmlZip x+    s = (z, IntMap.fromList [(0,z)])++-- | Same as run with the arguments flipped.+htmlQueryExec :: HTMLQuery a -> HTMLNode -> Maybe a+htmlQueryExec = flip htmlQueryRun++-- | Same as run with the arguments flipped.+htmlQueryTry :: HTMLQuery HTMLNode -> HTMLNode -> HTMLNode+htmlQueryTry q x = fromMaybe x $ htmlQueryRun x q++-- | Wraps a value as a query result.+htmlQueryWrap :: Maybe a -> HTMLQuery a+htmlQueryWrap = HTMLQuery . MaybeT . pure++-- | Returns a result that stops the query.+htmlQueryStop :: HTMLQuery a+htmlQueryStop = htmlQueryWrap $ Nothing++-- | Returns a result that continues the query.+htmlQueryCont :: HTMLQuery ()+htmlQueryCont = htmlQuerySucc ()++-- | Returns a successful query result.+htmlQuerySucc :: a -> HTMLQuery a+htmlQuerySucc = htmlQueryWrap . Just++-- | Gets the current query zipper.+htmlQueryZipper :: HTMLQuery HTMLZipper+htmlQueryZipper = gets fst++-- | Gets the current query node.+htmlQueryNode :: HTMLQuery HTMLNode+htmlQueryNode = htmlZipNode <$> htmlQueryZipper++-- | Performs a query step with a zipper operation.+withZip :: (HTMLZipper -> Maybe HTMLZipper) -> HTMLQuery ()+withZip f = do+  z <- htmlQueryZipper+  case f z of+    Nothing ->+      htmlQueryStop+    Just z' -> do+      modify $ \(_, m) -> (z', m)+      htmlQueryCont++-- | Moves the query to the first child node.+htmlQueryFirst :: HTMLQuery ()+htmlQueryFirst = withZip htmlZipFirst++-- | Moves the query to the last child node.+htmlQueryLast :: HTMLQuery ()+htmlQueryLast = withZip htmlZipLast++-- | Moves the query to the next sibling node.+htmlQueryNext :: HTMLQuery ()+htmlQueryNext = withZip htmlZipNext++-- | Moves the query to the previous sibling node.+htmlQueryPrev :: HTMLQuery ()+htmlQueryPrev = withZip htmlZipPrev++-- | Moves the query to the parent node.+htmlQueryUp :: HTMLQuery ()+htmlQueryUp = withZip htmlZipUp++-- | Evaluates a test result and continues the query if true.+htmlQueryTest :: Bool -> HTMLQuery ()+htmlQueryTest = bool htmlQueryStop htmlQueryCont++-- | Tests the current element name.+htmlQueryName :: Text -> HTMLQuery ()+htmlQueryName x = do+  n <- htmlQueryNode+  htmlQueryTest $ htmlElemName n == x++-- | Tests the current node to see if it is the first sibling.+htmlQueryIsFirst :: HTMLQuery ()+htmlQueryIsFirst = do+  z <- htmlQueryZipper+  htmlQueryTest $ isNothing $ htmlZipPrev z++-- | Tests the current node to see if it is the last sibling.+htmlQueryIsLast :: HTMLQuery ()+htmlQueryIsLast = do+  z <- htmlQueryZipper+  htmlQueryTest $ isNothing $ htmlZipNext z++-- | Saves the current query state.+htmlQuerySave :: Int -> HTMLQuery ()+htmlQuerySave x = do+  modify $ \(z, m) -> (z, IntMap.insert x z m)+  htmlQueryCont++-- | Gets a saved query node.+htmlQueryGet :: Int -> HTMLQuery HTMLNode+htmlQueryGet x = htmlZipNode <$> htmlQueryGetZipper x++-- | Gets a saved query zipper.+htmlQueryGetZipper :: Int -> HTMLQuery HTMLZipper+htmlQueryGetZipper x = do+  m <- gets snd+  case IntMap.lookup x m of+    Just z -> htmlQuerySucc z+    Nothing -> htmlQueryStop++-- | Gets the source input node.+htmlQuerySrc :: HTMLQuery HTMLNode+htmlQuerySrc = htmlQueryGet 0++-- | Tests if the current node has an attribute.+htmlQueryAttr :: Text -> HTMLQuery ()+htmlQueryAttr x = htmlQueryNode >>= htmlQueryTest . htmlElemHasAttrName x++-- | Tests if the current node has an attribute value.+htmlQueryAttrVal :: Text -> Text -> HTMLQuery ()+htmlQueryAttrVal n v = htmlQueryNode >>= htmlQueryTest . htmlElemHasAttrVal n v++-- | Tests if the current node has an id.+htmlQueryId :: Text -> HTMLQuery ()+htmlQueryId x = htmlQueryNode >>= htmlQueryTest . htmlElemHasID x++-- | Tests if the current node has a class.+htmlQueryHasClass :: Text -> HTMLQuery ()+htmlQueryHasClass x = htmlQueryNode >>= htmlQueryTest . htmlElemClassesContains x++-- | Moves to the child and require that it is the only child.+htmlQueryOnly :: Text -> HTMLQuery ()+htmlQueryOnly x = htmlQueryFirst >> htmlQueryName x >> htmlQueryIsLast
+ src/Zenacy/HTML/Internal/Render.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines the HTML render.+module Zenacy.HTML.Internal.Render+  ( htmlPrint+  , htmlPrintPretty+  , htmlRender+  , htmlRenderContent+  , htmlRenderNodes+  , htmlRenderPretty+  ) where++import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.HTML+import Zenacy.HTML.Internal.Oper+import Data.Monoid+  ( (<>)+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( append+  , concat+  , empty+  , intercalate+  , replace+  )+import qualified Data.Text.IO as T+  ( putStrLn+  )++-- | The rendering mode.+data HTMLRenderMode+  = HTMLRenderNormal+  | HTMLRenderPretty+    deriving (Show, Eq, Ord)++-- | Prints an HTML document.+htmlPrint :: HTMLNode -> IO ()+htmlPrint = T.putStrLn . htmlRender++-- | Pretty prints an HTML document.+htmlPrintPretty :: HTMLNode -> IO ()+htmlPrintPretty = T.putStrLn . htmlRenderPretty++-- | Renders an HTML document.+htmlRender :: HTMLNode -> Text+htmlRender = renderModal HTMLRenderNormal++-- | Renders the contents of a node+htmlRenderContent :: HTMLNode -> Text+htmlRenderContent = htmlRenderNodes . htmlNodeContent++-- | Renders a list of nodes.+htmlRenderNodes :: [HTMLNode] -> Text+htmlRenderNodes = T.concat . map htmlRender++-- | Renders an HTML document using pretty printing.+htmlRenderPretty :: HTMLNode -> Text+htmlRenderPretty = renderModal HTMLRenderPretty++-- | Renders an HTML document with a styling mode.+renderModal :: HTMLRenderMode -> HTMLNode -> Text+renderModal m = go 0 ""+  where+    go level parent node =+      case node of+        HTMLDocument _ c ->+          join $ map (go level parent) c+        HTMLDoctype n p s ->+          indent <> renderDoctype n p s+        HTMLFragment n c ->+          join $ map (go level parent) c+        HTMLElement n s a c ->+          indent+          <> renderElemStart n a+          <> if voidTag n+             then T.empty+             else (if | genLF n c -> "\n"+                      | oneLine c -> T.empty+                      | otherwise -> sep)+                  <> (join $ map (go (if oneLine c then 0 else level') n) c)+                  <> (if | oneLine c -> T.empty+                         | null c -> indent+                         | otherwise -> sep <> indent)+                  <> renderElemEnd n+        HTMLTemplate s a c ->+          indent <> renderElemStart tmp a+          <> sep <> go level' tmp c+          <> sep <> indent <> renderElemEnd tmp+        HTMLText t ->+          indent <> renderText t parent+        HTMLComment c ->+          indent <> renderComment c+      where+        level' = level + 1+        join = T.intercalate sep+        indent = case m of+          HTMLRenderNormal -> T.empty+          HTMLRenderPretty -> textBlank level+        sep = case m of+          HTMLRenderNormal -> T.empty+          HTMLRenderPretty -> "\n"+        tmp = "template"+        voidTag x = elem x+          ["area", "base", "basefont", "bgsound", "br", "col",+           "embed", "frame", "hr", "img", "input", "keygen",+           "link", "meta", "param", "source", "track", "wbr"]+        genLF x c = elem x ["pre", "textarea", "listing"] && oneText c+        oneText (HTMLText {}:[]) = True+        oneText _ = False+        oneLine x = oneText x || null x++-- | Renders text for a doctype.+renderDoctype :: Text -> Maybe Text -> Maybe Text -> Text+renderDoctype x y z = "<!DOCTYPE " <> x <> f y <> f z <> ">"+  where+    f = maybe "" (T.append " ")++-- | Returns text for an attribute.+renderAttr :: HTMLAttr -> Text+renderAttr (HTMLAttr n v s) =+  " " <> n' <> "=\"" <> escapeString True v <> "\""+  where+    n' = case s of+      HTMLAttrNamespaceNone -> n+      HTMLAttrNamespaceXLink -> "xlink:" <> n+      HTMLAttrNamespaceXML -> "xml:" <> n+      HTMLAttrNamespaceXMLNS ->+        if n == "xmlns" then n else "xmlns:" <> n++-- | Returns text for a list of attributes.+renderAttrList :: [HTMLAttr] -> Text+renderAttrList = T.concat . map renderAttr++-- | Returns text for a start element.+renderElemStart :: Text -> [HTMLAttr] -> Text+renderElemStart x y = "<" <> x <> renderAttrList y <> ">"++-- | Returns text for an end element.+renderElemEnd :: Text -> Text+renderElemEnd x = "</" <> x <> ">"++-- | Renders a text value.+renderText :: Text -> Text -> Text+renderText x parent =+  if parent `elem` a then x else escapeString False x+  where a = ["style", "script", "xmp", "iframe",+             "noembed", "noframes", "plaintext"]++-- | Renders text for a comment element.+renderComment :: Text -> Text+renderComment x = "<!--" <> x <> "-->"++-- | Escapes a string for serialization.+escapeString :: Bool -> Text -> Text+escapeString attributeMode =+  f . T.replace "\x00A0"  "&nbsp;"+    -- . T.replace "&" "&amp;" -- TODO: consider if this is needed+  where+    f = if attributeMode+        then T.replace "\"" "&quot;"+        else T.replace ">" "&gt;"+           . T.replace "<" "&lt;"
+ src/Zenacy/HTML/Internal/Token.hs view
@@ -0,0 +1,695 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines a token type used by the lexer.+module Zenacy.HTML.Internal.Token+  ( Token(..)+  , TokenBuffer(..)+  , TAttr(..)+  , tokenAttr+  , tokenHasAttr+  , tokenGetAttr+  , tokenGetAttrVal+  , tokenBuffer+  , tokenCapacity+  , tokenReset+  , tokenTail+  , tokenFirst+  , tokenNext+  , tokenCount+  , tokenOffset+  , tokenList+  , tokenDrop+  , tokenHasEOF+  , tokenSlice+  , tokenTagStartName+  , tokenTagEndName+  , tokenDoctypeType+  , tokenTagStartType+  , tokenTagEndType+  , tokenCommentType+  , tokenCharType+  , tokenEOFType+  , tokenDoctypeInit+  , tokenDoctypeNameAppend+  , tokenDoctypeSetForceQuirks+  , tokenDoctypePublicIdInit+  , tokenDoctypePublicIdAppend+  , tokenDoctypeSystemIdInit+  , tokenDoctypeSystemIdAppend+  , tokenTagStartInit+  , tokenTagStartSetSelfClosing+  , tokenTagEndInit+  , tokenTagNameAppend+  , tokenAttrInit+  , tokenAttrNameAppend+  , tokenAttrValAppend+  , tokenAttrNamePrune+  , tokenCommentInit+  , tokenCommentAppend+  , tokenCharInit+  , tokenEOFInit+  , tokenType+  , tokenSize+  , tokenPack+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Buffer+import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.Types+import Control.Monad+  ( when+  , forM+  )+import Control.Monad.Extra+  ( anyM+  )+import Control.Monad.ST+  ( ST+  )+import Data.STRef+  ( STRef+  , newSTRef+  , readSTRef+  , writeSTRef+  )+import Data.DList+  ( DList+  )+import qualified Data.DList as D+  ( empty+  , snoc+  , toList+  )+import Data.List+  ( find+  , or+  )+import Data.Maybe+  ( catMaybes+  , isJust+  )+import Data.Vector.Unboxed.Mutable+  ( MVector+  )+import qualified Data.Vector.Unboxed.Mutable as U+  ( new+  , length+  , read+  , write+  , grow+  )+import Data.Word+  ( Word8+  )++-- | Defines the token type.+-- The token type is used for testing and debugging only.+data Token+  = TDoctype+    { tDoctypeName   :: !BS+    , tDoctypeQuirks :: !Bool+    , tDoctypePublic :: !(Maybe BS)+    , tDoctypeSystem :: !(Maybe BS)+    }+  | TStart+    { tStartName     :: !BS+    , tStartClosed   :: !Bool+    , tStartAttr     :: ![TAttr]+    }+  | TEnd+    { tEndName       :: !BS+    }+  | TComment+    { tCommentData   :: !BS+    }+  | TChar+    { tCharData      :: !Word8+    }+  | TEOF+    deriving (Eq, Ord, Show)++-- | An HTML element attribute type.+data TAttr = TAttr+  { tAttrName      :: BS+  , tAttrVal       :: BS+  , tAttrNamespace :: HTMLAttrNamespace+  } deriving (Eq, Ord, Show)++-- | A type of buffer used to hold tokens.+data TokenBuffer s = TokenBuffer+  { tbCntl :: MVector s Int+  , tbData :: MVector s Word8+  }++-- | Makes an attribute.+tokenAttr :: BS -> BS -> TAttr+tokenAttr n v = TAttr n v HTMLAttrNamespaceNone++-- | Determines if a token has an attribute.+tokenHasAttr :: BS -> Token -> Bool+tokenHasAttr x t = isJust $ tokenGetAttr x t++-- | Finds an attribute in a token.+tokenGetAttr :: BS -> Token -> Maybe TAttr+tokenGetAttr x = \case+  TStart{..} -> find (\TAttr{..} -> tAttrName == x) tStartAttr+  _otherwise -> Nothing++-- | Finds an attribute value for a token.+tokenGetAttrVal :: BS -> Token -> Maybe BS+tokenGetAttrVal x t = tAttrVal <$> tokenGetAttr x t++-- | Makes a new token buffer.+tokenBuffer :: ST s (STRef s (TokenBuffer s))+tokenBuffer = do+  c <- U.new 100+  d <- U.new 100+  r <- newSTRef (TokenBuffer c d)+  tokenReset r+  pure r++-- | Gets the capacity of the buffer.+tokenCapacity :: STRef s (TokenBuffer s) -> ST s (Int, Int)+tokenCapacity r = do+  TokenBuffer{..} <- readSTRef r+  pure (U.length tbCntl, U.length tbData)++-- | Size of the buffer header.+headerSize :: Int+headerSize = 4++-- | Resets a token buffer.+tokenReset :: STRef s (TokenBuffer s) -> ST s ()+tokenReset r = do+  TokenBuffer{..} <- readSTRef r+  U.write tbCntl 0 1 -- data buffer length (skip first byte)+  U.write tbCntl 1 0 -- token list head offset+  U.write tbCntl 2 0 -- token list tail offset+  U.write tbCntl 3 0 -- token emit offset+  U.write tbData 0 0 -- first byte is unsed++-- | Get the token buffer tail offset.+tokenTail :: STRef s (TokenBuffer s) -> ST s Int+tokenTail r = do+  TokenBuffer{..} <- readSTRef r+  U.read tbCntl 2++-- | Positions the emitter to the first token and returns its offset.+tokenFirst :: STRef s (TokenBuffer s) -> ST s Int+tokenFirst r = do+  TokenBuffer{..} <- readSTRef r+  h <- U.read tbCntl 1+  U.write tbCntl 3 h+  pure h++-- | Positions the emitter to the next token and returns its offset.+tokenNext :: STRef s (TokenBuffer s) -> ST s Int+tokenNext r = do+  TokenBuffer{..} <- readSTRef r+  t <- U.read tbCntl 2+  i <- U.read tbCntl 3+  n <- U.read tbCntl (i + 1)+  if i == t+     then pure 0+     else do+       let j = i + n+       U.write tbCntl 3 j+       pure j++-- | Counts the number of tokens in the buffer.+tokenCount :: STRef s (TokenBuffer s) -> ST s Int+tokenCount r = tokenFold (\i n -> n + 1) 0 r++-- | Gets a list of the tokens in the buffer.+tokenOffset :: STRef s (TokenBuffer s) -> ST s [Int]+tokenOffset r = D.toList <$> tokenFold (flip D.snoc) D.empty r++-- | Gets a list of the tokens in the buffer.+tokenList :: STRef s (TokenBuffer s) -> ST s [Token]+tokenList r = tokenOffset r >>= mapM (flip tokenPack r)++-- | Performs a fold over the token offsets in the buffer.+tokenFold :: (Int -> a -> a) -> a -> STRef s (TokenBuffer s) -> ST s a+tokenFold f a r = do+  TokenBuffer{..} <- readSTRef r+  i <- U.read tbCntl 3+  x <- go a tokenFirst+  U.write tbCntl 3 i+  pure x+  where+    go b g = do+      i <- g r+      if i == 0+         then pure b+         else go (f i b) tokenNext++-- | Drops the last token from the buffer.+tokenDrop :: STRef s (TokenBuffer s) -> ST s ()+tokenDrop r = do+  TokenBuffer{..} <- readSTRef r+  headPtr <- U.read tbCntl 1+  tailPtr <- U.read tbCntl 2+  when (tailPtr > 0) $ do+    if tailPtr == headPtr+       then tokenReset r+       else go tbCntl tailPtr headPtr+  where+    go d t i = do+      n <- U.read d (i + offsetSize)+      if t == i + n+         then U.write d 2 i+         else go d t (i + n)++-- | Returns whether a buffer includes an EOF token.+tokenHasEOF :: STRef s (TokenBuffer s) -> ST s Bool+tokenHasEOF r =+  tokenOffset r >>= anyM isEOF+  where+    isEOF i = (== tokenEOFType) <$> tokenType i r++-- | Returns a slice of the data area of a token buffer.+tokenSlice :: Int -> Int -> STRef s (TokenBuffer s) -> ST s [Word8]+tokenSlice offset len r = do+  TokenBuffer{..} <- readSTRef r+  go tbData offset len D.empty+  where+    go d i 0 a = pure $ D.toList a+    go d i n a = do+      w <- U.read d i+      go d (i + 1) (n - 1) $ D.snoc a w++-- | Returns the start tag name at for the token at an offset.+tokenTagStartName :: Int -> STRef s (TokenBuffer s) -> ST s (Maybe [Word8])+tokenTagStartName = tagNameIfType tokenTagStartType++-- | Returns the end tag name at for the token at an offset.+tokenTagEndName :: Int -> STRef s (TokenBuffer s) -> ST s (Maybe [Word8])+tokenTagEndName = tagNameIfType tokenTagEndType++-- | Returns the start tag name at for the token at an offset.+tagNameIfType :: Int -> Int -> STRef s (TokenBuffer s) -> ST s (Maybe [Word8])+tagNameIfType t x r = do+  TokenBuffer{..} <- readSTRef r+  a <- tokenType x r+  if a == t+     then do+       o <- U.read tbCntl (x + 2)+       n <- U.read tbCntl (x + 3)+       Just <$> tokenSlice o n r+     else+       pure Nothing++-- | Defines the type for a DOCTYPE token.+tokenDoctypeType :: Int+tokenDoctypeType = 101++-- | Defines the type for a start tag token.+tokenTagStartType :: Int+tokenTagStartType = 102++-- | Defines the type for a end tag token.+tokenTagEndType :: Int+tokenTagEndType = 103++-- | Defines the type for a comment token.+tokenCommentType :: Int+tokenCommentType = 104++-- | Defines the type for a character token.+tokenCharType :: Int+tokenCharType = 105++-- | Defines the type for an EOF token.+tokenEOFType :: Int+tokenEOFType = 106++tokenInit :: Int -> STRef s (TokenBuffer s) -> ST s (MVector s Int, Int)+tokenInit maxIndex r = do+  t@TokenBuffer{..} <- readSTRef r+  tailPtr <- U.read tbCntl 2+  i <- if tailPtr == 0+       then do+         U.write tbCntl 1 headerSize+         U.write tbCntl 2 headerSize+         pure headerSize+       else do+         n <- U.read tbCntl (tailPtr + offsetSize)+         let j = tailPtr + n+         U.write tbCntl 2 j+         pure j+  c <- ensureCntl (i + maxIndex) t r+  pure (c, i)++-- | Defines the size of the doctype token.+tokenDoctypeSize :: Int+tokenDoctypeSize = 11++-- | Adds a new DOCTYPE token to the lexer.+tokenDoctypeInit :: STRef s (TokenBuffer s) -> ST s ()+tokenDoctypeInit r = do+  (c, i) <- tokenInit 10 r+  U.write c (i + 0) tokenDoctypeType+  U.write c (i + 1) tokenDoctypeSize+  U.write c (i + 2) 0 -- name offset+  U.write c (i + 3) 0 -- name length+  U.write c (i + 4) 0 -- force quirks flag+  U.write c (i + 5) 0 -- public id exists flag+  U.write c (i + 6) 0 -- public id offset+  U.write c (i + 7) 0 -- public id length+  U.write c (i + 8) 0 -- system id exists flag+  U.write c (i + 9) 0 -- system id offset+  U.write c (i + 10) 0 -- system id length++-- | Appends a character to the current DOCTYPE token.+tokenDoctypeNameAppend :: Word8 -> STRef s (TokenBuffer s) -> ST s ()+tokenDoctypeNameAppend = stringAppendTail 2++-- | Sets the force quirks flag for the current DOCTYPE.+tokenDoctypeSetForceQuirks :: STRef s (TokenBuffer s) -> ST s ()+tokenDoctypeSetForceQuirks r = do+  TokenBuffer{..} <- readSTRef r+  i <- U.read tbCntl 2+  U.write tbCntl (i + 4) 1++-- | Initializes the DOCTYPE public ID.+tokenDoctypePublicIdInit :: STRef s (TokenBuffer s) -> ST s ()+tokenDoctypePublicIdInit r = do+  TokenBuffer{..} <- readSTRef r+  i <- U.read tbCntl 2+  U.write tbCntl (i + 5) 1++-- | Appends a character to the DOCTYPE public ID.+tokenDoctypePublicIdAppend :: Word8 -> STRef s (TokenBuffer s) -> ST s ()+tokenDoctypePublicIdAppend = stringAppendTail 6++-- | Initializes the DOCTYPE system ID.+tokenDoctypeSystemIdInit :: STRef s (TokenBuffer s) -> ST s ()+tokenDoctypeSystemIdInit r = do+  TokenBuffer{..} <- readSTRef r+  i <- U.read tbCntl 2+  U.write tbCntl (i + 8) 1++-- | Appends a character to the DOCTYPE system ID.+tokenDoctypeSystemIdAppend :: Word8 -> STRef s (TokenBuffer s) -> ST s ()+tokenDoctypeSystemIdAppend = stringAppendTail 9++-- | Defines the size of an attribute record.+attrSize :: Int+attrSize = 4++-- | Defines the offset to the start of the attributes.+attrStart :: Int+attrStart = 6++-- | Defines the size of the start tag token.+tokenTagStartSize :: Int+tokenTagStartSize = 6++-- | Adds a new start tag to the lexer.+tokenTagStartInit :: STRef s (TokenBuffer s) -> ST s ()+tokenTagStartInit r = do+  (c, i) <- tokenInit 5 r+  U.write c (i + 0) tokenTagStartType+  U.write c (i + 1) tokenTagStartSize+  U.write c (i + 2) 0 -- name offset+  U.write c (i + 3) 0 -- name length+  U.write c (i + 4) 0 -- self closing flag+  U.write c (i + 5) 0 -- attribute count++-- | Defines the size of the end tag token.+tokenTagEndSize :: Int+tokenTagEndSize = 4++-- | Adds a new end tag to the lexer.+tokenTagEndInit :: STRef s (TokenBuffer s) -> ST s ()+tokenTagEndInit r = do+  (c, i) <- tokenInit 3 r+  U.write c (i + 0) tokenTagEndType+  U.write c (i + 1) tokenTagEndSize+  U.write c (i + 2) 0 -- name offset+  U.write c (i + 3) 0 -- name length++-- | Adds a new start tag to the lexer.+tokenTagStartSetSelfClosing :: STRef s (TokenBuffer s) -> ST s ()+tokenTagStartSetSelfClosing r = do+  TokenBuffer{..} <- readSTRef r+  i <- U.read tbCntl 2+  U.write tbCntl (i + 4) 1++-- | Appends a character to a tag name if the token is a tag.+tokenTagNameAppend :: Word8 -> STRef s (TokenBuffer s) -> ST s ()+tokenTagNameAppend = stringAppendTail 2++-- | Starts a new attribute+tokenAttrInit :: STRef s (TokenBuffer s) -> ST s ()+tokenAttrInit r = do+  t@TokenBuffer{..} <- readSTRef r+  tailPtr <- U.read tbCntl 2+  m <- U.read tbCntl (tailPtr + 1)+  n <- U.read tbCntl (tailPtr + 5)+  let i = attrSize * n + attrStart + tailPtr+  c <- ensureCntl (i + 3) t r+  U.write c (i + 0) 0 -- attribute name offset+  U.write c (i + 1) 0 -- attribute name length+  U.write c (i + 2) 0 -- attribute value offset+  U.write c (i + 3) 0 -- attribute value length+  U.write c (tailPtr + 1) (m + 4) -- add attr to size of token+  U.write c (tailPtr + 5) (n + 1)++-- | Appends a character to the latest attribute name.+tokenAttrNameAppend :: Word8 -> STRef s (TokenBuffer s) -> ST s ()+tokenAttrNameAppend x r = do+  t@TokenBuffer{..} <- readSTRef r+  tailPtr <- U.read tbCntl 2+  n <- U.read tbCntl (tailPtr + 5)+  let i = attrSize * (n - 1) + attrStart + tailPtr+  stringAppend (i + 0) x t r++-- | Appends a character to the latest attribute value.+tokenAttrValAppend :: Word8 -> STRef s (TokenBuffer s) -> ST s ()+tokenAttrValAppend x r = do+  t@TokenBuffer{..} <- readSTRef r+  tailPtr <- U.read tbCntl 2+  n <- U.read tbCntl (tailPtr + 5)+  let i = attrSize * (n - 1) + attrStart + tailPtr+  stringAppend (i + 2) x t r++-- | Checks for duplicate attribute names.+--   Refer to section 12.2.5.33 for details.+tokenAttrNamePrune :: Int -> STRef s (TokenBuffer s) -> ST s Bool+tokenAttrNamePrune x r = do+  t@TokenBuffer{..} <- readSTRef r+  a <- U.read tbCntl (x + offsetType)+  if a /= tokenTagStartType+  then pure False+  else do+    attrCount <- U.read tbCntl (x + 5)+    u <- forM [1 .. attrCount] $ \j -> do+      let i = (j - 1) * attrSize + attrStart + x+      no0 <- U.read tbCntl (i + 0)+      nc0 <- U.read tbCntl (i + 1)+      match <- forM [1 .. j - 1] $ \k -> do+        let m = (k - 1) * attrSize + attrStart + x+        no1 <- U.read tbCntl (m + 0)+        nc1 <- U.read tbCntl (m + 1)+        s0 <- tokenSlice no0 nc0 r+        s1 <- tokenSlice no1 nc1 r+        pure $ nc0 == nc1 && s0 == s1+      if or match+      then do+        U.write tbCntl (i + 0) 0+        U.write tbCntl (i + 1) 0+        pure True+      else+        pure False+    pure $ or u++-- | Defines the size of the comment token.+tokenCommentSize :: Int+tokenCommentSize = 4++-- | Adds a new comment token to the lexer.+tokenCommentInit :: STRef s (TokenBuffer s) -> ST s ()+tokenCommentInit r = do+  (c, i) <- tokenInit 3 r+  U.write c (i + 0) tokenCommentType+  U.write c (i + 1) tokenCommentSize+  U.write c (i + 2) 0 -- string offset+  U.write c (i + 3) 0 -- string length++-- | Appends a character to the current comment token.+tokenCommentAppend :: Word8 -> STRef s (TokenBuffer s) -> ST s ()+tokenCommentAppend = stringAppendTail 2++-- | Defines the size of the char token.+tokenCharSize :: Int+tokenCharSize = 3++-- | Initializes a text token.+tokenCharInit :: Word8 -> STRef s (TokenBuffer s) -> ST s ()+tokenCharInit x r = do+  t <- readSTRef r+  (c, i) <- tokenInit 2 r+  U.write c (i + 0) tokenCharType+  U.write c (i + 1) tokenCharSize+  U.write c (i + 2) (fromIntegral x)++-- | Defines the size of the eof token.+tokenEOFSize :: Int+tokenEOFSize = 2++-- | Initializes an EOF token.+tokenEOFInit :: STRef s (TokenBuffer s) -> ST s ()+tokenEOFInit r = do+  (c, i) <- tokenInit 2 r+  U.write c (i + 0) tokenEOFType+  U.write c (i + 1) tokenEOFSize++-- | Defines the token offset for the type field.+offsetType :: Int+offsetType = 0++-- | Defines the token offset for the size field.+offsetSize :: Int+offsetSize = 1++-- | Gets the type of a token.+tokenType :: Int -> STRef s (TokenBuffer s) -> ST s Int+tokenType x r = do+  TokenBuffer{..} <- readSTRef r+  U.read tbCntl (x + offsetType)++-- | Gets the size of a token.+tokenSize :: Int -> STRef s (TokenBuffer s) -> ST s Int+tokenSize x r = do+  TokenBuffer{..} <- readSTRef r+  U.read tbCntl (x + offsetSize)++-- | Unpacks a token at the specified index.+tokenPack :: Int -> STRef s (TokenBuffer s) -> ST s Token+tokenPack x r = do+  TokenBuffer{..} <- readSTRef r+  t <- U.read tbCntl x+  n <- U.read tbCntl 0+  s <- bufferString tbData n+  if | t == tokenDoctypeType ->  packDoctype x tbCntl s+     | t == tokenTagStartType -> packTagStart x tbCntl s+     | t == tokenTagEndType ->   packTagEnd x tbCntl s+     | t == tokenCommentType ->  packComment x tbCntl s+     | t == tokenCharType ->     packChar x tbCntl+     | t == tokenEOFType ->      pure TEOF+     | otherwise ->              pure TEOF++-- | Unpacks a doctype token.+packDoctype :: Int -> MVector s Int -> BS -> ST s Token+packDoctype x tbCntl bs = do+  nameOffset <- U.read tbCntl (x + 2)+  nameLen    <- U.read tbCntl (x + 3)+  quirks     <- U.read tbCntl (x + 4)+  pubExists  <- U.read tbCntl (x + 5)+  pubOffset  <- U.read tbCntl (x + 6)+  pubLen     <- U.read tbCntl (x + 7)+  sysExists  <- U.read tbCntl (x + 8)+  sysOffset  <- U.read tbCntl (x + 9)+  sysLen     <- U.read tbCntl (x + 10)+  pure $ TDoctype+    (bsPart nameOffset nameLen bs)+    (quirks == 1)+    (if pubExists == 1 then Just (bsPart pubOffset pubLen bs) else Nothing)+    (if sysExists == 1 then Just (bsPart sysOffset sysLen bs) else Nothing)++-- | Unpacks an start tag token.+packTagStart :: Int -> MVector s Int -> BS -> ST s Token+packTagStart x tbCntl bs = do+  nameOffset <- U.read tbCntl (x + 2)+  nameLen    <- U.read tbCntl (x + 3)+  selfClose  <- U.read tbCntl (x + 4)+  attrCount  <- U.read tbCntl (x + 5)+  attr <- forM [1 .. attrCount] $ \j -> do+    let i = (j - 1) * attrSize + attrStart + x+    no <- U.read tbCntl (i + 0)+    nc <- U.read tbCntl (i + 1)+    ao <- U.read tbCntl (i + 2)+    ac <- U.read tbCntl (i + 3)+    pure $+      if no > 0+      then Just $ TAttr+        (bsPart no nc bs)+        (bsPart ao ac bs)+        HTMLAttrNamespaceNone+      else Nothing+  pure $ TStart+    (bsPart nameOffset nameLen bs)+    (selfClose == 1)+    (catMaybes attr)++-- | Unpacks an end tag token.+packTagEnd :: Int -> MVector s Int -> BS -> ST s Token+packTagEnd x tbCntl bs = do+  nameOffset <- U.read tbCntl (x + 2)+  nameLen    <- U.read tbCntl (x + 3)+  pure $ TEnd $ bsPart nameOffset nameLen bs++-- | Unpacks a comment token.+packComment :: Int -> MVector s Int -> BS -> ST s Token+packComment x tbCntl bs = do+  o <- U.read tbCntl (x + 2)+  n <- U.read tbCntl (x + 3)+  pure $ TComment $ bsPart o n bs++-- | Unpacks a character token.+packChar :: Int -> MVector s Int -> ST s Token+packChar x tbCntl = do+  c <- U.read tbCntl (x + 2)+  pure $ TChar $ fromIntegral c++-- | Appends a character to a string at an offset in the current token.+stringAppendTail :: Int -> Word8 -> STRef s (TokenBuffer s) -> ST s ()+stringAppendTail offset word r = do+  t@TokenBuffer{..} <- readSTRef r+  tailPtr <- U.read tbCntl 2+  stringAppend (tailPtr + offset) word t r+{-# INLINE stringAppendTail #-}++-- | Appends a character to a string at an offset.+stringAppend :: Int -> Word8 -> TokenBuffer s -> STRef s (TokenBuffer s) -> ST s ()+stringAppend x word t@TokenBuffer{..} r = do+  let y = x + 1+  i <- U.read tbCntl 0+  o <- U.read tbCntl x+  n <- U.read tbCntl y+  d <- ensureData i t r+  U.write d i word+  U.write tbCntl 0 (i + 1)+  U.write tbCntl y (n + 1)+  when (o == 0) $+    U.write tbCntl x i+{-# INLINE stringAppend #-}++-- | Ensures that the control buffer has enough space and grows it if needed.+ensureCntl :: Int -> TokenBuffer s -> STRef s (TokenBuffer s) -> ST s (MVector s Int)+ensureCntl x TokenBuffer{..} r+  | x < U.length tbCntl =+      pure tbCntl+  | otherwise = do+      v <- U.grow tbCntl $ U.length tbCntl+      writeSTRef r $ TokenBuffer v tbData+      pure v+{-# INLINE ensureCntl #-}++-- | Ensures that the data buffer has enough space and grows it if needed.+ensureData :: Int -> TokenBuffer s -> STRef s (TokenBuffer s) -> ST s (MVector s Word8)+ensureData x TokenBuffer{..} r+  | x < U.length tbData =+      pure tbData+  | otherwise = do+      v <- U.grow tbData $ U.length tbData+      writeSTRef r $ TokenBuffer tbCntl v+      pure v+{-# INLINE ensureData #-}
+ src/Zenacy/HTML/Internal/Trie.hs view
@@ -0,0 +1,70 @@+-- | A basic trie over byte strings.+module Zenacy.HTML.Internal.Trie+  ( Trie+  , empty+  , fromList+  , insert+  , insertWords+  , match+  ) where++import Zenacy.HTML.Internal.BS+import Data.Map+  ( Map+  )+import qualified Data.Map as Map+  ( empty+  , fromList+  , insert+  , lookup+  )+import Data.Word+  ( Word8+  )++-- | Defines the tree.+data Trie a = Trie (Maybe a) (Map Word8 (Trie a)) deriving (Show)++-- | Creates an empty trie.+empty :: Trie a+empty = Trie Nothing Map.empty++-- | Creates a trie from a list of tuples containing key and value.+fromList :: [(BS,a)] -> Trie a+fromList = foldl (\t (x,y) -> insert x y t) empty++-- | Finds the longest prefix with a value in the trie and returns+-- the prefix, the value, and the remaining string.+match :: Trie a -> BS -> Maybe (BS, a, BS)+match t s =+  case go Nothing 0 t s of+    Nothing -> Nothing+    Just (n, v) -> Just (bsTake n s, v, bsDrop n s)+  where+    go a n (Trie v m) s =+      case bsUncons s of+        Nothing -> a+        Just (w, t) ->+          case Map.lookup w m of+            Nothing -> a+            Just b @ (Trie (Just v2) _) ->+              go (Just (n + 1, v2)) (n + 1) b t+            Just b ->+              go a (n + 1) b t++-- | Inserts a value into a trie.+insert :: BS -> a -> Trie a -> Trie a+insert x = insertWords $ bsUnpack x++-- | Inserts a value into a trie.+insertWords :: [Word8] -> a -> Trie a -> Trie a+insertWords x y = go x+  where+    go [] (Trie v m) =+      Trie (Just y) m+    go (w:ws) (Trie v m) =+      case Map.lookup w m of+        Nothing ->+          Trie v $ Map.insert w (go ws empty) m+        Just b ->+          Trie v $ Map.insert w (go ws b) m
+ src/Zenacy/HTML/Internal/Types.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines supporting types.+module Zenacy.HTML.Internal.Types+  ( HTMLNamespace(..)+  , HTMLAttrNamespace(..)+  ) where++import Data.Default+  ( Default(..)+  )++-- | An HTML namespace type.+data HTMLNamespace+  = HTMLNamespaceHTML+  | HTMLNamespaceSVG+  | HTMLNamespaceMathML+    deriving (Eq, Ord, Show)++-- | An HTML attribute namespace type.+data HTMLAttrNamespace+  = HTMLAttrNamespaceNone+  | HTMLAttrNamespaceXLink+  | HTMLAttrNamespaceXML+  | HTMLAttrNamespaceXMLNS+    deriving (Eq, Ord, Show)++-- | Defines a default namespace.+instance Default HTMLNamespace where+  def = HTMLNamespaceHTML++-- | Defines a default attribute namespace.+instance Default HTMLAttrNamespace where+  def = HTMLAttrNamespaceNone
+ src/Zenacy/HTML/Internal/Zip.hs view
@@ -0,0 +1,519 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Defines types for zipping and iterating over HTML trees.+module Zenacy.HTML.Internal.Zip+  ( HTMLZipper+  , HTMLZipAction+  , HTMLIter+  , HTMLZipPath(..)+  , htmlZip+  , htmlZipM+  , htmlUnzip+  , htmlUnzipM+  , htmlZipNode+  , htmlZipNodeM+  , htmlZipRoot+  , htmlZipRootM+  , htmlZipUp+  , htmlZipParent+  , htmlZipFirst+  , htmlZipLast+  , htmlZipFind+  , htmlZipNext+  , htmlZipPrev+  , htmlZipGet+  , htmlZipTest+  , htmlZipTestNode+  , htmlZipTestName+  , htmlZipTestFirst+  , htmlZipTestLast+  , htmlZipModify+  , htmlZipModifyM+  , htmlZipDelete+  , htmlZipCollapse+  , htmlZipInsertBefore+  , htmlZipInsertAfter+  , htmlZipContentBefore+  , htmlZipContentAfter+  , htmlZipContentLeft+  , htmlZipContentRight+  , htmlZipDropBefore+  , htmlZipDropAfter+  , htmlZipDropLeft+  , htmlZipDropRight+  , htmlZipPruneBefore+  , htmlZipPruneAfter+  , htmlZipPruneLeft+  , htmlZipPruneRight+  , htmlZipRepeat+  , htmlZipStepNext+  , htmlZipStepBack+  , htmlZipSearch+  , htmlZipIndex+  , htmlIter+  , htmlIterZipper+  , htmlIterSearch+  , htmlIterModify+  , htmlIterNext+  , htmlIterBack+  , htmlZipPath+  , htmlZipPathEmpty+  , htmlZipPathFind+  ) where++import Zenacy.HTML.Internal.Core+import Zenacy.HTML.Internal.HTML+import Zenacy.HTML.Internal.Oper+import Control.Monad+  ( (>=>)+  )+import Data.Bool+  ( bool+  )+import Data.Default+  ( Default(..)+  )+import Data.Maybe+  ( fromMaybe+  , isNothing+  )+import Data.Monoid+  ( (<>)+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( unpack+  )++-- | The zipper crumb definition.+data HTMLCrumb = HTMLCrumb HTMLNode [HTMLNode] [HTMLNode]++-- | The zipper type.+data HTMLZipper = HTMLZipper HTMLNode [HTMLCrumb]++-- | Defines an action on a zipper.+type HTMLZipAction = HTMLZipper -> Maybe HTMLZipper++-- | Defines a zip direction.+data Direction = Down | Across | Up++-- | The zipper iterator type.+data HTMLIter = HTMLIter Direction HTMLZipper++-- | Defines the type for a path.+newtype HTMLZipPath = HTMLZipPath [Int] deriving (Show, Eq, Ord)++-- | Defaults for zip path.+instance Default HTMLZipPath where+  def = htmlZipPathEmpty++-- | Creates a zipper for a HTML node.+htmlZip :: HTMLNode -> HTMLZipper+htmlZip x = HTMLZipper x []++-- | Creates a zipper for a HTML node in a Monad.+htmlZipM :: Monad m => HTMLNode -> m HTMLZipper+htmlZipM = pure . htmlZip++-- | Extracts the HTML node from a zipper.+htmlUnzip :: HTMLZipper -> HTMLNode+htmlUnzip = htmlZipNode . htmlZipRoot++-- | Extracts the HTML node from a zipper in a Monad.+htmlUnzipM :: Monad m => HTMLZipper -> m HTMLNode+htmlUnzipM = pure . htmlUnzip++-- | Gets the current HTML node.+htmlZipNode :: HTMLZipper -> HTMLNode+htmlZipNode (HTMLZipper x _) = x++-- | Gets the current HTML node in a Monad.+htmlZipNodeM :: Monad m => HTMLZipper -> m HTMLNode+htmlZipNodeM = pure . htmlZipNode++-- | Moves the zipper to the root HTML node.+htmlZipRoot :: HTMLZipper -> HTMLZipper+htmlZipRoot x = maybe x htmlZipRoot $ htmlZipParent x++-- | Moves the zipper to the root HTML node in a Monad.+htmlZipRootM :: Monad m => HTMLZipper -> m HTMLZipper+htmlZipRootM = pure . htmlZipRoot++-- | Moves the zipper to the parent node.+htmlZipUp :: HTMLZipper -> Maybe HTMLZipper+htmlZipUp = htmlZipParent++-- | Moves the zipper to the parent node.+htmlZipParent :: HTMLZipper -> Maybe HTMLZipper+htmlZipParent = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n ls rs):cs) ->+    let c = reverse ls <> [x] <> rs+    in case n of+      HTMLDocument n [] ->+        Just $ HTMLZipper (HTMLDocument n c) cs+      HTMLDoctype n p s ->+        Nothing+      HTMLFragment n [] ->+        Just $ HTMLZipper (HTMLFragment n c) cs+      HTMLElement n s a [] ->+        Just $ HTMLZipper (HTMLElement n s a c) cs+      HTMLTemplate s a c ->+        Nothing+      HTMLText t ->+        Nothing+      HTMLComment c ->+        Nothing++-- | Moves the zipper to the first child node.+htmlZipFirst :: HTMLZipper -> Maybe HTMLZipper+htmlZipFirst (HTMLZipper y z) = case y of+  HTMLDocument n c ->+    f c $ HTMLDocument n []+  HTMLFragment n c ->+    f c $ HTMLFragment n []+  HTMLElement n s a c ->+    f c $ HTMLElement n s a []+  _ -> Nothing+  where+    f [] n = Nothing+    f (h:rs) n = Just $ HTMLZipper h ((HTMLCrumb n [] rs):z)++-- | Moves the zipper to the last child node.+htmlZipLast :: HTMLZipper -> Maybe HTMLZipper+htmlZipLast (HTMLZipper y z) = case y of+  HTMLDocument n c ->+    f c $ HTMLDocument n []+  HTMLFragment n c ->+    f c $ HTMLFragment n []+  HTMLElement n s a c ->+    f c $ HTMLElement n s a []+  _ -> Nothing+  where+    f [] n = Nothing+    f xs n = let (h:ls) = reverse xs in Just $+      HTMLZipper h ((HTMLCrumb n ls []):z)++-- | Moves the zipper to a named child element.+htmlZipFind :: (HTMLNode -> Bool) -> HTMLZipper -> Maybe HTMLZipper+htmlZipFind p (HTMLZipper y z) = case y of+  HTMLDocument n c ->+    f c $ HTMLDocument n []+  HTMLFragment n c ->+    f c $ HTMLFragment n []+  HTMLElement n s a c ->+    f c $ HTMLElement n s a []+  _ -> Nothing+  where+    f c n = case break p c of+      (ls, []) -> Nothing+      (ls, h:rs) -> Just $+        HTMLZipper h ((HTMLCrumb n (reverse ls) rs):z)++-- | Moves to the next sibling.+htmlZipNext :: HTMLZipper -> Maybe HTMLZipper+htmlZipNext = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n ls []):cs) -> Nothing+  HTMLZipper x ((HTMLCrumb n ls (h:rs)):cs) ->+    Just $ HTMLZipper h ((HTMLCrumb n (x:ls) rs):cs)++-- | Moves to the previous sibling.+htmlZipPrev :: HTMLZipper -> Maybe HTMLZipper+htmlZipPrev = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n [] rs):cs) -> Nothing+  HTMLZipper x ((HTMLCrumb n (h:ls) rs):cs) ->+    Just $ HTMLZipper h ((HTMLCrumb n ls (x:rs)):cs)++-- | Gets the child specified by an index.+htmlZipGet :: Int -> HTMLZipper -> Maybe HTMLZipper+htmlZipGet n z+  | n < 0 = Nothing+  | n == 0 = htmlZipFirst z+  | otherwise = htmlZipFirst z >>= f n+  where+    f 0 = Just+    f n = htmlZipNext >=> f (n - 1)++-- | Continues a zipper if a test is passed.+htmlZipTest :: (HTMLZipper -> Bool) -> HTMLZipper -> Maybe HTMLZipper+htmlZipTest f z = bool Nothing (Just z) $ f z++-- | Continues a zipper if a node test is passed.+htmlZipTestNode :: (HTMLNode -> Bool) -> HTMLZipper -> Maybe HTMLZipper+htmlZipTestNode f = htmlZipTest $ f . htmlZipNode++-- | Tests the current node for an element name.+htmlZipTestName :: Text -> HTMLZipper -> Maybe HTMLZipper+htmlZipTestName x = htmlZipTest (htmlElemHasName x . htmlZipNode)++-- | Test whether the zipper is at the first child node.+htmlZipTestFirst :: HTMLZipper -> Maybe HTMLZipper+htmlZipTestFirst = htmlZipTest (isNothing . htmlZipPrev)++-- | Test whether the zipper is at the last child node.+htmlZipTestLast :: HTMLZipper -> Maybe HTMLZipper+htmlZipTestLast = htmlZipTest (isNothing . htmlZipNext)++-- | Modifies the currently focused node.+htmlZipModify :: (HTMLNode -> HTMLNode) -> HTMLZipper -> HTMLZipper+htmlZipModify f (HTMLZipper y z) = HTMLZipper (f y) z++-- | Modifies the currently focused node in a Monad.+htmlZipModifyM :: Monad m => (HTMLNode -> HTMLNode) -> HTMLZipper -> m HTMLZipper+htmlZipModifyM f = pure . htmlZipModify f++-- | Deletes the current node.+htmlZipDelete :: HTMLZipper -> Maybe HTMLZipper+htmlZipDelete = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n l r):cs) ->+    let c = reverse l <> r+    in case n of+      HTMLDocument n [] ->+        Just $ HTMLZipper (HTMLDocument n c) cs+      HTMLFragment n [] ->+        Just $ HTMLZipper (HTMLFragment n c) cs+      HTMLElement n s a [] ->+        Just $ HTMLZipper (HTMLElement n s a c) cs+      _ -> Nothing++-- | Collapses the current node.+htmlZipCollapse :: HTMLZipper -> Maybe HTMLZipper+htmlZipCollapse = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n l r):cs) ->+    let c = reverse l <> htmlNodeContent x <> r+    in case n of+      HTMLDocument n [] ->+        Just $ HTMLZipper (HTMLDocument n c) cs+      HTMLFragment n [] ->+        Just $ HTMLZipper (HTMLFragment n c) cs+      HTMLElement n s a [] ->+        Just $ HTMLZipper (HTMLElement n s a c) cs+      _ -> Nothing++-- | Inserts a node before the current node.+htmlZipInsertBefore :: HTMLNode -> HTMLZipper -> Maybe HTMLZipper+htmlZipInsertBefore y = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n l r):cs) ->+    Just $ HTMLZipper x ((HTMLCrumb n (y:l) r):cs)++-- | Inserts a node after the current node.+htmlZipInsertAfter :: HTMLNode -> HTMLZipper -> Maybe HTMLZipper+htmlZipInsertAfter y = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n l r):cs) ->+    Just $ HTMLZipper x ((HTMLCrumb n l (y:r)):cs)++-- | Gets the siblings to the left of the current node.+htmlZipContentBefore :: HTMLZipper -> [HTMLNode]+htmlZipContentBefore = \case+  HTMLZipper x [] -> []+  HTMLZipper x ((HTMLCrumb n l r):cs) -> reverse l++-- | Gets the siblings to the right of the current node.+htmlZipContentAfter :: HTMLZipper -> [HTMLNode]+htmlZipContentAfter = \case+  HTMLZipper x [] -> []+  HTMLZipper x ((HTMLCrumb n l r):cs) -> r++-- | Synonym for htmlZipContentBefore.+htmlZipContentLeft :: HTMLZipper -> [HTMLNode]+htmlZipContentLeft = htmlZipContentBefore++-- | Synonym for htmlZipContentAfter.+htmlZipContentRight :: HTMLZipper -> [HTMLNode]+htmlZipContentRight = htmlZipContentAfter++-- | Drops the siblings to the left of the current node.+htmlZipDropBefore :: HTMLZipper -> Maybe HTMLZipper+htmlZipDropBefore = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n _ r):cs) ->+    Just $ HTMLZipper x ((HTMLCrumb n [] r):cs)++-- | Drops the siblings to the right of the current node.+htmlZipDropAfter :: HTMLZipper -> Maybe HTMLZipper+htmlZipDropAfter = \case+  HTMLZipper x [] -> Nothing+  HTMLZipper x ((HTMLCrumb n l _):cs) ->+    Just $ HTMLZipper x ((HTMLCrumb n l []):cs)++-- | Synonym for htmlZipDropBefore.+htmlZipDropLeft :: HTMLZipper -> Maybe HTMLZipper+htmlZipDropLeft = htmlZipDropBefore++-- | Synonym for htmlZipDropAfter.+htmlZipDropRight :: HTMLZipper -> Maybe HTMLZipper+htmlZipDropRight = htmlZipDropAfter++-- | Drops all of the branches to the left of the current node+--   while moving up to and ending at the root.+htmlZipPruneBefore :: HTMLZipper -> Maybe HTMLZipper+htmlZipPruneBefore = htmlZipRepeat safeDrop htmlZipParent+  where+    safeDrop z = Just $ fromMaybe z $ htmlZipDropBefore z++-- | Drops all of the branches to the right of the current node+--   while moving up to and ending at the root.+htmlZipPruneAfter :: HTMLZipper -> Maybe HTMLZipper+htmlZipPruneAfter = htmlZipRepeat safeDrop htmlZipParent+  where+    safeDrop z = Just $ fromMaybe z $ htmlZipDropAfter z++-- | Synonym for htmlZipPruneBefore.+htmlZipPruneLeft :: HTMLZipper -> Maybe HTMLZipper+htmlZipPruneLeft = htmlZipPruneBefore++-- | Synonym for htmlZipPruneAfter.+htmlZipPruneRight :: HTMLZipper -> Maybe HTMLZipper+htmlZipPruneRight = htmlZipPruneAfter++-- | Repeats a zipper action until another zipper returns Nothing.+htmlZipRepeat :: HTMLZipAction -> HTMLZipAction -> HTMLZipAction+htmlZipRepeat f g z =+  case f z of+    Nothing -> Nothing+    Just z1 -> case g z1 of+      Nothing -> Just z1+      Just z2 -> htmlZipRepeat f g z2++-- | Step a zipper forward one node.+htmlZipStepNext :: HTMLZipper -> Maybe HTMLZipper+htmlZipStepNext = htmlZipStep htmlZipFirst htmlZipNext++-- | Step a zipper back one node.+htmlZipStepBack :: HTMLZipper -> Maybe HTMLZipper+htmlZipStepBack = htmlZipStep htmlZipLast htmlZipPrev++-- | Step a zipper.+htmlZipStep :: HTMLZipAction -> HTMLZipAction -> HTMLZipAction+htmlZipStep first next z =+  case first z of+    Just x -> Just x+    Nothing -> f z+  where+    f x = case next x of+      Just a -> Just a+      Nothing -> case htmlZipParent x of+        Just b -> f b+        Nothing -> Nothing++-- | Searches a zipper until a predicate is true.+htmlZipSearch+  :: (HTMLZipper -> Maybe HTMLZipper)+  -> (HTMLZipper -> Bool)+  -> HTMLZipper+  -> Maybe HTMLZipper+htmlZipSearch step test x+  | test x = Just x+  | otherwise = maybe Nothing (htmlZipSearch step test) $ step x++-- | Gets the index for a node.+htmlZipIndex :: HTMLZipper -> Maybe Int+htmlZipIndex = \case+  HTMLZipper _ [] -> Nothing+  HTMLZipper _ ((HTMLCrumb _ ls _):_) -> Just $ length ls++-- | Dumps a zipper to a string.+htmlZipDump :: HTMLZipper -> String+htmlZipDump (HTMLZipper n cs) =+  name n <> "\n" <> go cs+  where+    go :: [HTMLCrumb] -> String+    go [] = ""+    go ((HTMLCrumb n ls rs):cs) =+      name n <> "\n"+      <> " ls: " <> names ls <> "\n"+      <> " rs: " <> names rs <> "\n"+      <> go cs+    name = T.unpack . htmlElemName+    names = show . map name++-- | Returns an iterator for a zipper.+htmlIter :: HTMLZipper -> HTMLIter+htmlIter = HTMLIter Down++-- | Gets the iterator for a zipper.+htmlIterZipper :: HTMLIter -> HTMLZipper+htmlIterZipper (HTMLIter _ z) = z++-- | Modifies the zipper for an interator.+htmlIterModify :: (HTMLZipper -> HTMLZipper) -> HTMLIter -> HTMLIter+htmlIterModify f (HTMLIter d z) = (HTMLIter d $ f z)++-- | Advances an iterator to the next element.+htmlIterNext :: HTMLIter -> Maybe HTMLIter+htmlIterNext = iterStep htmlZipFirst htmlZipNext++-- | Advances an iterator to the previous element.+htmlIterBack :: HTMLIter -> Maybe HTMLIter+htmlIterBack = iterStep htmlZipLast htmlZipPrev++-- | Steps an iterator.+iterStep+  :: (HTMLZipper -> Maybe HTMLZipper)+  -> (HTMLZipper -> Maybe HTMLZipper)+  -> HTMLIter+  -> Maybe HTMLIter+iterStep first next = go+  where+    go (HTMLIter d z) =+      case d of+        Down ->+          case first z of+            Just x -> Just $ HTMLIter Down x+            Nothing -> go $ HTMLIter Across z+        Across ->+          case next z of+            Just x -> Just $ HTMLIter Down x+            Nothing -> go $ HTMLIter Up z+        Up ->+          case htmlZipParent z of+            Just x -> Just $ HTMLIter Across x+            Nothing -> Nothing++-- | Searches an iterator until a predicate is true.+htmlIterSearch+  :: (HTMLIter -> Maybe HTMLIter)+  -> (HTMLZipper -> Bool)+  -> HTMLIter+  -> Maybe HTMLIter+htmlIterSearch step test x@(HTMLIter _ z)+  | test z = Just x+  | otherwise = maybe Nothing (htmlIterSearch step test) $ step x++-- | Defines an empty path.+htmlZipPathEmpty :: HTMLZipPath+htmlZipPathEmpty = HTMLZipPath []++-- | Gets the path for a node.+htmlZipPath :: HTMLZipper -> HTMLZipPath+htmlZipPath = maybe (HTMLZipPath []) id . go htmlZipPathEmpty+  where+    go :: HTMLZipPath -> HTMLZipper -> Maybe HTMLZipPath+    go (HTMLZipPath p) z =+      case htmlZipIndex z of+        Nothing ->+          Just $ HTMLZipPath p+        Just x ->+          case htmlZipParent z of+            Nothing -> Nothing+            Just y -> go (HTMLZipPath $ x : p) y++-- | Finds the zipper for a path starting from the current node.+htmlZipPathFind :: HTMLZipPath -> HTMLZipper -> Maybe HTMLZipper+htmlZipPathFind (HTMLZipPath p) = f p+  where+    f [] = pure+    f (x:xs) = htmlZipGet x >=> f xs
+ test/Samples.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}++module Samples+  ( testSamples+  ) where++import Zenacy.HTML+import Data.Default+  ( Default(..)+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )+import Data.Maybe+  ( fromJust+  , fromMaybe+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( pack+  )+import Text.RawString.QQ++testSamples :: Test+testSamples = testGroup "Samples"+  [ testHello+  , testRewrite+  , testExtract+  , testQuery+  , testQuery2+  ]++testHello :: Test+testHello = testCase "sample hello" $ do+  flip (assertEqual "Sample 1")+    (htmlRender $ htmlParseEasy "<div>HelloWorld</div>")+    "<html><head></head><body><div>HelloWorld</div></body></html>"++  flip (assertEqual "Sample 2")+    (htmlParseEasy "<div>HelloWorld</div>")+    (HTMLDocument ""+      [ HTMLElement "html" HTMLNamespaceHTML []+          [ HTMLElement "head" HTMLNamespaceHTML [] []+          , HTMLElement "body" HTMLNamespaceHTML []+            [ HTMLElement "div" HTMLNamespaceHTML []+              [ HTMLText "HelloWorld" ] ] ] ])++  flip (assertEqual "Sample 3")+    (htmlParseEasy "<div>HelloWorld</div>")+    HTMLDocument+      { htmlDocumentName = ""+      , htmlDocumentChildren =+        [ HTMLElement+          { htmlElementName = "html"+          , htmlElementNamespace = HTMLNamespaceHTML+          , htmlElementAttributes = []+          , htmlElementChildren =+            [ HTMLElement+              { htmlElementName = "head"+              , htmlElementNamespace = HTMLNamespaceHTML+              , htmlElementAttributes = []+              , htmlElementChildren = []+              }+            , HTMLElement+              { htmlElementName = "body"+              , htmlElementNamespace = HTMLNamespaceHTML+              , htmlElementAttributes = []+              , htmlElementChildren =+                [ HTMLElement+                  { htmlElementName = "div"+                  , htmlElementNamespace = HTMLNamespaceHTML+                  , htmlElementAttributes = []+                  , htmlElementChildren =+                    [ HTMLText+                      { htmlTextData = "HelloWorld" }+                    ] } ] } ] } ] }++testRewrite :: Test+testRewrite = testCase "sample rewrite" $ do+  flip (assertEqual "Sample 1")+    (rewrite "<span>Hello</span><span>World</span>")+    "<html><head></head><body><div>Hello</div><div>World</div></body></html>"++rewrite :: Text -> Text+rewrite = htmlRender . htmlMapElem f . fromJust . htmlDocHtml . htmlParseEasy+  where+    f x+      | htmlElemHasName "span" x = htmlElemRename "div" x+      | otherwise = x++testExtract :: Test+testExtract = testCase "sample extract" $ do+  flip (assertEqual "Sample 1")+    (extract "<a href=\"https://example1.com\"></a><a href=\"https://example2.com\"></a>")+    [ "https://example1.com"+    , "https://example2.com"+    ]++extract :: Text -> [Text]+extract = go . htmlParseEasy+  where+    go = \case+      HTMLDocument n c ->+        concatMap go c+      e @ (HTMLElement "a" s a c) ->+        case htmlElemAttrFind (htmlAttrHasName "href") e of+          Just (HTMLAttr n v s) ->+            v : concatMap go c+          Nothing ->+            concatMap go c+      HTMLElement n s a c ->+        concatMap go c+      _otherwise ->+        []++testQuery :: Test+testQuery = testCase "sample query" $ do+  assertEqual "Sample 1" (Just "AAA") $ query (b h)+  where+    h = [r|+      <p>+        <span id="x" class="y z"></span>+        <br>+        <a href="bbb">AAA</a>+        <img>+      </p>+      |]+    b = fromJust+      . htmlSpaceRemove+      . fromJust+      . htmlDocBody+      . htmlParseEasy ++query :: HTMLNode -> Maybe Text+query = htmlQueryExec $ do+  htmlQueryName "body"+  htmlQueryFirst+  htmlQueryName "p"+  htmlQueryFirst+  htmlQueryId "x"+  htmlQueryNext+  htmlQueryNext+  htmlQueryName "a"+  a <- htmlQueryNode+  htmlQuerySucc $+    fromMaybe "" $ htmlElemText a++testQuery2 = testCase "sample query2" $ do+  assertEqual "Sample 1" (htmlRender h') $+    htmlRender $ htmlMapElem query2 h+  where+    h = b [r|+      <section><div><img src="aaa"></div></section>+      <section><div><img src="bbb"></div></section>+      <section><div><img src="ccc"></div></section>+      |]+    h' = b [r|+      <section><a href="aaa">aaa</a></section>+      <section><a href="bbb">bbb</a></section>+      <section><a href="ccc">ccc</a></section>+      |]+    b = fromJust+      . htmlSpaceRemove+      . fromJust+      . htmlDocBody+      . htmlParseEasy ++query2 :: HTMLNode -> HTMLNode+query2 = htmlQueryTry $ do+  htmlQueryName "div"+  htmlQueryOnly "img"+  a <- htmlQueryNode+  let Just b = htmlElemGetAttr "src" a+  htmlQuerySucc $+    htmlElem "a" [ htmlAttr "href" b ]+      [ htmlText b ]
+ test/TestSuite.hs view
@@ -0,0 +1,33 @@+module Main where++import Samples+import Zenacy.HTML.Internal.Buffer.Tests+import Zenacy.HTML.Internal.Entity.Tests+import Zenacy.HTML.Internal.HTML.Tests+import Zenacy.HTML.Internal.Image.Tests+import Zenacy.HTML.Internal.Lexer.Tests+import Zenacy.HTML.Internal.Oper.Tests+import Zenacy.HTML.Internal.Parser.Tests+import Zenacy.HTML.Internal.Query.Tests+import Zenacy.HTML.Internal.Token.Tests+import Zenacy.HTML.Internal.Trie.Tests+import Zenacy.HTML.Internal.Zip.Tests+import Test.Framework+  ( defaultMain+  )++main :: IO ()+main = defaultMain+  [ testBuffer+  , testEntity+  , testToken+  , testLexer+  , testParser+  , testHtml+  , testImage+  , testOper+  , testTrie+  , testZip+  , testQuery+  , testSamples+  ]
+ test/Zenacy/HTML/Internal/Buffer/Tests.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE OverloadedStrings #-}++module Zenacy.HTML.Internal.Buffer.Tests+  ( testBuffer+  ) where++import Zenacy.HTML.Internal.Buffer+import Control.Monad+import Control.Monad.ST+import qualified Data.ByteString as S+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )++testBuffer :: Test+testBuffer = testGroup "Zenacy.HTML.Internal.Buffer"+  [ testCapacity+  , testSize+  , testReset+  , testPack+  , testApply+  , testTake+  ]++testCapacity :: Test+testCapacity = testCase "buffer capacity" $ do+  assertEqual "TEST 1" (1,100) $+    runST $ do+      b <- bufferNew+      bufferCapacity b+  assertEqual "TEST 2" (1,25600) $+    runST $ do+      b <- bufferNew+      forM_ [1..20000] $ const $ bufferAppend 0x40 b+      bufferCapacity b++testSize :: Test+testSize = testCase "buffer size" $ do+  assertEqual "TEST 1" 0 $+    runST $ do+      b <- bufferNew+      bufferSize b+  assertEqual "TEST 2" 200 $+    runST $ do+      b <- bufferNew+      forM_ [1..200] $ const $ bufferAppend 0x40 b+      bufferSize b+  assertEqual "TEST 3" 1000 $+    runST $ do+      b <- bufferNew+      forM_ [1..1000] $ const $ bufferAppend 0x40 b+      bufferSize b++testReset :: Test+testReset = testCase "buffer reset" $ do+  assertEqual "TEST 1" (0,200,0) $+    runST $ do+      b <- bufferNew+      n0 <- bufferSize b+      forM_ [1..200] $ const $ bufferAppend 0x40 b+      n1 <- bufferSize b+      bufferReset b+      n2 <- bufferSize b+      pure (n0,n1,n2)++testPack :: Test+testPack = testCase "buffer pack" $ do+  assertEqual "TEST 1" x   $ f x+  assertEqual "TEST 2" "0" $ f "0"+  assertEqual "TEST 2" ""  $ f ""+  where+    x = "the quick brown fox jumps over the lazy dog"+    f a =+      runST $ do+        b <- bufferNew+        forM_ (S.unpack a) $ \c -> bufferAppend c b+        bufferPack b++testApply :: Test+testApply = testCase "buffer apply" $ do+  assertEqual "TEST 1" x   $ f x+  assertEqual "TEST 2" "0" $ f "0"+  assertEqual "TEST 2" ""  $ f ""+  where+    x = "the quick brown fox jumps over the lazy dog"+    f a = runST $ do+      b0 <- bufferNew+      b1 <- bufferNew+      forM_ (S.unpack a) $ \c -> bufferAppend c b0+      bufferApply (\w -> bufferAppend w b1) b0+      bufferPack b1++testTake :: Test+testTake = testCase "buffer take" $ do+  assertEqual "TEST 1"+    []+    (f x 0)+  assertEqual "TEST 2"+    [0]+    (f x 1)+  assertEqual "TEST 3"+    [0,1,2,3,4]+    (f x 5)+  assertEqual "TEST 4"+    [0,1,2,3,4,5,6,7,8,9]+    (f x 100)+  where+    x = "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09"+    f a n = runST $ do+      b <- bufferNew+      forM_ (S.unpack a) $ \c -> bufferAppend c b+      bufferTake n b
+ test/Zenacy/HTML/Internal/Entity/Tests.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}++module Zenacy.HTML.Internal.Entity.Tests+  ( testEntity+  ) where++import Zenacy.HTML.Internal.Entity+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )++testEntity :: Test+testEntity = testGroup "Zenacy.HTML.Internal.Entity"+  [ testGeneral+  , testLongest+  ]++testGeneral :: Test+testGeneral = testCase "entity general" $ do+  assertEqual "TEST 1" Nothing                     $ entityMatch "aamp;b"+  assertEqual "TEST 2" (Just ("amp;", "&", "bbb")) $ entityMatch "amp;bbb"+  assertEqual "TEST 3" (Just ("amp;", "&", ""))    $ entityMatch "amp;"+  assertEqual "TEST 4" (Just ("amp", "&", "b"))    $ entityMatch "ampb"++testLongest :: Test+testLongest = testCase "entity longest" $ do+  assertEqual "TEST 1"+    -- TODO: is this the correct result?+    (Just ("DoubleLongLeftRightArrow;", "\226\159\186", "x"))+    (entityMatch "DoubleLongLeftRightArrow;x")
+ test/Zenacy/HTML/Internal/HTML/Tests.hs view
@@ -0,0 +1,577 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}++module Zenacy.HTML.Internal.HTML.Tests+  ( testHtml+  ) where++import Zenacy.HTML+import Data.Default+  ( Default(..)+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( pack+  )+import Text.RawString.QQ++testHtml :: Test+testHtml = testGroup "Zenacy.HTML.Internal.HTML"+  [ testBasic+  , testAA1+  , testAA2+  , testOmit+  , testTableSparse+  , testMath+  , testScript+  , testInput+  , testList+  , testScriptBeforeHead+  , testComment+  , testEntity+  , testAfterHead+  ]++genNormal x =+  case htmlParse def x of+    Left e -> T.pack $ show e+    Right r -> htmlRender $ htmlResultDocument r++genPretty x =+  case htmlParse def x of+    Left e -> T.pack $ show e+    Right r -> htmlRenderPretty $ htmlResultDocument r++genEntity x y =+  case htmlParse (def { htmlOptionIgnoreEntities = y }) x of+    Left e -> T.pack $ show e+    Right r -> htmlRender $ htmlResultDocument r++testBasic :: Test+testBasic = testCase "html basic" $ do+  assertEqual "TEST 1" htmlPretty $ genPretty htmlIn+  assertEqual "TEST 2" htmlNormal $ genNormal htmlIn++htmlIn =+  "<!DOCTYPE html>\+  \<head><title>TITLE</title></head>\+  \<body><p>HEY</p><br/>\+  \<template><br/><div></div><p></p><p>YOU</p><img/></template>\+  \<!-- test markup -->\+  \<table class=\"class\" style=\"red\">\+  \<tr><td></td><td id=\"2\">MEGADETH</td></tr>\+  \</table>\+  \</body>"++htmlPretty =+  "<!DOCTYPE html>\n\+  \<html>\n\+  \ <head>\n\+  \  <title>TITLE</title>\n\+  \ </head>\n\+  \ <body>\n\+  \  <p>HEY</p>\n\+  \  <br>\n\+  \  <template>\n\+  \   <br>\n\+  \   <div></div>\n\+  \   <p></p>\n\+  \   <p>YOU</p>\n\+  \   <img>\n\+  \  </template>\n\+  \  <!-- test markup -->\n\+  \  <table class=\"class\" style=\"red\">\n\+  \   <tbody>\n\+  \    <tr>\n\+  \     <td></td>\n\+  \     <td id=\"2\">MEGADETH</td>\n\+  \    </tr>\n\+  \   </tbody>\n\+  \  </table>\n\+  \ </body>\n\+  \</html>"++htmlNormal =+  "<!DOCTYPE html>\+  \<html>\+  \<head>\+  \<title>TITLE</title>\+  \</head>\+  \<body>\+  \<p>HEY</p>\+  \<br>\+  \<template>\+  \<br>\+  \<div></div>\+  \<p></p>\+  \<p>YOU</p>\+  \<img>\+  \</template>\+  \<!-- test markup -->\+  \<table class=\"class\" style=\"red\">\+  \<tbody>\+  \<tr>\+  \<td></td>\+  \<td id=\"2\">MEGADETH</td>\+  \</tr>\+  \</tbody>\+  \</table>\+  \</body>\+  \</html>"++testAA1 :: Test+testAA1 = testCase "html adoption agency 1" $ do+  assertEqual "TEST 1" htmlAA1Pretty $ genPretty htmlAA1In+  assertEqual "TEST 2" htmlAA1Normal $ genNormal htmlAA1In++htmlAA1In =+  "<!DOCTYPE html>\+  \<head><title>AA Case 1</title></head>\+  \<body>\+  \<p>1<b>2<i>3</b>4</i>5</p>\+  \</body>\+  \"++htmlAA1Pretty =+  "<!DOCTYPE html>\n\+  \<html>\n\+  \ <head>\n\+  \  <title>AA Case 1</title>\n\+  \ </head>\n\+  \ <body>\n\+  \  <p>\n\+  \   1\n\+  \   <b>\n\+  \    2\n\+  \    <i>3</i>\n\+  \   </b>\n\+  \   <i>4</i>\n\+  \   5\n\+  \  </p>\n\+  \ </body>\n\+  \</html>"++htmlAA1Normal =+  "<!DOCTYPE html>\+  \<html>\+  \<head>\+  \<title>AA Case 1</title>\+  \</head>\+  \<body>\+  \<p>\+  \1\+  \<b>\+  \2\+  \<i>3</i>\+  \</b>\+  \<i>4</i>\+  \5\+  \</p>\+  \</body>\+  \</html>"++testAA2 :: Test+testAA2 = testCase "html adoption agency 2" $ do+  assertEqual "TEST 1" htmlAA2Pretty $ genPretty htmlAA2In+  assertEqual "TEST 2" htmlAA2Normal $ genNormal htmlAA2In++htmlAA2In =+  "<!DOCTYPE html>\+  \<b>1<p>2</b>3</p>\+  \"++htmlAA2Pretty =+  "<!DOCTYPE html>\n\+  \<html>\n\+  \ <head></head>\n\+  \ <body>\n\+  \  <b>1</b>\n\+  \  <p>\n\+  \   <b>2</b>\n\+  \   3\n\+  \  </p>\n\+  \ </body>\n\+  \</html>"++htmlAA2Normal =+  "<!DOCTYPE html>\+  \<html>\+  \<head></head>\+  \<body>\+  \<b>1</b>\+  \<p>\+  \<b>2</b>\+  \3\+  \</p>\+  \</body>\+  \</html>"++testOmit :: Test+testOmit = testCase "html omit" $ do+  assertEqual "TEST 1" htmlOmitOut $ genNormal htmlOmitIn1+  assertEqual "TEST 2" htmlOmitOut $ genNormal htmlOmitIn2+  assertEqual "TEST 3" htmlOmit3Out $ genNormal htmlOmit3In++htmlOmitIn1 =+  "<!DOCTYPE HTML><title>Hello</title><p>example.</p>"++htmlOmitIn2 =+  "<!DOCTYPE HTML><title>Hello</title><p>example."++htmlOmitOut =+  "<!DOCTYPE html>\+  \<html><head><title>Hello</title>\+  \</head><body><p>example.</p></body></html>"++htmlOmit3In =+  "<!DOCTYPE HTML>\+  \<html lang=\"en\"><title>Hello</title>\+  \<body class=\"demo\"><p>example."++htmlOmit3Out =+  "<!DOCTYPE html>\+  \<html lang=\"en\"><head><title>Hello</title></head>\+  \<body class=\"demo\"><p>example.</p></body></html>"++testTableSparse :: Test+testTableSparse = testCase "html table sparse" $ do+  assertEqual "TEST 1"+    htmlTableSparseOut $ genNormal htmlTableSparseIn++htmlTableSparseIn =+  "<!DOCTYPE html>\+  \<table>\+  \ <caption>37547 TEE Electric Powered Rail Car Train Functions\+  \ <colgroup><col><col><col>\+  \ <thead>\+  \  <tr> <th>Function                    <th>Control Unit     <th>Central\+  \ <tbody>\+  \  <tr> <td>Headlights                  <td>✔                <td>✔\+  \  <tr> <td>Interior Lights             <td>✔                <td>✔\+  \  <tr> <td>Electric locomotive sounds  <td>✔                <td>✔\+  \  <tr> <td>Engineer's cab lighting     <td>                 <td>✔\+  \  <tr> <td>Station Announce - Swiss    <td>                 <td>✔\+  \</table>"++htmlTableSparseOut =+  "<!DOCTYPE html>\+  \<html><head></head><body>\+  \<table>\+  \ <caption>37547 TEE Electric Powered Rail Car Train Functions\+  \ </caption>\+  \<colgroup><col><col><col>\+  \ </colgroup><thead>\+  \  <tr> \+  \<th>Function                    </th>\+  \<th>Control Unit     </th>\+  \<th>Central </th>\+  \</tr>\+  \</thead><tbody>\+  \  <tr>\+  \ <td>Headlights                  </td>\+  \<td>\10004                </td>\+  \<td>\10004  </td>\+  \</tr><tr>\+  \ <td>Interior Lights             </td>\+  \<td>\10004                </td>\+  \<td>\10004  </td>\+  \</tr><tr>\+  \ <td>Electric locomotive sounds  </td>\+  \<td>\10004                </td>\+  \<td>\10004  </td>\+  \</tr><tr>\+  \ <td>Engineer's cab lighting     </td>\+  \<td>                 </td>\+  \<td>\10004  </td>\+  \</tr><tr>\+  \ <td>Station Announce - Swiss    </td>\+  \<td>                 </td>\+  \<td>\10004</td>\+  \</tr></tbody></table></body></html>"++testMath :: Test+testMath = testCase "html math" $ do+  assertEqual "TEST 1" htmlMathOut $ genNormal htmlMathIn++htmlMathIn =+  "<!DOCTYPE html>\+  \<p>You can add a string to a number, but this stringifies the number:</p>\+  \<math>\+  \<ms><![CDATA[x<y]]></ms>\+  \<mo>+</mo>\+  \<mn>3</mn>\+  \<mo>=</mo>\+  \<ms><![CDATA[x<y3]]></ms>\+  \</math>"++htmlMathOut =+  "<!DOCTYPE html>\+  \<html><head></head><body>\+  \<p>You can add a string to a number, but this stringifies the number:</p>\+  \<math>\+  \<ms>x&lt;y</ms>\+  \<mo>+</mo><mn>3</mn><mo>=</mo>\+  \<ms>x&lt;y3</ms>\+  \</math></body></html>"++testScript :: Test+testScript = testCase "html script" $ do+  assertEqual "TEST 1" htmlScript1Out $ genNormal htmlScript1In+  assertEqual "TEST 2" htmlScript2Out $ genNormal htmlScript2In+  assertEqual "TEST 3" htmlScript3Out $ genNormal htmlScript3In+  assertEqual "TEST 4" htmlScript4Out $ genNormal htmlScript4In++htmlScript1In =+  "<!DOCTYPE html>\+  \<script>\+  \document.write('<p>');\+  \</script>"++htmlScript1Out =+  "<!DOCTYPE html>\+  \<html>\+  \<head>\+  \<script>document.write('<p>');</script>\+  \</head>\+  \<body></body>\+  \</html>"++htmlScript2In =+  "<!DOCTYPE html>\+  \<div id=a>\+  \<script>\+  \ var div = document.getElementById('a');\+  \ parent.document.body.appendChild(div);\+  \</script>\+  \<script>\+  \ alert(document.URL);\+  \</script>\+  \</div>\+  \<script>\+  \ alert(document.URL);\+  \</script>"++htmlScript2Out =+  "<!DOCTYPE html>\+  \<html><head></head><body>\+  \<div id=\"a\">\+  \<script>\+  \ var div = document.getElementById('a');\+  \ parent.document.body.appendChild(div);\+  \</script>\+  \<script>\+  \ alert(document.URL);\+  \</script>\+  \</div>\+  \<script>\+  \ alert(document.URL);\+  \</script>\+  \</body></html>"++htmlScript3In =+  "<!DOCTYPE html>\+  \<body><script>\+  \ <!-- comm -->\+  \ var div = \"div\";\+  \ var d2 = \"<div>\";\+  \ var d3 = \"</div>\";\+  \</script></body>"++htmlScript3Out =+  "<!DOCTYPE html>\+  \<html><head></head><body>\+  \<script>\+  \ <!-- comm -->\+  \ var div = \"div\";\+  \ var d2 = \"<div>\";\+  \ var d3 = \"</div>\";\+  \</script>\+  \</body></html>"++htmlScript4In =+  [r|<script>+      var a = "<div id=\""+id+"\" class=\"ad "+divClass+"\">"+adString+"</div>";+     </script>|]++htmlScript4Out =+  [r|<html><head><script>+      var a = "<div id=\""+id+"\" class=\"ad "+divClass+"\">"+adString+"</div>";+     </script></head><body></body></html>|]++testInput :: Test+testInput = testCase "html input" $ do+  assertEqual "TEST 1" htmlInputOut $ genNormal htmlInputIn++htmlInputIn =+  "<!DOCTYPE html>\+  \<input disabled>\+  \<input value=yes>\+  \<input type='checkbox'>\+  \<input name=\"be evil\">"++htmlInputOut =+  "<!DOCTYPE html>\+  \<html><head></head><body>\+  \<input disabled=\"\">\+  \<input value=\"yes\">\+  \<input type=\"checkbox\">\+  \<input name=\"be evil\">\+  \</body></html>"++testList :: Test+testList = testCase "html list" $ do+  assertEqual "TEST 1" htmlList1Out $ genNormal htmlList1In++htmlList1In =+  "<!DOCTYPE html>\+  \<ul>\+  \<li>A\+  \<li>A\+  \<li>A\+  \</ul>"++htmlList1Out =+  "<!DOCTYPE html>\+  \<html><head></head><body>\+  \<ul><li>A</li><li>A</li><li>A</li></ul>\+  \</body></html>"++testScriptBeforeHead :: Test+testScriptBeforeHead = testCase "html script before head" $ do+  assertEqual "TEST 1"+    htmlScriptBeforeHeadOut $ genNormal htmlScriptBeforeHeadIn++htmlScriptBeforeHeadIn =+  "<!DOCTYPE html>\+  \<script type=\"text/javascript\">var a = 1;</script>\+  \<head></head>\+  \<body></body>\+  \"++htmlScriptBeforeHeadOut =+  "<!DOCTYPE html>\+  \<html>\+  \<head>\+  \<script type=\"text/javascript\">var a = 1;</script>\+  \</head>\+  \<body></body>\+  \</html>"++testComment :: Test+testComment = testCase "html comment" $ do+  assertEqual "TEST 1"+    htmlCommentOut $ genNormal htmlCommentIn++htmlCommentIn =+  "<!DOCTYPE html>\+  \<!--[if lt IE 7]>\+  \<html class=\"no-js ie ie6 lt-ie9 lt-ie8 lt-ie7\"\+  \ xmlns=\"http://www.w3.org/1999/xhtml\"\+  \ xmlns:og=\"http://opengraphprotocol.org/schema/\"\+  \ xmlns:fb=\"http://www.facebook.com/2008/fbml\"\+  \ lang=\"en-US\">\+  \ <![endif]-->\+  \<!-- start wired/views/global/partial-header-meta.php -->\+  \<head itemscope itemtype=\"http://schema.org/WebSite\"\+  \ profile=\"http://gmpg.org/xfn/11\">"++htmlCommentOut =+  "<!DOCTYPE html>\+  \<!--[if lt IE 7]>\+  \<html class=\"no-js ie ie6 lt-ie9 lt-ie8 lt-ie7\"\+  \ xmlns=\"http://www.w3.org/1999/xhtml\"\+  \ xmlns:og=\"http://opengraphprotocol.org/schema/\"\+  \ xmlns:fb=\"http://www.facebook.com/2008/fbml\"\+  \ lang=\"en-US\">\+  \ <![endif]-->\+  \<!-- start wired/views/global/partial-header-meta.php -->\+  \<html>\+  \<head itemscope=\"\"\+  \ itemtype=\"http://schema.org/WebSite\"\+  \ profile=\"http://gmpg.org/xfn/11\">\+  \</head><body></body></html>"++testEntity :: Test+testEntity = testCase "html entity" $ do+  assertEqual "TEST 1"+    htmlEntity1Out $ genEntity htmlEntity1In False+  assertEqual "TEST 2"+    htmlEntity2Out $ genEntity htmlEntity1In True+  assertEqual "TEST 3"+    htmlEntityNum1Out $ genEntity htmlEntityNumIn False+  assertEqual "TEST 4"+    htmlEntityNum2Out $ genEntity htmlEntityNumIn True++htmlEntity1In =+  "<!DOCTYPE html>\+  \<p id=\"&amp;\">&amp;</p>"++htmlEntity1Out =+  "<!DOCTYPE html>\+  \<html>\+  \<head>\+  \</head>\+  \<body>\+  \<p id=\"&\">&</p>\+  \</body>\+  \</html>"++htmlEntity2Out =+  "<!DOCTYPE html>\+  \<html>\+  \<head>\+  \</head>\+  \<body>\+  \<p id=\"&amp;\">&amp;</p>\+  \</body>\+  \</html>"++htmlEntityNumIn =+  "<!DOCTYPE html><p>&#x2212;&#x0394;&#160;</p>"++htmlEntityNum1Out =+  "<!DOCTYPE html><html><head></head><body>\+  \<p>\8722\916&nbsp;</p></body></html>"++htmlEntityNum2Out =+  "<!DOCTYPE html><html><head></head><body>\+  \<p>&#x2212;&#x0394;&#160;</p></body></html>"++testAfterHead :: Test+testAfterHead = testCase "html after head" $ do+  assertEqual "TEST 1" htmlAfterHead1Out $ genNormal htmlAfterHead1In++htmlAfterHead1In =+  "<!DOCTYPE html>\+  \<html>\+  \<head>\+  \</head>\+  \<script></script>\+  \<body>\+  \</body>\+  \</html>"++htmlAfterHead1Out =+  "<!DOCTYPE html>\+  \<html>\+  \<head>\+  \<script></script>\+  \</head>\+  \<body>\+  \</body>\+  \</html>"
+ test/Zenacy/HTML/Internal/Image/Tests.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings #-}++module Zenacy.HTML.Internal.Image.Tests+  ( testImage+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Char+import Zenacy.HTML.Internal.Image+import Zenacy.HTML.Internal.Types+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( reverse+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )++testImage :: Test+testImage = testGroup "Zenacy.HTML.Internal.Image"+  [ testParse+  , testRender+  , testURL+  , testMap+  , testMin+  , testMax+  ]++testParse :: Test+testParse = testCase "srcset parse" $ do+  assertEqual "TEST 1"+    (HTMLSrcset [])+    (htmlSrcsetParse "")+  assertEqual "TEST 2"+    (HTMLSrcset [HTMLSrcsetCandidate "/a/b/c" HTMLSrcsetNone])+    (htmlSrcsetParse "/a/b/c")+  assertEqual "TEST 3"+    (HTMLSrcset [HTMLSrcsetCandidate "/a/b/c" (HTMLSrcsetPixel 2)])+    (htmlSrcsetParse "/a/b/c 2x")+  assertEqual "TEST 4"+    (HTMLSrcset+      [HTMLSrcsetCandidate "/a" HTMLSrcsetNone+      ,HTMLSrcsetCandidate "/b" HTMLSrcsetNone+      ])+    (htmlSrcsetParse "/a,/b")+  assertEqual "TEST 5"+    (HTMLSrcset+      [HTMLSrcsetCandidate "/a" (HTMLSrcsetPixel 2)+      ,HTMLSrcsetCandidate "/b" (HTMLSrcsetWidth 2)+      ])+    (htmlSrcsetParse "/a 2x , /b 2w")+  assertEqual "TEST 6"+    (HTMLSrcset [])+    (htmlSrcsetParse ",")+  assertEqual "TEST 7"+    (HTMLSrcset [HTMLSrcsetCandidate "/a/b/c" HTMLSrcsetNone])+    (htmlSrcsetParse " /a/b/c ")+  assertEqual "TEST 8"+    (HTMLSrcset [HTMLSrcsetCandidate "/a/b/c" HTMLSrcsetNone])+    (htmlSrcsetParse " /a/b/c, ")+  assertEqual "TEST 9"+    (HTMLSrcset [HTMLSrcsetCandidate "/a/b/c" (HTMLSrcsetPixel 2)])+    (htmlSrcsetParse ",/a/b/c 2x,")+  assertEqual "TEST 10"+    (HTMLSrcset+      [HTMLSrcsetCandidate "/a" (HTMLSrcsetPixel 2)+      ,HTMLSrcsetCandidate "/b" (HTMLSrcsetWidth 2)+      ])+    (htmlSrcsetParse " /a 2x , /b 2w , ")++testRender :: Test+testRender = testCase "srcset render" $ do+  assertEqual "TEST 1" "" $ p ""+  assertEqual "TEST 2" "/a/b/c" $ p "/a/b/c"+  assertEqual "TEST 3" "/a/b/c 2x" $ p "/a/b/c 2x"+  assertEqual "TEST 4" "/a,/b" $ p "/a,/b"+  assertEqual "TEST 5" "/a 2x,/b 2w" $ p "/a 2x,/b 2w"+  assertEqual "TEST 6" "" $ p ","+  where+    p = htmlSrcsetRender+      . htmlSrcsetParse++testURL :: Test+testURL = testCase "srcset list" $ do+  assertEqual "TEST 1" [] $ p ""+  assertEqual "TEST 2" ["/a/b/c"] $ p "/a/b/c"+  assertEqual "TEST 3" ["/a/b/c"] $ p "/a/b/c 3x"+  assertEqual "TEST 4" ["/a","/b"] $  p "/a,/b"+  assertEqual "TEST 5" ["/a","/b"] $ p "/a 2x,/b 2w"+  where+    p = htmlSrcsetListURL+      . htmlSrcsetParse++testMap :: Test+testMap = testCase "srcset map" $ do+  assertEqual "TEST 1" "a/ 2x,b/ 2w" $ p "/a 2x,/b 2w"+  where+    p = htmlSrcsetRender+      . htmlSrcsetMapURL T.reverse+      . htmlSrcsetParse++testMin :: Test+testMin = testCase "srcset min" $ do+  assertEqual "TEST 1" "/a" $ p "/a,/b 2x"+  assertEqual "TEST 2" "/a" $ p "/a"+  assertEqual "TEST 3" "/a" $ p "/a 100w"+  assertEqual "TEST 4" "/a" $ p "/c 3x, /d 4x, /a, /b 2x"+  where+    p = htmlSrcsetImageMin+      . htmlSrcsetParse++testMax :: Test+testMax = testCase "srcset max" $ do+  assertEqual "TEST 1" "/b" $ p "/a,/b 2x"+  assertEqual "TEST 2" "/a" $ p "/a"+  assertEqual "TEST 3" "/a" $ p "/a 100w"+  assertEqual "TEST 4" "/d" $ p "/c 3x, /d 4x, /a, /b 2x"+  where+    p = htmlSrcsetImageMax+      . htmlSrcsetParse
+ test/Zenacy/HTML/Internal/Lexer/Tests.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}++module Zenacy.HTML.Internal.Lexer.Tests+  ( testLexer+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Char+import Zenacy.HTML.Internal.Lexer+import Zenacy.HTML.Internal.Token+import Zenacy.HTML.Internal.Types+import Control.Monad.ST+import Data.Default+  ( Default(..)+  )+import Data.DList+  ( DList+  )+import qualified Data.DList as D+  ( empty+  , snoc+  , toList+  )+import Data.Either.Extra+  ( fromRight+  )+import Data.Monoid+  ( (<>)+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )+import Text.RawString.QQ++testLexer :: Test+testLexer = testGroup "Zenacy.HTML.Internal.Lexer"+  [ testBasic+  , testBuffer+  , testComment+  , testDoctype+  , testSelfClose+  , testPrune+  , testCharRef+  , testScript+  ]++testBasic :: Test+testBasic = testCase "lexer basic" $ do+  assertEqual "TEST 1"+    [ TStart "html" False []+    , TStart "body" False []+    , TStart "a" False [tokenAttr "href" "https://example.com"]+    , TEnd "a"+    , TEnd "body"+    , TEnd "html"+    , TEOF+    ] $ getTokens htmlData++testBuffer :: Test+testBuffer = testCase "lexer buffer" $ do+  assertEqual "TEST 1"+    [ TStart "html" False []+    , TStart "body" False []+    , TStart "a" False [tokenAttr "href" "https://example.com"]+    , TEnd "a"+    , TEnd "body"+    , TEnd "html"+    , TEOF+    ] $ getTokens htmlData++testComment :: Test+testComment = testCase "lexer comment" $ do+  assertEqual "TEST 1"+    [ TComment "abcxyz"+    , TComment " abcxyz "+    , TEOF+    ] $ getTokens htmlComm++testDoctype :: Test+testDoctype = testCase "lexer doctype" $ do+  assertEqual "TEST 1"+    [ TDoctype "html" False Nothing Nothing, TEOF ] $+    getTokens [r|<!DOCTYPE html>|]+  assertEqual "TEST 2"+    [ TDoctype "html" False (Just "A") (Just "B"), TEOF ] $+    getTokens [r|<!DOCTYPE html PUBLIC "A" "B">|]+  assertEqual "TEST 3"+    [ TDoctype "html" False Nothing (Just "x"), TEOF ] $+    getTokens [r|<!DOCTYPE html SYSTEM "x">|]+  assertEqual "TEST 4"+    [ TDoctype "html" True Nothing Nothing, TEOF ] $+    getTokens [r|<!DOCTYPE html SYSTEM>|]+  assertEqual "TEST 5"+    [ TDoctype "html" False Nothing Nothing, TEOF ] $+    getTokens [r|<!doctype html>|]+  assertEqual "TEST 6"+    [ TDoctype "html" False Nothing Nothing, TEOF ] $+    getTokens [r|<!DOCTYPE HTML>|]++testSelfClose :: Test+testSelfClose = testCase "lexer self close" $ do+  assertEqual "TEST 1"+    [ TStart "meta" True [tokenAttr "charset" "UTF-8"]+    , TEOF+    ] $ getTokens [r|<meta charset="UTF-8"/>|]++testPrune :: Test+testPrune = testCase "lexer prune" $ do+  assertEqual "TEST 1"+    [ TStart "div" True [tokenAttr "id" "1"]+    , TEOF+    ] $ getTokens [r|<div id="1" id="2" id="3"/>|]++testCharRef :: Test+testCharRef = testCase "lexer char ref" $ do+  assertEqual "TEST 1"+    [ TStart "div" True [tokenAttr "a" "\226\136\128"]+    , TEOF+    ] $ getTokens [r|<div a="&forall;"/>|]+  assertEqual "TEST 2"+    [ TStart "div" True [tokenAttr "b" "\226\135\146"]+    , TEOF+    ] $ getTokens [r|<div b='&Implies;'/>|]+  assertEqual "TEST 3"+    [ TStart "div" False [tokenAttr "c" "\226\136\183"]+    , TEOF+    ] $ getTokens [r|<div c=&Proportion;>|]+  assertEqual "TEST 4"+    [ TStart "div" False []+    , TChar 226+    , TChar 136+    , TChar 130+    , TEnd "div"+    , TEOF+    ] $ getTokens [r|<div>&PartialD;</div>|]+  assertEqual "TEST 5"+    [ TStart "div" False [tokenAttr "a" "\226\136\128\226\136\128"]+    , TEOF+    ] $ getTokens [r|<div a="&#x02200;&#8704;">|]++testScript :: Test+testScript = testCase "lexer script" $ do+  run "TEST 1" "var a = 0;"+  where+    run x y = assertEqual x (res y) $ getTokens (scr y)+    scr x = "<script>" <> x <> "</script>"+    res x = [TStart "script" False []]+         <> map TChar (bsUnpack x)+         <> [TEnd "script", TEOF]++getTokens :: BS -> [Token]+getTokens s =+  runST $ do+    lexerNew def { lexerOptionInput = s } >>= \case+      Left e -> pure []+      Right x -> go x D.empty+  where+    go x a = do+      lexerNext x >>= \case+        TEOF -> pure $ D.toList $ D.snoc a TEOF+        token -> go x $ D.snoc a token++htmlData = [r|<html><body><a href="https://example.com"></a></body></html>|]++htmlComm = [r|<!--abcxyz--><!-- abcxyz -->|]
+ test/Zenacy/HTML/Internal/Oper/Tests.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++module Zenacy.HTML.Internal.Oper.Tests+  ( testOper+  ) where++import Zenacy.HTML+import Control.Monad+  ( (>=>)+  )+import Data.Map+  ( Map+  )+import qualified Data.Map as Map+  ( fromList+  , lookup+  )+import Data.Maybe+  ( fromJust+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )++testOper :: Test+testOper = testGroup "Zenacy.HTML.Internal.Oper"+  [ testStyle+  ]++h = fromJust+  . htmlDocBody+  $ htmlParseEasy+  "<body>\+  \<h1></h1>\+  \<p><a href='bbb'>AAA</a><span></span><br><img></p>\+  \<p id=\"1\" style=\"display:none\"></p>\+  \<p id=\"2\" style=\"display:none;\"></p>\+  \<p id=\"3\" style=\"display: none;\"></p>\+  \<p id=\"4\" style=\"  display:  none; \"></p>\+  \<p id=\"5\" style=\"  display\"></p>\+  \<p id=\"6\" style=\" \"></p>\+  \<p id=\"7\" style=\"  display:  ; \"></p>\+  \<p id=\"8\" style=\";  ;display:  none;;\"></p>\+  \<div id=\"9\" style=\"background-image:url(https://a/b);\"></div>\+  \<div id=\"10\" style=\"background-image:url('https://a/b');\"></div>\+  \</body>"+f x = fromJust . htmlElemFindID x++testStyle :: Test+testStyle = testCase "oper style" $ do+  assertEqual "TEST 1" m0 $ g "1"+  assertEqual "TEST 2" m0 $ g "2"+  assertEqual "TEST 3" m0 $ g "3"+  assertEqual "TEST 4" m0 $ g "4"+  assertEqual "TEST 5" m1 $ g "5"+  assertEqual "TEST 6" m2 $ g "6"+  assertEqual "TEST 7" m1 $ g "7"+  assertEqual "TEST 8" m0 $ g "8"+  assertEqual "TEST 9"+    (Map.fromList [("background-image","url(https://a/b)")])+    (g "9")+  assertEqual "TEST 10"+    (Just "https://a/b")+    ((Map.lookup "background-image" >=> htmlElemStyleParseURL) (g "9"))+  assertEqual "TEST 11"+    (Just "https://a/b")+    ((Map.lookup "background-image" >=> htmlElemStyleParseURL) (g "10"))+  where+    g x = htmlElemStyles $ f x h+    m0 = Map.fromList [("display","none")]+    m1 = Map.fromList [("display","")]+    m2 = Map.fromList []
+ test/Zenacy/HTML/Internal/Parser/Tests.hs view
@@ -0,0 +1,447 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}++module Zenacy.HTML.Internal.Parser.Tests+  ( testParser+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Char+import Zenacy.HTML.Internal.DOM+import Zenacy.HTML.Internal.Lexer+import Zenacy.HTML.Internal.Parser+import Zenacy.HTML.Internal.Token+import Zenacy.HTML.Internal.Types+import Control.Monad.ST+import Data.Default+  ( Default(..)+  )+import Data.Either.Extra+  ( fromRight+  )+import Data.IntMap+  ( IntMap+  )+import qualified Data.IntMap as IntMap+  ( fromList+  )+import Data.Sequence+  ( Seq+  )+import qualified Data.Sequence as Seq+  ( fromList+  )+import GHC.Exts+  ( IsList(..)+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )+import Text.RawString.QQ+import Text.Show.Pretty+  ( ppShow+  , pPrint+  )++testParser :: Test+testParser = testGroup "Zenacy.HTML.Internal.Parser"+  [ testBasic+  , testComment+  , testTemplate+  , testType+  , testCode+  ]++testBasic :: Test+testBasic = testCase "parser basic" $ do+  assertEqual "TEST 1" domData $ parserResultDOM $ getResult htmlData++testComment :: Test+testComment = testCase "parser comment" $ do+  assertEqual "TEST 1" domComm $ parserResultDOM $ getResult htmlComm++testTemplate :: Test+testTemplate = testCase "parser template" $ do+  assertEqual "TEST 1" domTemp $ parserResultDOM $ getResult htmlTemp++testType :: Test+testType = testCase "parser type" $ do+  assertEqual "TEST 1" domType $ parserResultDOM $ getResult htmlType++testCode :: Test+testCode = testCase "parser code" $ do+  assertEqual "TEST 1" domCode $ parserResultDOM $ getResult htmlCode++-- | This test case is used to make other test cases by rendering+-- the results of the dom.+testRender :: Test+testRender = testCase "parser render" $ do+  let r = getResult htmlCode+  let d = parserResultDOM r+  pPrint d+  assertEqual "TEST 1" def $ ppShow d++getResult :: BS -> ParserResult+getResult s = fromRight def $ parseDocument def { parserOptionInput = s }++htmlData = [r|<html><body>aaa<a href="https://example.com">bbb</a>ccc</body></html>|]++htmlComm = [r|<!--abcxyz--><!-- abcxyz -->|]++htmlTemp = [r|<!DOCTYPE html><template><div>a</div></template>|]++htmlType = [r|<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">|]++htmlCode = [r|<!DOCTYPE html>&#x2212;&#x0394;&#160;|]++domData =+  DOM+    { domNodes =+        fromList+          [ ( 1+            , DOMDocument+                { domDocumentID = 0+                , domDocumentParent = 0+                , domDocumentName = ""+                , domDocumentChildren = fromList [ 2 ]+                , domDocumentQuirksMode = DOMQuirksMode+                }+            )+          , ( 2+            , DOMElement+                { domElementID = 2+                , domElementParent = 1+                , domElementName = "html"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList [ 3 , 4 ]+                }+            )+          , ( 3+            , DOMElement+                { domElementID = 3+                , domElementParent = 2+                , domElementName = "head"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList []+                }+            )+          , ( 4+            , DOMElement+                { domElementID = 4+                , domElementParent = 2+                , domElementName = "body"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList [ 5 , 6 , 8 ]+                }+            )+          , ( 5+            , DOMText+                { domTextID = 5 , domTextParent = 4 , domTextData = "aaa" }+            )+          , ( 6+            , DOMElement+                { domElementID = 6+                , domElementParent = 4+                , domElementName = "a"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes =+                    fromList+                      [ DOMAttr+                          { domAttrName = "href"+                          , domAttrVal = "https://example.com"+                          , domAttrNamespace = HTMLAttrNamespaceNone+                          }+                      ]+                , domElementChildren = fromList [ 7 ]+                }+            )+          , ( 7+            , DOMText+                { domTextID = 7 , domTextParent = 6 , domTextData = "bbb" }+            )+          , ( 8+            , DOMText+                { domTextID = 8 , domTextParent = 4 , domTextData = "ccc" }+            )+          ]+    , domNextID = 9+    }++domComm =+  DOM+    { domNodes =+        fromList+          [ ( 1+            , DOMDocument+                { domDocumentID = 0+                , domDocumentParent = 0+                , domDocumentName = ""+                , domDocumentChildren = fromList [ 2 , 3 , 4 ]+                , domDocumentQuirksMode = DOMQuirksMode+                }+            )+          , ( 2+            , DOMComment+                { domCommentID = 2+                , domCommentParent = 1+                , domCommentData = "abcxyz"+                }+            )+          , ( 3+            , DOMComment+                { domCommentID = 3+                , domCommentParent = 1+                , domCommentData = " abcxyz "+                }+            )+          , ( 4+            , DOMElement+                { domElementID = 4+                , domElementParent = 1+                , domElementName = "html"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList [ 5 , 6 ]+                }+            )+          , ( 5+            , DOMElement+                { domElementID = 5+                , domElementParent = 4+                , domElementName = "head"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList []+                }+            )+          , ( 6+            , DOMElement+                { domElementID = 6+                , domElementParent = 4+                , domElementName = "body"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList []+                }+            )+          ]+    , domNextID = 7+    }++domTemp =+  DOM+    { domNodes =+        fromList+          [ ( 1+            , DOMDocument+                { domDocumentID = 0+                , domDocumentParent = 0+                , domDocumentName = ""+                , domDocumentChildren = fromList [ 2 , 3 ]+                , domDocumentQuirksMode = DOMQuirksNone+                }+            )+          , ( 2+            , DOMDoctype+                { domDoctypeID = 2+                , domDoctypeParent = 1+                , domDoctypeName = "html"+                , domDoctypePublicID = Nothing+                , domDoctypeSystemID = Nothing+                }+            )+          , ( 3+            , DOMElement+                { domElementID = 3+                , domElementParent = 1+                , domElementName = "html"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList [ 4 , 9 ]+                }+            )+          , ( 4+            , DOMElement+                { domElementID = 4+                , domElementParent = 3+                , domElementName = "head"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList [ 6 ]+                }+            )+          , ( 5+            , DOMFragment+                { domFragmentID = 5+                , domFragmentParent = 6+                , domFragmentName = ""+                , domFragmentChildren = fromList [ 7 ]+                }+            )+          , ( 6+            , DOMTemplate+                { domTemplateID = 6+                , domTemplateParent = 4+                , domTemplateNamespace = HTMLNamespaceHTML+                , domTemplateAttributes = fromList []+                , domTemplateContents = 5+                }+            )+          , ( 7+            , DOMElement+                { domElementID = 7+                , domElementParent = 5+                , domElementName = "div"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList [ 8 ]+                }+            )+          , ( 8+            , DOMText { domTextID = 8 , domTextParent = 7 , domTextData = "a" }+            )+          , ( 9+            , DOMElement+                { domElementID = 9+                , domElementParent = 3+                , domElementName = "body"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList []+                }+            )+          ]+    , domNextID = 10+    }++domType =+  DOM+    { domNodes =+        fromList+          [ ( 1+            , DOMDocument+                { domDocumentID = 0+                , domDocumentParent = 0+                , domDocumentName = ""+                , domDocumentChildren = fromList [ 2 , 3 ]+                , domDocumentQuirksMode = DOMQuirksNone+                }+            )+          , ( 2+            , DOMDoctype+                { domDoctypeID = 2+                , domDoctypeParent = 1+                , domDoctypeName = "html"+                , domDoctypePublicID = Just "-//W3C//DTD HTML 4.01//EN"+                , domDoctypeSystemID = Just "http://www.w3.org/TR/html4/strict.dtd"+                }+            )+          , ( 3+            , DOMElement+                { domElementID = 3+                , domElementParent = 1+                , domElementName = "html"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList [ 4 , 5 ]+                }+            )+          , ( 4+            , DOMElement+                { domElementID = 4+                , domElementParent = 3+                , domElementName = "head"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList []+                }+            )+          , ( 5+            , DOMElement+                { domElementID = 5+                , domElementParent = 3+                , domElementName = "body"+                , domElementNamespace = HTMLNamespaceHTML+                , domElementAttributes = fromList []+                , domElementChildren = fromList []+                }+            )+          ]+    , domNextID = 6+    }++domCode =+  DOM+  { domNodes =+      fromList+        [ ( 1+          , DOMDocument+              { domDocumentID = 0+              , domDocumentParent = 0+              , domDocumentName = ""+              , domDocumentChildren = fromList [ 2 , 3 ]+              , domDocumentQuirksMode = DOMQuirksNone+              }+          )+        , ( 2+          , DOMDoctype+              { domDoctypeID = 2+              , domDoctypeParent = 1+              , domDoctypeName = "html"+              , domDoctypePublicID = Nothing+              , domDoctypeSystemID = Nothing+              }+          )+        , ( 3+          , DOMElement+              { domElementID = 3+              , domElementParent = 1+              , domElementName = "html"+              , domElementNamespace = HTMLNamespaceHTML+              , domElementAttributes = fromList []+              , domElementChildren = fromList [ 4 , 5 ]+              }+          )+        , ( 4+          , DOMElement+              { domElementID = 4+              , domElementParent = 3+              , domElementName = "head"+              , domElementNamespace = HTMLNamespaceHTML+              , domElementAttributes = fromList []+              , domElementChildren = fromList []+              }+          )+        , ( 5+          , DOMElement+              { domElementID = 5+              , domElementParent = 3+              , domElementName = "body"+              , domElementNamespace = HTMLNamespaceHTML+              , domElementAttributes = fromList []+              , domElementChildren = fromList [ 6 ]+              }+          )+        , ( 6+          , DOMText+              { domTextID = 6+              , domTextParent = 5+              , domTextData = "\226\136\146\206\148\194\160"+              }+          )+        ]+  , domNextID = 7+  }
+ test/Zenacy/HTML/Internal/Query/Tests.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE OverloadedStrings #-}++module Zenacy.HTML.Internal.Query.Tests+  ( testQuery+  ) where++import Zenacy.HTML+import Data.Maybe+  ( fromJust+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )++testQuery :: Test+testQuery = testGroup "Zenacy.HTML.Internal.Query"+  [ testFirst+  , testLast+  , testNext+  , testPrev+  , testUp+  , testIsFirst+  , testIsLast+  , testSave+  , testNode+  , testName+  , testAttr+  , testAttrVal+  , testId+  , testClass+  , testGeneral+  , testOnly+  ]++h = htmlParseEasy+    "<h1></h1><p>\+    \<a href='bbb'>AAA</a><span id='x' class='y z'></span><br><img>\+    \</p>"+b = fromJust $ htmlDocBody h++testFirst :: Test+testFirst = testCase "query first" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ do+      htmlQueryFirst+      htmlQueryName "h1"+      htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun b $ do+      htmlQueryFirst+      htmlQueryFirst+      htmlQuerySucc True++testLast :: Test+testLast = testCase "query last" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ htmlQueryLast >> htmlQueryName "p" >> htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun b $ htmlQueryFirst >> htmlQueryLast >> htmlQuerySucc True++testNext :: Test+testNext = testCase "query next" $ do+  assertEqual "TEST 1" (Nothing) $+    htmlQueryRun b $ htmlQueryNext >> htmlQuerySucc True++testPrev :: Test+testPrev = testCase "query prev" $ do+  assertEqual "TEST 1" (Nothing) $+    htmlQueryRun b $ htmlQueryPrev >> htmlQuerySucc True++testUp :: Test+testUp = testCase "query up" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ htmlQueryLast >> htmlQueryLast >> htmlQueryName "img"+      >> htmlQueryUp >> htmlQueryName "p" >> htmlQueryUp >> htmlQueryName "body"+      >> htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun b $ htmlQueryUp >> htmlQuerySucc True++testIsFirst :: Test+testIsFirst = testCase "query isfirst" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ htmlQueryIsFirst >> htmlQuerySucc True++testIsLast :: Test+testIsLast = testCase "query islast" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ htmlQueryIsLast >> htmlQuerySucc True++testSave :: Test+testSave = testCase "query save" $ do+  assertEqual "TEST 1" (Just "body") $+    htmlQueryRun b $ htmlQuerySave 4 >> htmlQueryGet 4 >>= \a -> htmlQuerySucc $ htmlElemName a++testNode :: Test+testNode = testCase "query node" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ htmlQueryNode >>= htmlQuerySucc . htmlElemHasName "body"++testName :: Test+testName = testCase "query name" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ htmlQueryName "body" >> htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun b $ htmlQueryName "x" >> htmlQuerySucc True++testAttr :: Test+testAttr = testCase "query attr" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ do+      htmlQueryLast+      htmlQueryFirst+      htmlQueryNext+      htmlQueryAttr "id"+      htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun b $ do+      htmlQueryAttr "x"+      htmlQuerySucc True++testAttrVal :: Test+testAttrVal = testCase "query attr val" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ do+      htmlQueryLast+      htmlQueryFirst+      htmlQueryNext+      htmlQueryAttrVal "id" "x"+      htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun b $ do+      htmlQueryLast+      htmlQueryFirst+      htmlQueryNext+      htmlQueryAttrVal "id" "0"+      htmlQuerySucc True++testId :: Test+testId = testCase "query id" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ do+      htmlQueryLast+      htmlQueryFirst+      htmlQueryNext+      htmlQueryId "x"+      htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun b $ do+      htmlQueryLast+      htmlQueryFirst+      htmlQueryNext+      htmlQueryId "0"+      htmlQuerySucc True++testClass :: Test+testClass = testCase "query class" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun b $ do+      htmlQueryLast+      htmlQueryFirst+      htmlQueryNext+      htmlQueryHasClass "z"+      htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun b $ do+      htmlQueryLast+      htmlQueryFirst+      htmlQueryNext+      htmlQueryHasClass "0"+      htmlQuerySucc True++testGeneral :: Test+testGeneral = testCase "query general" $ do+  assertEqual "TEST 4" (Just "h1") $+    htmlQueryRun b $ do+      htmlQueryName "body"+      htmlQueryFirst+      htmlQueryName "h1"+      htmlQuerySave 1+      htmlQueryNext+      htmlQueryName "p"+      htmlQueryIsLast+      a <- htmlQueryGet 1+      htmlQuerySucc $ htmlElemName a++testOnly :: Test+testOnly = testCase "query only" $ do+  assertEqual "TEST 1" (Just True) $+    htmlQueryRun a $ do+      htmlQueryFirst+      htmlQueryNext+      htmlQueryOnly "span"+      htmlQueryOnly "a"+      htmlQuerySucc True+  assertEqual "TEST 2" (Nothing) $+    htmlQueryRun a $ do+      htmlQueryFirst+      htmlQueryNext+      htmlQueryOnly "a"+      htmlQueryOnly "a"+      htmlQuerySucc True+  assertEqual "TEST 3" (Nothing) $+    htmlQueryRun a $ do+      htmlQueryOnly "h1"+      htmlQuerySucc True+  where+    a = fromJust $ htmlDocBody $ htmlParseEasy+      "<h1></h1><p><span><a></a></span></p>"
+ test/Zenacy/HTML/Internal/Token/Tests.hs view
@@ -0,0 +1,610 @@+{-# LANGUAGE OverloadedStrings #-}++module Zenacy.HTML.Internal.Token.Tests+  ( testToken+  ) where++import Zenacy.HTML.Internal.BS+import Zenacy.HTML.Internal.Char+import Zenacy.HTML.Internal.Token+import Zenacy.HTML.Internal.Types+import Control.Monad+import Control.Monad.ST+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )++testToken :: Test+testToken = testGroup "Zenacy.HTML.Internal.Token"+  [ testType+  , testDoctype+  , testStart+  , testAttr+  , testEnd+  , testComment+  , testChar+  , testEof+  , testCount+  , testOffset+  , testDrop+  , testSize+  , testEmit+  , testIter+  , testCapacity+  , testStartName+  , testEndName+  , testPrune+  ]++testType :: Test+testType = testCase "token type" $ do+  assertEqual "TEST 1" (Just tokenDoctypeType) $+    runST $ f tokenDoctypeInit+  assertEqual "TEST 2" (Just tokenTagStartType) $+    runST $ f tokenTagStartInit+  assertEqual "TEST 3" (Just tokenTagEndType) $+    runST $ f tokenTagEndInit+  assertEqual "TEST 4" (Just tokenCommentType) $+    runST $ f tokenCommentInit+  assertEqual "TEST 5" (Just tokenCharType) $+    runST $ f $ tokenCharInit (ctow 'a')+  assertEqual "TEST 6" (Just tokenEOFType) $+    runST $ f tokenEOFInit+  where+    f g = do+      b <- tokenBuffer+      g b+      i <- tokenFirst b+      if i == 0+         then pure Nothing+         else Just <$> tokenType i b++testDoctype :: Test+testDoctype = testCase "token doctype" $ do+  assertEqual "TEST 1"+    (Just $ TDoctype "html" False Nothing Nothing) $+    runST $ do+      t <- tokenBuffer+      tokenDoctypeInit t+      tokenDoctypeNameAppend (ctow 'h') t+      tokenDoctypeNameAppend (ctow 't') t+      tokenDoctypeNameAppend (ctow 'm') t+      tokenDoctypeNameAppend (ctow 'l') t+      packFirst t+  assertEqual "TEST 2"+    (Just $ TDoctype "html" False (Just "abc") Nothing) $+    runST $ do+      t <- tokenBuffer+      tokenDoctypeInit t+      tokenDoctypeNameAppend (ctow 'h') t+      tokenDoctypeNameAppend (ctow 't') t+      tokenDoctypeNameAppend (ctow 'm') t+      tokenDoctypeNameAppend (ctow 'l') t+      tokenDoctypePublicIdInit t+      tokenDoctypePublicIdAppend (ctow 'a') t+      tokenDoctypePublicIdAppend (ctow 'b') t+      tokenDoctypePublicIdAppend (ctow 'c') t+      packFirst t+  assertEqual "TEST 3"+    (Just $ TDoctype "html" True (Just "abc") (Just "efg")) $+    runST $ do+      t <- tokenBuffer+      tokenDoctypeInit t+      tokenDoctypeNameAppend (ctow 'h') t+      tokenDoctypeNameAppend (ctow 't') t+      tokenDoctypeNameAppend (ctow 'm') t+      tokenDoctypeNameAppend (ctow 'l') t+      tokenDoctypePublicIdInit t+      tokenDoctypePublicIdAppend (ctow 'a') t+      tokenDoctypePublicIdAppend (ctow 'b') t+      tokenDoctypePublicIdAppend (ctow 'c') t+      tokenDoctypeSystemIdInit t+      tokenDoctypeSystemIdAppend (ctow 'e') t+      tokenDoctypeSystemIdAppend (ctow 'f') t+      tokenDoctypeSystemIdAppend (ctow 'g') t+      tokenDoctypeSetForceQuirks t+      packFirst t++testStart :: Test+testStart = testCase "token start" $ do+  assertEqual "TEST 1"+    (Just $ TStart "abc" False []) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'a') t+      tokenTagNameAppend (ctow 'b') t+      tokenTagNameAppend (ctow 'c') t+      packFirst t++testAttr :: Test+testAttr = testCase "token attr" $ do+  assertEqual "TEST 1"+    (Just $ TStart "abc" False [tokenAttr "id" "108"]) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'a') t+      tokenTagNameAppend (ctow 'b') t+      tokenTagNameAppend (ctow 'c') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'i') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrValAppend (ctow '1') t+      tokenAttrValAppend (ctow '0') t+      tokenAttrValAppend (ctow '8') t+      packFirst t+  assertEqual "TEST 2"+    (Just $ TStart "a" False [tokenAttr "x" ""]) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'a') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'x') t+      packFirst t+  assertEqual "TEST 3"+    (Just $ TStart "a" False+      [tokenAttr "x" "", tokenAttr "y" ""]) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'a') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'x') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'y') t+      packFirst t+  assertEqual "TEST 4"+    (Just $ TStart "div" False+      [ tokenAttr "id" "menu"+      , tokenAttr "hidden" ""+      , tokenAttr "data" "http"+      ]) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'd') t+      tokenTagNameAppend (ctow 'i') t+      tokenTagNameAppend (ctow 'v') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'i') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrValAppend (ctow 'm') t+      tokenAttrValAppend (ctow 'e') t+      tokenAttrValAppend (ctow 'n') t+      tokenAttrValAppend (ctow 'u') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'h') t+      tokenAttrNameAppend (ctow 'i') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrNameAppend (ctow 'e') t+      tokenAttrNameAppend (ctow 'n') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrNameAppend (ctow 'a') t+      tokenAttrNameAppend (ctow 't') t+      tokenAttrNameAppend (ctow 'a') t+      tokenAttrValAppend (ctow 'h') t+      tokenAttrValAppend (ctow 't') t+      tokenAttrValAppend (ctow 't') t+      tokenAttrValAppend (ctow 'p') t+      packFirst t++testEnd :: Test+testEnd = testCase "token end" $ do+  assertEqual "TEST 1"+    (Just $ TEnd "abc") $+    runST $ do+      t <- tokenBuffer+      tokenTagEndInit t+      tokenTagNameAppend (ctow 'a') t+      tokenTagNameAppend (ctow 'b') t+      tokenTagNameAppend (ctow 'c') t+      packFirst t++testComment :: Test+testComment = testCase "token comment" $ do+  assertEqual "TEST 1"+    (Just $ TComment "abc") $+    runST $ do+      t <- tokenBuffer+      tokenCommentInit t+      tokenCommentAppend (ctow 'a') t+      tokenCommentAppend (ctow 'b') t+      tokenCommentAppend (ctow 'c') t+      packFirst t++testChar :: Test+testChar = testCase "token char" $ do+  assertEqual "TEST 1"+    (Just $ TChar $ ctow 'a') $+    runST $ do+      t <- tokenBuffer+      tokenCharInit (ctow 'a') t+      packFirst t++testEof :: Test+testEof = testCase "token eof" $ do+  assertEqual "TEST 1"+    (Just TEOF) $+    runST $ do+      t <- tokenBuffer+      tokenEOFInit t+      packFirst t+  assertEqual "TEST 2"+    True $+    runST $ do+      t <- tokenBuffer+      tokenEOFInit t+      tokenHasEOF t+  assertEqual "TEST 3"+    True $+    runST $ do+      t <- tokenBuffer+      tokenCommentInit t+      tokenTagStartInit t+      tokenTagStartInit t+      tokenEOFInit t+      tokenHasEOF t+  assertEqual "TEST 4"+    False $+    runST $ do+      t <- tokenBuffer+      tokenCommentInit t+      tokenTagStartInit t+      tokenTagStartInit t+      tokenHasEOF t++testCount :: Test+testCount = testCase "token count" $ do+  assertEqual "TEST 1" 0 $+    runST $ do+      t <- tokenBuffer+      tokenCount t+  assertEqual "TEST 2" 1 $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenCount t+  assertEqual "TEST 3" 8 $+    runST $ do+      t <- tokenBuffer+      tokenDoctypeInit t+      tokenTagStartInit t+      tokenTagEndInit t+      tokenTagStartInit t+      tokenTagEndInit t+      tokenCommentInit t+      tokenCharInit (ctow 'a') t+      tokenEOFInit t+      tokenCount t++testOffset :: Test+testOffset = testCase "token offset" $ do+  assertEqual "TEST 1" [] $+    runST $ do+      t <- tokenBuffer+      tokenOffset t+  assertEqual "TEST 2" [4] $+    runST $ do+      t <- tokenBuffer+      tag t "p"+      tokenOffset t+  assertEqual "TEST 3" [4,10] $+    runST $ do+      t <- tokenBuffer+      tag t "p"+      tag t "div"+      tokenOffset t+  assertEqual "TEST 4" [4,10,16] $+    runST $ do+      t <- tokenBuffer+      tag t "p"+      tag t "div"+      tag t "a"+      tokenOffset t+  where+    tag t x = do+      tokenTagStartInit t+      mapM_ (flip tokenTagNameAppend t) $ bsUnpack x++testDrop :: Test+testDrop = testCase "token drop" $ do+  assertEqual "TEST 1" ["p", "div"] $+    runST $ do+      t <- tokenBuffer+      tag t "p"+      tag t "div"+      tag t "a"+      tokenDrop t+      tokenOffset t >>= mapM (f t)+  assertEqual "TEST 2" ["p"] $+    runST $ do+      t <- tokenBuffer+      tag t "p"+      tag t "div"+      tag t "a"+      tokenDrop t+      tokenDrop t+      tokenOffset t >>= mapM (f t)+  assertEqual "TEST 3" [] $+    runST $ do+      t <- tokenBuffer+      tag t "p"+      tag t "div"+      tag t "a"+      tokenDrop t+      tokenDrop t+      tokenDrop t+      tokenOffset t >>= mapM (f t)+  assertEqual "TEST 4" ["div"] $+    runST $ do+      t <- tokenBuffer+      tag t "p"+      tokenDrop t+      tag t "div"+      tag t "a"+      tokenDrop t+      tokenOffset t >>= mapM (f t)+  assertEqual "TEST 5" [] $+    runST $ do+      t <- tokenBuffer+      tokenDrop t+      tokenOffset t >>= mapM (f t)+  assertEqual "TEST 6" [] $+    runST $ do+      t <- tokenBuffer+      tag t "p"+      tokenDrop t+      tokenOffset t >>= mapM (f t)+  where+    tag t x = do+      tokenTagStartInit t+      mapM_ (flip tokenTagNameAppend t) $ bsUnpack x+    f t x =+      tokenTagStartName x t >>= pure . maybe bsEmpty bsPack++testSize :: Test+testSize = testCase "token size" $ do+  assertEqual "TEST 1" Nothing $+    runST $ do+      t <- tokenBuffer+      sizeFirst t+  assertEqual "TEST 2" (Just 11) $+    runST $ do+      t <- tokenBuffer+      tokenDoctypeInit t+      sizeFirst t+  assertEqual "TEST 3" (Just 4) $+    runST $ do+      t <- tokenBuffer+      tokenTagEndInit t+      sizeFirst t+  assertEqual "TEST 4" (Just 4) $+    runST $ do+      t <- tokenBuffer+      tokenCommentInit t+      sizeFirst t+  assertEqual "TEST 5" (Just 3) $+    runST $ do+      t <- tokenBuffer+      tokenCharInit (ctow 'a') t+      sizeFirst t+  assertEqual "TEST 6" (Just 2) $+    runST $ do+      t <- tokenBuffer+      tokenEOFInit t+      sizeFirst t+  assertEqual "TEST 7" (Just 6) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      sizeFirst t+  assertEqual "TEST 8" (Just 10) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenAttrInit t+      sizeFirst t+  assertEqual "TEST 9" (Just 26) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenAttrInit t+      tokenAttrInit t+      tokenAttrInit t+      tokenAttrInit t+      tokenAttrInit t+      sizeFirst t++testEmit :: Test+testEmit = testCase "token emit" $ do+  assertEqual "TEST 1" ["a","b","c","d","e","f"] $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'a') t+      tokenAttrInit t+      tokenTagEndInit t+      tokenTagNameAppend (ctow 'b') t+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'c') t+      tokenAttrInit t+      tokenTagEndInit t+      tokenTagNameAppend (ctow 'd') t+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'e') t+      tokenAttrInit t+      tokenTagEndInit t+      tokenTagNameAppend (ctow 'f') t+      a <- tokenList t+      pure $ map tokenName a++testIter :: Test+testIter = testCase "token iter" $ do+  assertEqual "TEST 1" 0 $+    runST $ do+      tokenBuffer >>= tokenFirst+  assertEqual "TEST 2" 0 $+    runST $ do+      tokenBuffer >>= tokenNext++testCapacity :: Test+testCapacity = testCase "token capacity" $ do+  assertEqual "TEST 1" (100,100) $+    runST $ do+      t <- tokenBuffer+      tokenCapacity t+  assertEqual "TEST 2" (3200,25600) $+    runST $ do+      t <- tokenBuffer+      forM_ [1..200] $ const $ addToken t+      tokenCapacity t+  where+    addToken t = do+      tokenTagStartInit t+      forM_ [1..10] $ const $+        tokenTagNameAppend (ctow 'a') t+      tokenAttrInit t+      forM_ [1..10] $ const $+        tokenAttrNameAppend (ctow 'b') t+      forM_ [1..40] $ const $+        tokenAttrValAppend (ctow 'c') t+      tokenTagEndInit t+      forM_ [1..5] $ const $+        tokenTagNameAppend (ctow 'x') t++testStartName :: Test+testStartName = testCase "token start name" $ do+  assertEqual "TEST 1" [Just "p", Just "a", Nothing, Just "div"] $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'p') t+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'a') t+      tokenTagEndInit t+      tokenTagNameAppend (ctow 'a') t+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'd') t+      tokenTagNameAppend (ctow 'i') t+      tokenTagNameAppend (ctow 'v') t+      tokenOffset t >>= mapM (f t)+  assertEqual "TEST 2" (Just "i") $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'i') t+      tokenTail t >>= f t+  where+    f t x =+      tokenTagStartName x t >>= pure . maybe Nothing (Just . bsPack)++testEndName :: Test+testEndName = testCase "token end name" $ do+  assertEqual "TEST 1" (Just "b") $+    runST $ do+      t <- tokenBuffer+      tokenTagEndInit t+      tokenTagNameAppend (ctow 'b') t+      tokenTail t >>= f t+  where+    f t x =+      tokenTagEndName x t >>= pure . maybe Nothing (Just . bsPack)++testPrune :: Test+testPrune = testCase "token prune" $ do+  assertEqual "TEST 1"+    (True, Just $ TStart "div" False+      [ tokenAttr "id" "menu"+      , tokenAttr "hidden" ""+      , tokenAttr "data" "http"+      ]) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'd') t+      tokenTagNameAppend (ctow 'i') t+      tokenTagNameAppend (ctow 'v') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'i') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrValAppend (ctow 'm') t+      tokenAttrValAppend (ctow 'e') t+      tokenAttrValAppend (ctow 'n') t+      tokenAttrValAppend (ctow 'u') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'h') t+      tokenAttrNameAppend (ctow 'i') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrNameAppend (ctow 'e') t+      tokenAttrNameAppend (ctow 'n') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrNameAppend (ctow 'a') t+      tokenAttrNameAppend (ctow 't') t+      tokenAttrNameAppend (ctow 'a') t+      tokenAttrValAppend (ctow 'h') t+      tokenAttrValAppend (ctow 't') t+      tokenAttrValAppend (ctow 't') t+      tokenAttrValAppend (ctow 'p') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrNameAppend (ctow 'a') t+      tokenAttrNameAppend (ctow 't') t+      tokenAttrNameAppend (ctow 'a') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'i') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrValAppend (ctow 'x') t+      i <- tokenTail t+      a <- tokenAttrNamePrune i t+      b <- packFirst t+      pure (a, b)+  assertEqual "TEST 2"+    (False, Just $ TStart "div" False+      [ tokenAttr "id" "1"+      ]) $+    runST $ do+      t <- tokenBuffer+      tokenTagStartInit t+      tokenTagNameAppend (ctow 'd') t+      tokenTagNameAppend (ctow 'i') t+      tokenTagNameAppend (ctow 'v') t+      tokenAttrInit t+      tokenAttrNameAppend (ctow 'i') t+      tokenAttrNameAppend (ctow 'd') t+      tokenAttrValAppend (ctow '1') t+      tokenAttrInit t+      i <- tokenTail t+      a <- tokenAttrNamePrune i t+      b <- packFirst t+      pure (a, b)++packFirst t = do+  i <- tokenFirst t+  if i == 0+     then pure Nothing+     else Just <$> tokenPack i t++sizeFirst t = do+  i <- tokenFirst t+  if i == 0+     then pure Nothing+     else Just <$> tokenSize i t++tokenName (TStart n _ _) = n+tokenName (TEnd n) = n+tokenName _ = ""
+ test/Zenacy/HTML/Internal/Trie/Tests.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}++module Zenacy.HTML.Internal.Trie.Tests+  ( testTrie+  ) where++import qualified Zenacy.HTML.Internal.Trie as Trie+import Control.Monad+  ( (>=>)+  )+import Control.Monad.Writer+  ( Writer(..)+  , execWriter+  , tell+  )+import Data.Maybe+  ( fromJust+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( concat+  )++testTrie :: Test+testTrie = testGroup "Zenacy.HTML.Internal.Trie"+  [ testMatch+  ]++testMatch :: Test+testMatch = testCase "trie match" $ do+  assertEqual "TEST 1" Nothing $ Trie.match t0 "z"+  assertEqual "TEST 2" (Just ("a", 1, "")) $ Trie.match t0 "a"+  assertEqual "TEST 3" (Just ("a", 1, "y")) $ Trie.match t0 "ay"+  assertEqual "TEST 4" (Just ("bbb", 5, "yyy")) $ Trie.match t2 "bbbyyy"+  assertEqual "TEST 5" (Just ("ccc", 7, "yyy")) $ Trie.match t2 "cccyyy"+  assertEqual "TEST 6" Nothing $ Trie.match t1 "z"+  assertEqual "TEST 7" (Just ("aa", 1, "")) $ Trie.match t1 "aa"+  assertEqual "TEST 8" (Just ("bb", 2, "")) $ Trie.match t1 "bb"+  assertEqual "TEST 9" (Just ("a", 1, "z")) $ Trie.match t2 "az"+  assertEqual "TEST 10" (Just ("aa", 2, "z")) $ Trie.match t2 "aaz"+  assertEqual "TEST 11" (Just ("aaa", 3, "z")) $ Trie.match t2 "aaaz"+  assertEqual "TEST 12" (Just ("bb", 4, "z")) $ Trie.match t2 "bbz"+  assertEqual "TEST 13" (Just ("aaax", 6, "z")) $ Trie.match t2 "aaaxz"++t0 = Trie.fromList+  [ ("a", 1)+  ]++t1 = Trie.fromList+  [ ("aa", 1)+  , ("bb", 2)+  ]++t2 = Trie.fromList+  [ ("a",    1)+  , ("aa",   2)+  , ("aaa",  3)+  , ("bb",   4)+  , ("bbb",  5)+  , ("aaax", 6)+  , ("ccc",  7)+  ]
+ test/Zenacy/HTML/Internal/Zip/Tests.hs view
@@ -0,0 +1,503 @@+{-# LANGUAGE OverloadedStrings #-}++module Zenacy.HTML.Internal.Zip.Tests+  ( testZip+  ) where++import Zenacy.HTML+import Control.Monad+  ( (>=>)+  )+import Control.Monad.Writer+  ( Writer+  , execWriter+  , tell+  )+import Data.Maybe+  ( fromJust+  )+import Test.Framework+  ( Test+  , testGroup+  )+import Test.Framework.Providers.HUnit+  ( testCase+  )+import Test.HUnit+  ( assertBool+  , assertEqual+  , assertFailure+  )+import Data.Text+  ( Text+  )+import qualified Data.Text as T+  ( concat+  )++testZip :: Test+testZip = testGroup "Zenacy.HTML.Internal.Zip"+  [ testFind+  , testFirst+  , testLast+  , testParent+  , testRoot+  , testModify+  , testDelete+  , testNext+  , testPrev+  , testGet+  , testInsertBefore+  , testInsertAfter+  , testUnzip+  , testStep+  , testSearch+  , testContentLeft+  , testContentRight+  , testDropLeft+  , testDropRight+  , testPruneLeft+  , testPruneRight+  , testIndex+  , testPath+  , testPathFind+  , testTest+  , testIterModify+  ]++h :: HTMLNode+h = htmlParseEasy "<h1></h1><p><a href='bbb'>AAA</a><span></span><br><img></p>"++z :: HTMLZipper+z = htmlZip h++f :: Text -> HTMLZipper -> Maybe HTMLZipper+f x = htmlZipFind $ htmlElemHasName x++n :: HTMLZipper -> Text+n = htmlElementName . htmlZipNode++g :: HTMLZipper -> Maybe Text+g = Just . n++testFind :: Test+testFind = testCase "zip find" $ do+  assertEqual "TEST 1" (Just "html")+    ((f "html" >=> g) z)+  assertEqual "TEST 2" (Just "body")+    ((f "html" >=> f "body" >=> g) z)+  assertEqual "TEST 3" (Just "h1")+    ((f "html" >=> f "body" >=> f "h1" >=> g) z)+  assertEqual "TEST 4" (Just "p")+    ((f "html" >=> f "body" >=> f "p" >=> g) z)+  assertEqual "TEST 5" (Just "a")+    ((f "html" >=> f "body" >=> f "p" >=> f "a" >=> g) z)+  assertEqual "TEST 6" (Just "span")+    ((f "html" >=> f "body" >=> f "p" >=> f "span" >=> g) z)+  assertEqual "TEST 7" (Just "br")+    ((f "html" >=> f "body" >=> f "p" >=> f "br" >=> g) z)+  assertEqual "TEST 8" (Just "img")+    ((f "html" >=> f "body" >=> f "p" >=> f "img" >=> g) z)+  assertEqual "TEST 9" Nothing+    ((f "x" >=> g) z)++testFirst :: Test+testFirst = testCase "zip first" $ do+  assertEqual "TEST 1" (Just "h1") $+    (f "html" >=> f "body" >=> htmlZipFirst >=> g) z+  assertEqual "TEST 2" (Just "a") $+    (f "html" >=> f "body" >=> f "p" >=> htmlZipFirst >=> g) z++testLast :: Test+testLast = testCase "zip last" $ do+  assertEqual "TEST 1" (Just "p") $+    (f "html" >=> f "body" >=> htmlZipLast >=> g) z+  assertEqual "TEST 2" (Just "img") $+    (f "html" >=> f "body" >=> f "p" >=> htmlZipLast >=> g) z++testParent :: Test+testParent = testCase "zip parent" $ do+  let p = htmlZipParent+  let q = f "html" >=> f "body" >=> f "p" >=> f "br"+  assertEqual "TEST 1" (Just "p") $ (q >=> p >=> g) z+  assertEqual "TEST 2" (Just "body") $ (q >=> p >=> p >=> g) z+  assertEqual "TEST 3" (Just "html") $ (q >=> p >=> p >=> p >=> g) z++testRoot :: Test+testRoot = testCase "zip root" $ do+  case (f "html" >=> f "body" >=> f "p" >=> f "br") z of+    Nothing ->+      assertFailure "TEST 1"+    Just z' ->+      case htmlZipNode (htmlZipRoot z') of+        HTMLDocument {} ->+          assertBool "TEST 2" True+        _ ->+          assertFailure "TEST 3"++testModify :: Test+testModify = testCase "zip modify" $ do+  case (f "html" >=> f "body" >=> f "h1") z of+    Nothing ->+      assertFailure "TEST 1"+    Just z' -> do+      let r y = htmlZipModify (\x -> x { htmlElementName = y })+      assertEqual "TEST 2" "h1" $ n z'+      assertEqual "TEST 3" "h2" $ n $ r "h2" z'++testDelete :: Test+testDelete = testCase "zip delete" $ do+  let q = f "html" >=> f "body" >=> htmlZipDelete+  let h' = htmlUnzip $ fromJust $ q z+  assertEqual "TEST 1" "<html><head></head></html>" $ htmlRender h'++testNext :: Test+testNext = testCase "zip next" $ do+  let t = htmlZipNext+  let q = f "html" >=> f "body" >=> f "p" >=> htmlZipFirst+  assertEqual "TEST 1" (Just "a") $+    (q >=> g) z+  assertEqual "TEST 2" (Just "span") $+    (q >=> t >=> g) z+  assertEqual "TEST 3" (Just "br") $+    (q >=> t >=> t >=> g) z+  assertEqual "TEST 4" (Just "img") $+    (q >=> t >=> t >=> t >=> g) z+  assertEqual "TEST 5" Nothing $+    (q >=> t >=> t >=> t >=> t >=> g) z++testPrev :: Test+testPrev = testCase "zip prev" $ do+  let t = htmlZipPrev+  let q = f "html" >=> f "body" >=> f "p" >=> htmlZipLast+  assertEqual "TEST 1" (Just "img") $+    (q >=> g) z+  assertEqual "TEST 2" (Just "br") $+    (q >=> t >=> g) z+  assertEqual "TEST 3" (Just "span") $+    (q >=> t >=> t >=> g) z+  assertEqual "TEST 4" (Just "a") $+    (q >=> t >=> t >=> t >=> g) z+  assertEqual "TEST 5" Nothing $+    (q >=> t >=> t >=> t >=> t >=> g) z++testGet :: Test+testGet = testCase "zip get" $ do+  let q = f "html" >=> f "body" >=> f "p"+  assertEqual "TEST 1" (Just "a") $+    (q >=> htmlZipGet 0 >=> g) z+  assertEqual "TEST 2" (Just "span") $+    (q >=> htmlZipGet 1 >=> g) z+  assertEqual "TEST 3" (Just "br") $+    (q >=> htmlZipGet 2 >=> g) z+  assertEqual "TEST 4" (Just "img") $+    (q >=> htmlZipGet 3 >=> g) z+  assertEqual "TEST 5" Nothing $+    (q >=> htmlZipGet 4 >=> g) z++testInsertBefore :: Test+testInsertBefore = testCase "zip insert before" $ do+  let q = f "html" >=> f "body" >=> htmlZipLast+  let e = htmlDefaultElement { htmlElementName = "h2" }+  assertEqual "TEST 1" (Just "h2") $+    (q >=> htmlZipInsertBefore e >=> htmlZipPrev >=> g) z++testInsertAfter :: Test+testInsertAfter = testCase "zip insert after" $ do+  let q = f "html" >=> f "body" >=> htmlZipFirst+  let e = htmlDefaultElement { htmlElementName = "h2" }+  assertEqual "TEST 1" (Just "h2") $+    (q >=> htmlZipInsertAfter e >=> htmlZipNext >=> g) z++testUnzip :: Test+testUnzip = testCase "zip unzip" $ do+  let q = f "html" >=> f "body" >=> f "p" >=> f "a" >=>+          pure . htmlZipModify (htmlElemAttrRemove "href")+  let h' = htmlUnzip $ fromJust $ q z+  assertEqual "TEST 1"+    "<html><head></head><body>\+    \<h1></h1><p><a>AAA</a><span></span><br><img></p>\+    \</body></html>" $+    htmlRender h'++testStep :: Test+testStep = testCase "zip step" $ do+  assertEqual "TEST 1"+    ["html","head","body","h1","p","a","span","br","img",+     "div","p","span","a","img"]+    $ w htmlZipStepNext+  assertEqual "TEST 2"+    ["html","body","div","p","span","img","a","p",+     "img","br","span","a","h1","head"]+    $ w htmlZipStepBack+  where+    w h' = execWriter $ f h' z+    f :: (HTMLZipper -> Maybe HTMLZipper) -> HTMLZipper -> Writer [Text] HTMLZipper+    f h z' = case h z' of+      Nothing -> return z'+      Just x -> tell [n x] >> f h x+    z = htmlZip $ htmlParseEasy $ T.concat+        [ "<h1></h1>"+        , "<p><a></a><span></span><br><img></p>"+        , "<div><p><span><a></a><img></span></p></div>"+        ]++testSearch :: Test+testSearch = testCase "zip search" $ do+  assertEqual "TEST 201" "h1"   $ fa (t "h1")+  assertEqual "TEST 202" "a"    $ fa (i "1")+  assertEqual "TEST 203" "a"    $ fa (i "2")+  assertEqual "TEST 204" "span" $ fa (t "span")+  assertEqual "TEST 205" "h1"   $ fa (i "3")+  assertEqual "TEST 206" "h1"   $ ba (t "h1")+  assertEqual "TEST 207" "a"    $ ba (i "1")+  assertEqual "TEST 208" "a"    $ ba (i "2")+  assertEqual "TEST 209" "span" $ ba (t "span")+  assertEqual "TEST 210" "h1"   $ ba (i "3")+  assertEqual "TEST 211" "img"  $ ba (i "8")+  assertEqual "TEST 212" "img"  $ fa (i "8")++  assertEqual "TEST 301" "h1" $+    m $ (sf (i "8") >=> sb (i "3")) z+  assertEqual "TEST 302" "span" $+    m $ (sf (i "8") >=> ib (i "7")) z+  assertEqual "TEST 303" "img" $+    m $ (sf (t "img") >=> sf (t "img")) z+  where+    sf = htmlZipSearch htmlZipStepNext+    sb = htmlZipSearch htmlZipStepBack+    fa h = m $ sf h z+    ba h = m $ sb h z++    ib :: (HTMLZipper -> Bool) -> HTMLZipper -> Maybe HTMLZipper+    ib f = htmlIterSearch htmlIterBack f . htmlIter >=> Just . htmlIterZipper++    i x = htmlElemHasAttrVal "id" x . htmlZipNode+    t x = htmlElemHasName x . htmlZipNode+    m = maybe "" n+    z = htmlZip+      . htmlParseEasy+      . T.concat+      $ [ "<div id='4'></div>"+        , "<h1 id='3'></h1>"+        , "<p><a id='1'></a><span></span><br><img></p>"+        , "<div><p><span id='7'><a id='2'></a><img id='8'></span></p></div>"+        ]++testContentLeft :: Test+testContentLeft = testCase "zip content left" $ do+  let q x = f "html" >=> f "body" >=> f "p" >=> f x >=> pure . htmlZipContentLeft+  let r x = map htmlElemName $ fromJust $ q x z+  assertEqual "TEST 1" [] $ r "a"+  assertEqual "TEST 2" ["a"] $ r "span"+  assertEqual "TEST 3" ["a","span"] $ r "br"+  assertEqual "TEST 4" ["a","span","br"] $ r "img"++testContentRight :: Test+testContentRight = testCase "zip content right" $ do+  let q x = f "html" >=> f "body" >=> f "p" >=> f x >=> pure . htmlZipContentRight+  let r x = map htmlElemName $ fromJust $ q x z+  assertEqual "TEST 1" ["span","br","img"] $ r "a"+  assertEqual "TEST 2" ["br","img"] $ r "span"+  assertEqual "TEST 3" ["img"] $ r "br"+  assertEqual "TEST 4" [] $ r "img"++testDropLeft :: Test+testDropLeft = testCase "zip drop left" $ do+  let q x = f "html" >=> f "body" >=> f "p" >=> f x >=> htmlZipDropLeft+  let r x = htmlRender $ htmlUnzip $ fromJust $ q x $ z+  assertEqual "TEST 1"+    "<html><head></head><body>\+    \<h1></h1><p><a href=\"bbb\">AAA</a><span></span><br><img></p>\+    \</body></html>" $+    r "a"+  assertEqual "TEST 2"+    "<html><head></head><body>\+    \<h1></h1><p><span></span><br><img></p>\+    \</body></html>" $+    r "span"+  assertEqual "TEST 3"+    "<html><head></head><body>\+    \<h1></h1><p><br><img></p>\+    \</body></html>" $+    r "br"+  assertEqual "TEST 4"+    "<html><head></head><body>\+    \<h1></h1><p><img></p>\+    \</body></html>" $+    r "img"++testDropRight :: Test+testDropRight = testCase "zip drop right" $ do+  let q x = f "html" >=> f "body" >=> f "p" >=> f x >=> htmlZipDropRight+  let r x = htmlRender $ htmlUnzip $ fromJust $ q x $ z+  assertEqual "TEST 1"+    "<html><head></head><body>\+    \<h1></h1><p><a href=\"bbb\">AAA</a></p>\+    \</body></html>" $+    r "a"+  assertEqual "TEST 2"+    "<html><head></head><body>\+    \<h1></h1><p><a href=\"bbb\">AAA</a><span></span></p>\+    \</body></html>" $+    r "span"+  assertEqual "TEST 3"+    "<html><head></head><body>\+    \<h1></h1><p><a href=\"bbb\">AAA</a><span></span><br></p>\+    \</body></html>" $+    r "br"+  assertEqual "TEST 4"+    "<html><head></head><body>\+    \<h1></h1><p><a href=\"bbb\">AAA</a><span></span><br><img></p>\+    \</body></html>" $+    r "img"++testPruneLeft :: Test+testPruneLeft = testCase "zip prune left" $ do+  assertEqual "TEST 1"+    "<body><div><div><h1></h1><img></div><p></p></div></body>" $+    run $ f "div" >=> f "div" >=> f "h1" >=> htmlZipPruneLeft+  assertEqual "TEST 2"+    "<body><div><div><img></div><p></p></div></body>" $+    run $ f "div" >=> f "div" >=> f "img" >=> htmlZipPruneLeft+  assertEqual "TEST 3"+    "<body><div><p></p></div></body>" $+    run $ f "div" >=> htmlZipFirst >=> htmlZipNext >=> htmlZipNext+      >=> htmlZipPruneLeft+  where+    run g = htmlRender $ htmlUnzip $ fromJust $ g $ fromJust $+      (htmlZipM >=> f "html" >=> f "body" >=> htmlZipNodeM >=> htmlZipM) $+      htmlParseEasy+        "<div>\+        \<p></p>\+        \<div>\+        \<span></span><h1></h1><img>\+        \</div>\+        \<p></p>\+        \</div>"++testPruneRight :: Test+testPruneRight = testCase "zip prune right" $ do+  assertEqual "TEST 1"+    "<body><div><p></p><div><span></span><h1></h1></div></div></body>" $+    run $ f "div" >=> f "div" >=> f "h1" >=> htmlZipPruneRight+  assertEqual "TEST 2"+    "<body><div><p></p><div><span></span><h1></h1><img></div></div></body>" $+    run $ f "div" >=> f "div" >=> f "img" >=> htmlZipPruneRight+  assertEqual "TEST 3"+    "<body><div><p></p><div><span></span></div></div></body>" $+    run $ f "div" >=> f "div" >=> f "span" >=> htmlZipPruneRight+  assertEqual "TEST 4"+    "<body><div><p></p></div></body>" $+    run $ f "div" >=> htmlZipFirst >=> htmlZipPruneRight+  where+    run g = htmlRender $ htmlUnzip $ fromJust $ g $ fromJust $+      (htmlZipM >=> f "html" >=> f "body" >=> htmlZipNodeM >=> htmlZipM) $+      htmlParseEasy+        "<div>\+        \<p></p>\+        \<div>\+        \<span></span><h1></h1><img>\+        \</div>\+        \<p></p>\+        \</div>"++testIndex :: Test+testIndex = testCase "zip index" $ do+  assertEqual "TEST 1" (Just 0) $ g (i "1")+  assertEqual "TEST 2" (Just 0) $ g (i "2")+  assertEqual "TEST 3" (Just 1) $ g (i "8")+  assertEqual "TEST 4" (Just 1) $ g (i "3")+  assertEqual "TEST 4" (Just 0) $ g (i "4")+  assertEqual "TEST 5" (Just 3) $ g (i "5")+  where+    g f = maybe Nothing htmlZipIndex $ htmlZipSearch htmlZipStepNext f z+    i x = htmlElemHasAttrVal "id" x . htmlZipNode+    z = htmlZip+      . htmlParseEasy+      . T.concat+      $ [ "<div id='4'></div>"+        , "<h1 id='3'></h1>"+        , "<p><a id='1'></a><span></span><br><img id='5'></p>"+        , "<div><p><span id='7'><a id='2'></a><img id='8'></span></p></div>"+        ]++testPath :: Test+testPath = testCase "zip path" $ do+  assertEqual "TEST 1" (m [0,1,2,0]) $ g (i "1")+  assertEqual "TEST 2" (m [0,1,3,0,0,0]) $ g (i "2")+  assertEqual "TEST 3" (m [0,1,3,0,0,1]) $ g (i "8")+  assertEqual "TEST 4" (m [0,1,1]) $ g (i "3")+  assertEqual "TEST 4" (m [0,1,0]) $ g (i "4")+  assertEqual "TEST 5" (m [0,1,2,3]) $ g (i "5")+  where+    m = Just . HTMLZipPath+    g f = maybe Nothing (Just . htmlZipPath) $ htmlZipSearch htmlZipStepNext f z+    i x = htmlElemHasAttrVal "id" x . htmlZipNode+    z = htmlZip+      . htmlParseEasy+      . T.concat+      $ [ "<div id='4'></div>"+        , "<h1 id='3'></h1>"+        , "<p><a id='1'></a><span></span><br><img id='5'></p>"+        , "<div><p><span id='7'><a id='2'></a><img id='8'></span></p></div>"+        ]++testPathFind :: Test+testPathFind = testCase "zip path find" $ do+  assertEqual "TEST 1" (Just "a")    $ f [0,1,2,0]+  assertEqual "TEST 2" (Just "span") $ f [0,1,2,1]+  assertEqual "TEST 3" (Just "span") $ f [0,1,3,0,0]+  assertEqual "TEST 4" (Just "a")    $ f [0,1,3,0,0,0]+  assertEqual "TEST 5" (Just "img")  $ f [0,1,3,0,0,1]+  where+    f p = htmlZipPathFind (HTMLZipPath p) z >>= g+    z = htmlZip+      . htmlParseEasy+      . T.concat+      $ [ "<div id='4'></div>"+        , "<h1 id='3'></h1>"+        , "<p><a id='1'></a><span></span><br><img id='5'></p>"+        , "<div><p><span id='7'><a id='2'></a><img id='8'></span></p></div>"+        ]++testTest :: Test+testTest = testCase "zip test" $ do+  assertEqual "TEST 1" (Just True)+    ((name "body" >=> frst >=> name "h1" >=> next >=> name "p" >=> tlst >=> s) z')+  assertEqual "TEST 2" (Nothing)+    ((name "body" >=> frst >=> name "h1" >=> next >=> name "a" >=> tlst >=> s) z')+  assertEqual "TEST 3" (Nothing)+    ((name "body" >=> frst >=> name "h1" >=> next >=> name "p" >=> tfst >=> s) z')+  assertEqual "TEST 4" (Just "h1") $+    htmlZipM b >>=+    htmlZipTestName "body" >>=+    htmlZipFirst >>=+    htmlZipTestName "h1" >>= \n0 ->+    htmlZipNext n0 >>=+    htmlZipTestName "p" >>=+    htmlZipTestLast >>+    pure (htmlElemName $ htmlZipNode n0)+  where+    b = fromJust $ htmlDocBody h+    z' = htmlZip b+    frst = htmlZipFirst+    next = htmlZipNext+    tfst = htmlZipTestFirst+    tlst = htmlZipTestLast+    name = htmlZipTestName+    s = const $ pure True++testIterModify :: Test+testIterModify = testCase "zip iter modify" $ do+  assertEqual "TEST 1" n' (f' b')+  where+    b' = fromJust $ htmlDocBody h+    n' = "newname"+    f' = ( htmlElemName+        . htmlUnzip+        . htmlIterZipper+        . htmlIterModify (htmlZipModify (htmlElemRename n'))+        . htmlIter+        . htmlZip+        )
+ zenacy-html.cabal view
@@ -0,0 +1,185 @@+cabal-version: >= 1.10+name:+  zenacy-html+version:+  2.0.0+synopsis:+  A standard compliant HTML parsing library+description:+  Zenacy HTML is an HTML parsing and processing library that implements the+  WHATWG HTML parsing standard.  The standard is described as a state machine+  that this library implements exactly as spelled out including all the error+  handling, recovery, and conformance checks that makes it robust in handling+  any HTML pulled from the web.  In addition to parsing, the library provides+  many processing features to help extract information from web pages or+  rewrite them and render the modified results.+homepage:+  https://github.com/mlcfp/zenacy-html+license:+  MIT+license-file:+  LICENSE+author:+  Michael Williams <mlcfp@icloud.com>+maintainer:+  Michael Williams <mlcfp@icloud.com>+copyright:+  Copyright (C) 2015-2020 Michael P Williams+category:+  Web+build-type:+  Simple+extra-source-files:+  README.md CHANGES.md++source-repository head+  type:     git+  location: https://github.com/mlcfp/zenacy-html.git++library+  hs-source-dirs:+    src+  exposed-modules:+    Zenacy.HTML+    , Zenacy.HTML.Internal.BS+    , Zenacy.HTML.Internal.Buffer+    , Zenacy.HTML.Internal.Char+    , Zenacy.HTML.Internal.Core+    , Zenacy.HTML.Internal.DOM+    , Zenacy.HTML.Internal.Entity+    , Zenacy.HTML.Internal.Filter+    , Zenacy.HTML.Internal.HTML+    , Zenacy.HTML.Internal.Image+    , Zenacy.HTML.Internal.Lexer+    , Zenacy.HTML.Internal.Oper+    , Zenacy.HTML.Internal.Parser+    , Zenacy.HTML.Internal.Query+    , Zenacy.HTML.Internal.Render+    , Zenacy.HTML.Internal.Token+    , Zenacy.HTML.Internal.Trie+    , Zenacy.HTML.Internal.Types+    , Zenacy.HTML.Internal.Zip+  build-depends:+    base              == 4.*,+    bytestring        >= 0.10.6.0 && < 0.11,+    containers        >= 0.5.7.1 && < 0.7,+    data-default      >= 0.7.1.1 && < 0.8,+    dlist             >= 0.8 && < 0.9,+    extra             >= 1.4 && < 1.8,+    mtl               >= 2.1 && < 2.3,+    pretty-show       >= 1.6 && < 1.11,+    safe              >= 0.3.14 && < 0.4,+    safe-exceptions   >= 0.1.5.0 && < 0.2,+    text              >= 1.2.2.0 && < 1.3,+    transformers      >= 0.5.2 && < 0.6,+    vector            >= 0.11 && < 0.13,+    word8             >= 0.1.2 && < 0.2++  ghc-options:+    -O3 -Wall+    -Wno-name-shadowing+    -Wno-unused-matches+    -Wno-unused-local-binds+    -Wno-unused-imports+    -Wno-unused-top-binds+    -Wno-incomplete-patterns+  default-extensions:+  default-language:+    Haskell2010++executable zenacy-html-exe+  hs-source-dirs:+    app+  main-is:+    Main.hs+  other-modules:+  ghc-options:+    -O3 -Wall+    -Wno-name-shadowing+    -Wno-unused-matches+    -Wno-unused-local-binds+    -Wno-unused-imports+    -Wno-unused-top-binds+    -Wno-incomplete-patterns+    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    base == 4.*+    , bytestring+    , containers+    , data-default+    , dlist+    , extra+    , pretty-show+    , text+    , vector+    , zenacy-html+  default-extensions:+  default-language:+    Haskell2010++test-suite zenacy-html-test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    TestSuite.hs+  build-depends:+    base == 4.*+    , bytestring+    , containers+    , data-default+    , dlist+    , extra+    , HUnit+    , mtl+    , pretty-show+    , raw-strings-qq+    , test-framework+    , test-framework-hunit+    , text+    , transformers+    , zenacy-html+  default-extensions:+  ghc-options:+    -O3 -threaded -rtsopts -with-rtsopts=-N+  default-language:+    Haskell2010+  other-modules:+    Zenacy.HTML.Internal.Buffer.Tests+    , Zenacy.HTML.Internal.Entity.Tests+    , Zenacy.HTML.Internal.HTML.Tests+    , Zenacy.HTML.Internal.Image.Tests+    , Zenacy.HTML.Internal.Lexer.Tests+    , Zenacy.HTML.Internal.Oper.Tests+    , Zenacy.HTML.Internal.Parser.Tests+    , Zenacy.HTML.Internal.Query.Tests+    , Zenacy.HTML.Internal.Token.Tests+    , Zenacy.HTML.Internal.Trie.Tests+    , Zenacy.HTML.Internal.Zip.Tests+    , Samples++benchmark zenacy-html-bench+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    bench+  main-is:+    BenchMain.hs+  build-depends:+    base == 4.*+    , bytestring+    , containers+    , data-default+    , dlist+    , criterion+    , pretty-show+    , raw-strings-qq+    , text+    , zenacy-html+  default-extensions:+  ghc-options:+    -O3 -threaded -rtsopts -with-rtsopts=-N+  default-language:+    Haskell2010+  other-modules: