zenacy-html 2.0.3 → 2.0.4
raw patch · 6 files changed
+173/−168 lines, 6 filesdep ~transformers
Dependency ranges changed: transformers
Files
- CHANGES.md +5/−0
- src/Zenacy/HTML/Internal/Lexer.hs +97/−97
- src/Zenacy/HTML/Internal/Parser.hs +67/−67
- src/Zenacy/HTML/Internal/Trie.hs +1/−1
- test/Samples.hs +1/−1
- zenacy-html.cabal +2/−2
CHANGES.md view
@@ -1,5 +1,10 @@ # Change Log +## 2.0.4++* Remove whitespace around @ patterns for GHC 9+* Upgrade transformers dependency+ ## 2.0.2 * Upgrade bytestring dependency
src/Zenacy/HTML/Internal/Lexer.hs view
@@ -437,7 +437,7 @@ -- | Gets the next token from a lexer. lexerNext :: Lexer s -> ST s Token-lexerNext x @ Lexer {..} =+lexerNext x@Lexer {..} = skip where skip = do@@ -468,7 +468,7 @@ -- | Gets the next word from a lexer. nextWord :: Lexer s -> ST s Word8-nextWord x @ Lexer {..} = do+nextWord Lexer {..} = do offset <- rref lexerOffset if | offset < bsLen lexerData -> do wref lexerOffset (offset + 1)@@ -478,7 +478,7 @@ -- | Gets the next word from a lexer without advancing. peekWord :: Lexer s -> ST s Word8-peekWord x @ Lexer {..} = do+peekWord Lexer {..} = do offset <- rref lexerOffset if | offset < bsLen lexerData -> pure $ bsIndex lexerData offset@@ -487,54 +487,54 @@ -- | Moves the lexer back one word. backWord :: Lexer s -> ST s ()-backWord x @ Lexer {..} = uref lexerOffset (subtract 1)+backWord Lexer {..} = uref lexerOffset (subtract 1) -- | Skips the specified number of words. skipWord :: Lexer s -> Int -> ST s ()-skipWord x @ Lexer {..} n = uref lexerOffset (+n)+skipWord 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+dataIndexer 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+dataRemain 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+emit 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+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+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+state Lexer {..} = wref lexerState -- | Sets the lexer return state. returnSet :: Lexer s -> LexerState -> ST s ()-returnSet x @ Lexer {..} = wref lexerReturn+returnSet x@Lexer {..} = wref lexerReturn -- | Gets the lexer return state. returnGet :: Lexer s -> ST s LexerState-returnGet x @ Lexer {..} = rref lexerReturn+returnGet x@Lexer {..} = rref lexerReturn -- | Switches to the return state. returnState :: Lexer s -> ST s ()@@ -542,19 +542,19 @@ -- | Handles parse errors. parseError :: Lexer s -> BS -> ST s ()-parseError x @ Lexer {..} =+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+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+consumingAttibute x@Lexer {..} = do a <- returnGet x pure $ any (==a) [ StateAttrValueDoubleQuoted@@ -564,7 +564,7 @@ -- | Flushes the code points stored in the buffer. flushCodePoints :: Lexer s -> ST s ()-flushCodePoints x @ Lexer {..} = do+flushCodePoints x@Lexer {..} = do a <- consumingAttibute x if | a -> do bufferApply (flip tokenAttrValAppend lexerToken) lexerBuffer@@ -574,7 +574,7 @@ -- 12.2.5.1 Data state doData :: Lexer s -> ST s ()-doData x @ Lexer {..} = do+doData x@Lexer {..} = do c <- nextWord x if | c == chrAmpersand -> do returnSet x StateData@@ -590,7 +590,7 @@ -- 12.2.5.2 RCDATA state doRCDATA :: Lexer s -> ST s ()-doRCDATA x @ Lexer {..} = do+doRCDATA x@Lexer {..} = do c <- nextWord x if | c == chrAmpersand -> do returnSet x StateRCDATA@@ -606,7 +606,7 @@ -- 12.2.5.3 RAWTEXT state doRAWTEXT :: Lexer s -> ST s ()-doRAWTEXT x @ Lexer {..} = do+doRAWTEXT x@Lexer {..} = do c <- nextWord x if | c == chrLess -> do doRAWTEXTLessThan x@@ -619,7 +619,7 @@ -- 12.2.5.4 Script data state doScriptData :: Lexer s -> ST s ()-doScriptData x @ Lexer {..} = do+doScriptData x@Lexer {..} = do c <- nextWord x if | c == chrLess -> do doScriptDataLessThan x@@ -632,7 +632,7 @@ -- 12.2.5.5 PLAINTEXT state doPLAINTEXT :: Lexer s -> ST s ()-doPLAINTEXT x @ Lexer {..} = do+doPLAINTEXT x@Lexer {..} = do c <- nextWord x if | c == chrEOF -> do tokenEOFInit lexerToken@@ -643,7 +643,7 @@ -- 12.2.5.6 Tag open state doTagOpen :: Lexer s -> ST s ()-doTagOpen x @ Lexer {..} = do+doTagOpen x@Lexer {..} = do c <- nextWord x if | c == chrExclamation -> do doMarkupDeclarationOpen x@@ -670,7 +670,7 @@ -- 12.2.5.7 End tag open state doEndTagOpen :: Lexer s -> ST s ()-doEndTagOpen x @ Lexer {..} = do+doEndTagOpen x@Lexer {..} = do c <- nextWord x if | chrASCIIAlpha c -> do tokenTagEndInit lexerToken@@ -693,7 +693,7 @@ -- 12.2.5.8 Tag name state doTagName :: Lexer s -> ST s ()-doTagName x @ Lexer {..} = do+doTagName x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -718,7 +718,7 @@ -- 12.2.5.9 RCDATA less-than sign state doRCDATALessThan :: Lexer s -> ST s ()-doRCDATALessThan x @ Lexer {..} = do+doRCDATALessThan x@Lexer {..} = do c <- nextWord x if | c == chrSolidus -> do bufferReset lexerBuffer@@ -730,7 +730,7 @@ -- 12.2.5.10 RCDATA end tag open state doRCDATAEndTagOpen :: Lexer s -> ST s ()-doRCDATAEndTagOpen x @ Lexer {..} = do+doRCDATAEndTagOpen x@Lexer {..} = do c <- nextWord x if | chrASCIIAlpha c -> do tokenTagEndInit lexerToken@@ -744,7 +744,7 @@ -- 12.2.5.11 RCDATA end tag name state doRCDATAEndTagName :: Lexer s -> ST s ()-doRCDATAEndTagName x @ Lexer {..} = do+doRCDATAEndTagName x@Lexer {..} = do c <- nextWord x a <- appropriateEndTag x if | c == chrTab ||@@ -790,7 +790,7 @@ -- 12.2.5.12 RAWTEXT less-than sign state doRAWTEXTLessThan :: Lexer s -> ST s ()-doRAWTEXTLessThan x @ Lexer {..} = do+doRAWTEXTLessThan x@Lexer {..} = do c <- nextWord x if | c == chrSolidus -> do bufferReset lexerBuffer@@ -802,7 +802,7 @@ -- 12.2.5.13 RAWTEXT end tag open state doRAWTEXTEndTagOpen :: Lexer s -> ST s ()-doRAWTEXTEndTagOpen x @ Lexer {..} = do+doRAWTEXTEndTagOpen x@Lexer {..} = do c <- nextWord x if | chrASCIIAlpha c -> do tokenTagEndInit lexerToken@@ -816,7 +816,7 @@ -- 12.2.5.14 RAWTEXT end tag name state doRAWTEXTEndTagName :: Lexer s -> ST s ()-doRAWTEXTEndTagName x @ Lexer {..} = do+doRAWTEXTEndTagName x@Lexer {..} = do c <- nextWord x a <- appropriateEndTag x if | c == chrTab ||@@ -862,7 +862,7 @@ -- 12.2.5.15 Script data less-than sign state doScriptDataLessThan :: Lexer s -> ST s ()-doScriptDataLessThan x @ Lexer {..} = do+doScriptDataLessThan x@Lexer {..} = do c <- nextWord x if | c == chrSolidus -> do bufferReset lexerBuffer@@ -878,7 +878,7 @@ -- 12.2.5.16 Script data end tag open state doScriptDataEndTagOpen :: Lexer s -> ST s ()-doScriptDataEndTagOpen x @ Lexer {..} = do+doScriptDataEndTagOpen x@Lexer {..} = do c <- nextWord x if | chrASCIIAlpha c -> do tokenTagEndInit lexerToken@@ -892,7 +892,7 @@ -- 12.2.5.17 Script data end tag name state doScriptDataEndTagName :: Lexer s -> ST s ()-doScriptDataEndTagName x @ Lexer {..} = do+doScriptDataEndTagName x@Lexer {..} = do c <- nextWord x a <- appropriateEndTag x if | c == chrTab ||@@ -938,7 +938,7 @@ -- 12.2.5.18 Script data escape start state doScriptDataEscapeStart :: Lexer s -> ST s ()-doScriptDataEscapeStart x @ Lexer {..} = do+doScriptDataEscapeStart x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do emitChar x chrHyphen@@ -949,7 +949,7 @@ -- 12.2.5.19 Script data escape start dash state doScriptDataEscapeStartDash :: Lexer s -> ST s ()-doScriptDataEscapeStartDash x @ Lexer {..} = do+doScriptDataEscapeStartDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do emitChar x chrHyphen@@ -960,7 +960,7 @@ -- 12.2.5.20 Script data escaped state doScriptDataEscaped :: Lexer s -> ST s ()-doScriptDataEscaped x @ Lexer {..} = do+doScriptDataEscaped x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do emitChar x chrHyphen@@ -977,7 +977,7 @@ -- 12.2.5.21 Script data escaped dash state doScriptDataEscapedDash :: Lexer s -> ST s ()-doScriptDataEscapedDash x @ Lexer {..} = do+doScriptDataEscapedDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do emitChar x chrHyphen@@ -994,7 +994,7 @@ -- 12.2.5.22 Script data escaped dash dash state doScriptDataEscapedDashDash :: Lexer s -> ST s ()-doScriptDataEscapedDashDash x @ Lexer {..} = do+doScriptDataEscapedDashDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do emitChar x c@@ -1014,7 +1014,7 @@ -- 12.2.5.23 Script data escaped less-than sign state doScriptDataEscapedLessThan :: Lexer s -> ST s ()-doScriptDataEscapedLessThan x @ Lexer {..} = do+doScriptDataEscapedLessThan x@Lexer {..} = do c <- nextWord x if | c == chrSolidus -> do bufferReset lexerBuffer@@ -1031,7 +1031,7 @@ -- 12.2.5.24 Script data escaped end tag open state doScriptDataEscapedEndTagOpen :: Lexer s -> ST s ()-doScriptDataEscapedEndTagOpen x @ Lexer {..} = do+doScriptDataEscapedEndTagOpen x@Lexer {..} = do c <- nextWord x if | chrASCIIAlpha c -> do tokenTagEndInit lexerToken@@ -1045,7 +1045,7 @@ -- 12.2.5.25 Script data escaped end tag name state doScriptDataEscapedEndTagName :: Lexer s -> ST s ()-doScriptDataEscapedEndTagName x @ Lexer {..} = do+doScriptDataEscapedEndTagName x@Lexer {..} = do c <- nextWord x a <- appropriateEndTag x if | c == chrTab ||@@ -1092,7 +1092,7 @@ -- 12.2.5.26 Script data double escape start state doScriptDataDoubleEscapedStart :: Lexer s -> ST s ()-doScriptDataDoubleEscapedStart x @ Lexer {..} = do+doScriptDataDoubleEscapedStart x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1123,7 +1123,7 @@ -- 12.2.5.27 Script data double escaped state doScriptDataDoubleEscaped :: Lexer s -> ST s ()-doScriptDataDoubleEscaped x @ Lexer {..} = do+doScriptDataDoubleEscaped x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do tokenCharInit c lexerToken@@ -1143,7 +1143,7 @@ -- 12.2.5.28 Script data double escaped dash state doScriptDataDoubleEscapedDash :: Lexer s -> ST s ()-doScriptDataDoubleEscapedDash x @ Lexer {..} = do+doScriptDataDoubleEscapedDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do tokenCharInit c lexerToken@@ -1164,7 +1164,7 @@ -- 12.2.5.29 Script data double escaped dash dash state doScriptDataDoubleEscapedDashDash :: Lexer s -> ST s ()-doScriptDataDoubleEscapedDashDash x @ Lexer {..} = do+doScriptDataDoubleEscapedDashDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do emitChar x c@@ -1188,7 +1188,7 @@ -- 12.2.5.30 Script data double escaped less-than sign state doScriptDataDoubleEscapedLessThan :: Lexer s -> ST s ()-doScriptDataDoubleEscapedLessThan x @ Lexer {..} = do+doScriptDataDoubleEscapedLessThan x@Lexer {..} = do c <- nextWord x if | c == chrSolidus -> do bufferReset lexerBuffer@@ -1201,7 +1201,7 @@ -- 12.2.5.31 Script data double escape end state doScriptDataDoubleEscapeEnd :: Lexer s -> ST s ()-doScriptDataDoubleEscapeEnd x @ Lexer {..} = do+doScriptDataDoubleEscapeEnd x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1230,7 +1230,7 @@ -- 12.2.5.32 Before attribute name state doBeforeAttrName :: Lexer s -> ST s ()-doBeforeAttrName x @ Lexer {..} = do+doBeforeAttrName x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1254,7 +1254,7 @@ -- 12.2.5.33 Attribute name state doAttrName :: Lexer s -> ST s ()-doAttrName x @ Lexer {..} = do+doAttrName x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1289,7 +1289,7 @@ -- 12.2.5.34 After attribute name state doAfterAttrName :: Lexer s -> ST s ()-doAfterAttrName x @ Lexer {..} = do+doAfterAttrName x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1314,7 +1314,7 @@ -- 12.2.5.35 Before attribute value state doBeforeAttrValue :: Lexer s -> ST s ()-doBeforeAttrValue x @ Lexer {..} = do+doBeforeAttrValue x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1335,7 +1335,7 @@ -- 12.2.5.36 Attribute value (double-quoted) state doAttrValueDoubleQuoted :: Lexer s -> ST s ()-doAttrValueDoubleQuoted x @ Lexer {..} = do+doAttrValueDoubleQuoted x@Lexer {..} = do c <- nextWord x if | c == chrQuote -> do doAfterAttrValue x@@ -1352,7 +1352,7 @@ -- 12.2.5.37 Attribute value (single-quoted) state doAttrValueSingleQuoted :: Lexer s -> ST s ()-doAttrValueSingleQuoted x @ Lexer {..} = do+doAttrValueSingleQuoted x@Lexer {..} = do c <- nextWord x if | c == chrApostrophe -> do doAfterAttrValue x@@ -1369,7 +1369,7 @@ -- 12.2.5.38 Attribute value (unquoted) state doAttrValueUnquoted :: Lexer s -> ST s ()-doAttrValueUnquoted x @ Lexer {..} = do+doAttrValueUnquoted x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1400,7 +1400,7 @@ -- 12.2.5.39 After attribute value (quoted) state doAfterAttrValue :: Lexer s -> ST s ()-doAfterAttrValue x @ Lexer {..} = do+doAfterAttrValue x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1423,7 +1423,7 @@ -- 12.2.5.40 Self-closing start tag state doSelfClosingStartTag :: Lexer s -> ST s ()-doSelfClosingStartTag x @ Lexer {..} = do+doSelfClosingStartTag x@Lexer {..} = do c <- nextWord x if | c == chrGreater -> do tokenTagStartSetSelfClosing lexerToken@@ -1440,7 +1440,7 @@ -- 12.2.5.41 Bogus comment state doBogusComment :: Lexer s -> ST s ()-doBogusComment x @ Lexer {..} = do+doBogusComment x@Lexer {..} = do c <- nextWord x if | c == chrGreater -> do state x StateData@@ -1454,7 +1454,7 @@ -- 12.2.5.42 Markup declaration open state doMarkupDeclarationOpen :: Lexer s -> ST s ()-doMarkupDeclarationOpen x @ Lexer {..} = do+doMarkupDeclarationOpen x@Lexer {..} = do f <- dataIndexer x n <- dataRemain x if | n > 1 &&@@ -1505,7 +1505,7 @@ -- 12.2.5.43 Comment start state doCommentStart :: Lexer s -> ST s ()-doCommentStart x @ Lexer {..} = do+doCommentStart x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do doCommentStartDash x@@ -1519,7 +1519,7 @@ -- 12.2.5.44 Comment start dash state doCommentStartDash :: Lexer s -> ST s ()-doCommentStartDash x @ Lexer {..} = do+doCommentStartDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do doCommentEnd x@@ -1538,7 +1538,7 @@ -- 12.2.5.45 Comment state doComment :: Lexer s -> ST s ()-doComment x @ Lexer {..} = do+doComment x@Lexer {..} = do c <- nextWord x if | c == chrLess -> do tokenCommentAppend c lexerToken@@ -1555,7 +1555,7 @@ -- 12.2.5.46 Comment less-than sign state doCommentLessThan :: Lexer s -> ST s ()-doCommentLessThan x @ Lexer {..} = do+doCommentLessThan x@Lexer {..} = do c <- nextWord x if | c == chrExclamation -> do tokenCommentAppend c lexerToken@@ -1569,7 +1569,7 @@ -- 12.2.5.47 Comment less-than sign bang state doCommentLessThanBang :: Lexer s -> ST s ()-doCommentLessThanBang x @ Lexer {..} = do+doCommentLessThanBang x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do doCommentLessThanBangDash x@@ -1579,7 +1579,7 @@ -- 12.2.5.48 Comment less-than sign bang dash state doCommentLessThanBangDash :: Lexer s -> ST s ()-doCommentLessThanBangDash x @ Lexer {..} = do+doCommentLessThanBangDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do doCommentLessThanBangDashDash x@@ -1589,7 +1589,7 @@ -- 12.2.5.49 Comment less-than sign bang dash dash state doCommentLessThanBangDashDash :: Lexer s -> ST s ()-doCommentLessThanBangDashDash x @ Lexer {..} = do+doCommentLessThanBangDashDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen || c == chrEOF -> do@@ -1602,7 +1602,7 @@ -- 12.2.5.50 Comment end dash state doCommentEndDash :: Lexer s -> ST s ()-doCommentEndDash x @ Lexer {..} = do+doCommentEndDash x@Lexer {..} = do c <- nextWord x if | c == chrHyphen -> do doCommentEnd x@@ -1617,7 +1617,7 @@ -- 12.2.5.51 Comment end state doCommentEnd :: Lexer s -> ST s ()-doCommentEnd x @ Lexer {..} = do+doCommentEnd x@Lexer {..} = do c <- nextWord x if | c == chrGreater -> do state x StateData@@ -1639,7 +1639,7 @@ -- 12.2.5.52 Comment end bang state doCommentEndBang :: Lexer s -> ST s ()-doCommentEndBang x @ Lexer {..} = do+doCommentEndBang x@Lexer {..} = do c <- nextWord x if | c == chrGreater -> do state x StateData@@ -1666,7 +1666,7 @@ -- 12.2.5.53 DOCTYPE state doDoctype :: Lexer s -> ST s ()-doDoctype x @ Lexer {..} = do+doDoctype x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1689,7 +1689,7 @@ -- 12.2.5.54 Before DOCTYPE name state doBeforeDoctypeName :: Lexer s -> ST s ()-doBeforeDoctypeName x @ Lexer {..} = do+doBeforeDoctypeName x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1719,7 +1719,7 @@ -- 12.2.5.55 DOCTYPE name state doDoctypeName :: Lexer s -> ST s ()-doDoctypeName x @ Lexer {..} = do+doDoctypeName x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1743,7 +1743,7 @@ -- 12.2.5.56 After DOCTYPE name state doAfterDoctypeName :: Lexer s -> ST s ()-doAfterDoctypeName x @ Lexer {..} = do+doAfterDoctypeName x@Lexer {..} = do c <- nextWord x -- Get data indexer after the character. f <- dataIndexer x@@ -1783,7 +1783,7 @@ -- 12.2.5.57 After DOCTYPE public keyword state doAfterDoctypePublicKeyword :: Lexer s -> ST s ()-doAfterDoctypePublicKeyword x @ Lexer {..} = do+doAfterDoctypePublicKeyword x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1815,7 +1815,7 @@ -- 12.2.5.58 Before DOCTYPE public identifier state doBeforeDoctypePublicId :: Lexer s -> ST s ()-doBeforeDoctypePublicId x @ Lexer {..} = do+doBeforeDoctypePublicId x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1845,7 +1845,7 @@ -- 12.2.5.59 DOCTYPE public identifier (double-quoted) state doDoctypePublicIdDoubleQuoted :: Lexer s -> ST s ()-doDoctypePublicIdDoubleQuoted x @ Lexer {..} = do+doDoctypePublicIdDoubleQuoted x@Lexer {..} = do c <- nextWord x if | c == chrQuote -> do doAfterDoctypePublicId x@@ -1865,7 +1865,7 @@ -- 12.2.5.60 DOCTYPE public identifier (single-quoted) state doDoctypePublicIdSingleQuoted :: Lexer s -> ST s ()-doDoctypePublicIdSingleQuoted x @ Lexer {..} = do+doDoctypePublicIdSingleQuoted x@Lexer {..} = do c <- nextWord x if | c == chrApostrophe -> do doAfterDoctypePublicId x@@ -1885,7 +1885,7 @@ -- 12.2.5.61 After DOCTYPE public identifier state doAfterDoctypePublicId :: Lexer s -> ST s ()-doAfterDoctypePublicId x @ Lexer {..} = do+doAfterDoctypePublicId x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1915,7 +1915,7 @@ -- 12.2.5.62 Between DOCTYPE public and system identifiers state doBetweenDoctypePublicAndSystem :: Lexer s -> ST s ()-doBetweenDoctypePublicAndSystem x @ Lexer {..} = do+doBetweenDoctypePublicAndSystem x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1943,7 +1943,7 @@ -- 12.2.5.63 After DOCTYPE system keyword state doAfterDoctypeSystemKeyword :: Lexer s -> ST s ()-doAfterDoctypeSystemKeyword x @ Lexer {..} = do+doAfterDoctypeSystemKeyword x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -1975,7 +1975,7 @@ -- 12.2.5.64 Before DOCTYPE system identifier state doBeforeDoctypeSystemId :: Lexer s -> ST s ()-doBeforeDoctypeSystemId x @ Lexer {..} = do+doBeforeDoctypeSystemId x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -2005,7 +2005,7 @@ -- 12.2.5.65 DOCTYPE system identifier (double-quoted) state doDoctypeSystemIdDoubleQuoted :: Lexer s -> ST s ()-doDoctypeSystemIdDoubleQuoted x @ Lexer {..} = do+doDoctypeSystemIdDoubleQuoted x@Lexer {..} = do c <- nextWord x if | c == chrQuote -> do doAfterDoctypeSystemId x@@ -2025,7 +2025,7 @@ -- 12.2.5.66 DOCTYPE system identifier (single-quoted) state doDoctypeSystemIdSingleQuoted :: Lexer s -> ST s ()-doDoctypeSystemIdSingleQuoted x @ Lexer {..} = do+doDoctypeSystemIdSingleQuoted x@Lexer {..} = do c <- nextWord x if | c == chrApostrophe -> do doAfterDoctypeSystemId x@@ -2045,7 +2045,7 @@ -- 12.2.5.67 After DOCTYPE system identifier state doAfterDoctypeSystemId :: Lexer s -> ST s ()-doAfterDoctypeSystemId x @ Lexer {..} = do+doAfterDoctypeSystemId x@Lexer {..} = do c <- nextWord x if | c == chrTab || c == chrLF ||@@ -2066,7 +2066,7 @@ -- 12.2.5.68 Bogus DOCTYPE state doBogusDoctype :: Lexer s -> ST s ()-doBogusDoctype x @ Lexer {..} = do+doBogusDoctype x@Lexer {..} = do c <- nextWord x if | c == chrGreater -> do state x StateData@@ -2079,7 +2079,7 @@ -- 12.2.5.69 CDATA section state doCDATASection :: Lexer s -> ST s ()-doCDATASection x @ Lexer {..} = do+doCDATASection x@Lexer {..} = do c <- nextWord x if | c == chrBracketRight -> do doCDATASectionBracket x@@ -2093,7 +2093,7 @@ -- 12.2.5.70 CDATA section bracket state doCDATASectionBracket :: Lexer s -> ST s ()-doCDATASectionBracket x @ Lexer {..} = do+doCDATASectionBracket x@Lexer {..} = do c <- nextWord x if | c == chrBracketRight -> do doCDATASectionEnd x@@ -2104,7 +2104,7 @@ -- 12.2.5.71 CDATA section end state doCDATASectionEnd :: Lexer s -> ST s ()-doCDATASectionEnd x @ Lexer {..} = do+doCDATASectionEnd x@Lexer {..} = do c <- nextWord x if | c == chrBracketRight -> do emitChar x c@@ -2119,7 +2119,7 @@ -- 12.2.5.72 Character reference state doCharacterReference :: Lexer s -> ST s ()-doCharacterReference x @ Lexer {..} = do+doCharacterReference x@Lexer {..} = do bufferReset lexerBuffer bufferAppend chrAmpersand lexerBuffer c <- nextWord x@@ -2140,7 +2140,7 @@ -- 12.2.5.73 Named character reference state doNamedCharacterReference :: Lexer s -> ST s ()-doNamedCharacterReference x @ Lexer {..} = do+doNamedCharacterReference x@Lexer {..} = do o <- rref lexerOffset case entityMatch (bsDrop o lexerData) of Just (p, v, _) -> do@@ -2169,7 +2169,7 @@ -- 12.2.5.74 Ambiguous ampersand state doAmbiguousAmpersand :: Lexer s -> ST s ()-doAmbiguousAmpersand x @ Lexer {..} = do+doAmbiguousAmpersand x@Lexer {..} = do c <- nextWord x if | chrASCIIAlphanumeric c -> do consumingAttibute x >>= \case@@ -2186,7 +2186,7 @@ -- 12.2.5.75 Numeric character reference state doNumericCharacterReference :: Lexer s -> ST s ()-doNumericCharacterReference x @ Lexer {..} = do+doNumericCharacterReference x@Lexer {..} = do wref lexerCode 0 c <- nextWord x if | c == chrUpperX || c == chrLowerX -> do@@ -2198,7 +2198,7 @@ -- 12.2.5.76 Hexademical character reference start state doHexCharacterReferenceStart :: Lexer s -> ST s ()-doHexCharacterReferenceStart x @ Lexer {..} = do+doHexCharacterReferenceStart x@Lexer {..} = do c <- nextWord x if | chrASCIIHexDigit c -> do backWord x@@ -2211,7 +2211,7 @@ -- 12.2.5.77 Decimal character reference start state doDecimalCharacterReferenceStart :: Lexer s -> ST s ()-doDecimalCharacterReferenceStart x @ Lexer {..} = do+doDecimalCharacterReferenceStart x@Lexer {..} = do c <- nextWord x if | chrASCIIDigit c -> do backWord x@@ -2224,7 +2224,7 @@ -- 12.2.5.78 Hexademical character reference state doHexCharacterReference :: Lexer s -> ST s ()-doHexCharacterReference x @ Lexer {..} = do+doHexCharacterReference x@Lexer {..} = do c <- nextWord x if | chrASCIIDigit c -> do uref lexerCode $ \y -> 16 * y + (fromIntegral c - 0x30)@@ -2244,7 +2244,7 @@ -- 12.2.5.79 Decimal character reference state doDecimalCharacterReference :: Lexer s -> ST s ()-doDecimalCharacterReference x @ Lexer {..} = do+doDecimalCharacterReference x@Lexer {..} = do c <- nextWord x if | chrASCIIDigit c -> do uref lexerCode $ \y -> 10 * y + (fromIntegral c - 0x30)@@ -2258,7 +2258,7 @@ -- 12.2.5.80 Numeric character reference end state doNumericCharacterReferenceEnd :: Lexer s -> ST s ()-doNumericCharacterReferenceEnd x @ Lexer {..} = do+doNumericCharacterReferenceEnd x@Lexer {..} = do c <- rref lexerCode let n = fromIntegral c if | c == 0 -> do
src/Zenacy/HTML/Internal/Parser.hs view
@@ -311,7 +311,7 @@ -- | The parser main loop. parserRun :: Parser s -> ST s ParserResult-parserRun p @ Parser {..} = do+parserRun p@Parser {..} = do rref parserDone >>= \case True -> do Lexer{..} <- rref parserLexer@@ -328,7 +328,7 @@ -- | Handles tree construction dispatch. dispatchTreeConstruction :: Parser s -> Token -> ST s ()-dispatchTreeConstruction p @ Parser {..} t = do+dispatchTreeConstruction p@Parser {..} t = do e <- elementStackEmpty p a <- adjustedCurrentNode p b <- pure $ case a of@@ -354,7 +354,7 @@ -- | Processes a token as HTML content. doHtmlContent :: Parser s -> Token -> ST s ()-doHtmlContent p @ Parser {..} t = do+doHtmlContent p@Parser {..} t = do m <- rref parserInsertionMode parserInserter m p t @@ -391,7 +391,7 @@ -- | Handles parse errors. parseError :: Parser s -> Maybe Token -> BS -> ST s ()-parseError p @ Parser {..} t s =+parseError p@Parser {..} t s = when parserLogErrors $ uref parserErrors $ flip D.snoc e where@@ -446,41 +446,41 @@ -- | Detmermines if the element stack is empty. elementStackEmpty :: Parser s -> ST s Bool-elementStackEmpty p @ Parser {..} = null <$> elementStack p+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+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+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:)+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+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 =+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 =+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+elementStackPopUntil p@Parser {..} f = do elementStackPopWhile p (not . g) elementStackPopIf p g where@@ -668,11 +668,11 @@ -- | Converts a node ID to a node. getNode :: Parser s -> DOMID -> ST s (Maybe DOMNode)-getNode p @ Parser {..} x = flip domGetNode x <$> getDOM p+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+nodeElementName p@Parser {..} x = do d <- getDOM p pure $ case domGetNode d x of Just a -> domNodeElementName a@@ -680,11 +680,11 @@ -- | Gets the last node ID. lastNodeID :: Parser s -> ST s (Maybe DOMID)-lastNodeID p @ Parser {..} = listToMaybe . reverse <$> elementStack p+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+currentNodeID p@Parser {..} = listToMaybe <$> elementStack p -- | Gets the current node. currentNode :: Parser s -> ST s (Maybe DOMNode)@@ -714,7 +714,7 @@ -- | Gets the adjusted current node ID. adjustedCurrentNodeID :: Parser s -> ST s (Maybe DOMID)-adjustedCurrentNodeID p @ Parser {..} = do+adjustedCurrentNodeID p@Parser {..} = do f <- rref parserFragmentMode n <- elementStackSize p if f && n == 1@@ -767,7 +767,7 @@ -- | Modifies the DOM. modifyDOM :: Parser s -> (DOM -> DOM) -> ST s ()-modifyDOM p @ Parser {..} = uref parserDOM+modifyDOM p@Parser {..} = uref parserDOM -- | Sets the insertion mode. setMode :: Parser s -> ParserMode -> ST s ()@@ -813,7 +813,7 @@ -- | Gets the current form element type. getFormType :: Parser s -> ST s (Maybe DOMType)-getFormType p @ Parser {..} =+getFormType p@Parser {..} = getFormElement p >>= pure . maybe Nothing (Just . domNodeType) -- | Saves the current node as the form element.@@ -826,7 +826,7 @@ -- | Initializes the self closing flag. selfClosingInit :: Parser s -> Token -> ST s ()-selfClosingInit p @ Parser {..} t =+selfClosingInit p@Parser {..} t = wref parserSelfClosingFlag $ case t of TStart {..} -> tStartClosed@@ -884,7 +884,7 @@ -- | Adds an element to the list of active format elements. activeFormatAddElement :: Parser s -> Token -> DOMID -> ST s ()-activeFormatAddElement p @ Parser {..} t x = do+activeFormatAddElement p@Parser {..} t x = do d <- getDOM p a <- activeFormatList p let match (ParserFormatElement y _) = domMatch d x y@@ -896,12 +896,12 @@ -- | Adds the current node to the list of active format elements. activeFormatAddCurrentNode :: Parser s -> Token -> ST s ()-activeFormatAddCurrentNode p @ Parser {..} t =+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+activeFormatAny p@Parser {..} f = do d <- getDOM p a <- activeFormatList p pure $@@ -917,7 +917,7 @@ -- | Finds a format item with a specified tag name. activeFormatFindTag :: Parser s -> BS -> ST s (Maybe ParserFormatItem)-activeFormatFindTag p @ Parser {..} x = do+activeFormatFindTag p@Parser {..} x = do d <- getDOM p a <- activeFormatList p pure $@@ -927,7 +927,7 @@ -- | Finds the token for a node ID. activeFormatFindToken :: Parser s -> DOMID -> ST s (Maybe Token)-activeFormatFindToken p @ Parser {..} x =+activeFormatFindToken p@Parser {..} x = activeFormatList p >>= f where f [] = pure Nothing@@ -958,7 +958,7 @@ -- | Reopens a format item. reopen :: Parser s -> [ParserFormatItem] -> [ParserFormatItem] -> ST s ()-reopen p @ Parser {..} b a =+reopen p@Parser {..} b a = case b of [] -> wref parserActiveFormatList a@@ -1031,26 +1031,26 @@ -- | Gets the current template insertion mode. templateModeCurrent :: Parser s -> ST s (Maybe ParserMode)-templateModeCurrent p @ Parser {..} = listToMaybe <$> rref parserTemplateMode+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:)+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 {..} =+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+templateModeCount p@Parser {..} = length <$> rref parserTemplateMode -- | Gets the appropriate insertion location. appropriateInsertionLocation :: Parser s -> Maybe DOMID -> ST s DOMPos-appropriateInsertionLocation p @ Parser {..} override = do+appropriateInsertionLocation p@Parser {..} override = do -- (1) Check for override target. target <- case override of Just a -> pure a@@ -1310,11 +1310,11 @@ -- | 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+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+insertNewNode p@Parser {..} i x = do d <- getDOM p let (d', j) = domInsertNew i x d setDOM p d'@@ -1322,20 +1322,20 @@ -- | Inserts a node as a child of the document. insertDocumentNode :: Parser s -> DOMID -> ST s ()-insertDocumentNode p @ Parser {..} = insertNode p domRootPos+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+insertNewDocumentNode p@Parser {..} = void . insertNewNode p domRootPos -- | Makes a comment node. commentMake :: Parser s -> Token -> ST s DOMNode-commentMake p @ Parser {..} t =+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 {..} =+doctypeMake p@Parser {..} TDoctype {..} = pure $ domDefaultDoctype { domDoctypeName = tDoctypeName , domDoctypePublicID = tDoctypePublic@@ -1344,18 +1344,18 @@ -- | Inserts a new comment in the document. insertComment :: Parser s -> Token -> ST s ()-insertComment p @ Parser {..} t =+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 =+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 {..} =+insertChar p@Parser {..} = withCharToken $ \w -> do pos <- insertionLocation p let i = domPosParent pos@@ -1397,7 +1397,7 @@ -- | Returns a dom with the text nodes populated with text values. textMapDOM :: Parser s -> ST s DOM-textMapDOM p @ Parser {..} = do+textMapDOM p@Parser {..} = do DOM{..} <- getDOM p m <- rref parserTextMap >>= mapM bufferPack let f x = IntMap.findWithDefault bsEmpty x m@@ -1480,7 +1480,7 @@ -- | Resets the insertion mode appropriately. resetInsertionMode :: Parser s -> ST s ()-resetInsertionMode p @ Parser {..} =+resetInsertionMode p@Parser {..} = elementStackNodes p >>= f where f [] = pure ()@@ -1582,7 +1582,7 @@ -- | Runs the adoption agency algorithm. adoptionAgencyRun :: Parser s -> BS -> ST s () -> ST s ()-adoptionAgencyRun p @ Parser {..} subject anyOther = do+adoptionAgencyRun p@Parser {..} subject anyOther = do a <- currentNodeHasType p $ domMakeTypeHTML subject b <- currentNodeID p >>= \case Just i -> notM $ activeFormatContains p i@@ -1854,7 +1854,7 @@ -- | Handle the initial insertion mode. doModeInitial :: Parser s -> Token -> ST s ()-doModeInitial p @ Parser {..} t =+doModeInitial p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> do pure ()@@ -1878,7 +1878,7 @@ -- | Handle the before html insertion mode. doModeBeforeHtml :: Parser s -> Token -> ST s ()-doModeBeforeHtml p @ Parser {..} t =+doModeBeforeHtml p@Parser {..} t = case t of TDoctype {} -> parseError p (Just t) "before html doctype"@@ -1903,7 +1903,7 @@ -- | Handle the before head insertion mode. doModeBeforeHead :: Parser s -> Token -> ST s ()-doModeBeforeHead p @ Parser {..} t =+doModeBeforeHead p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> pure ()@@ -1933,7 +1933,7 @@ -- | Handles the in-head parser mode. doModeInHead :: Parser s -> Token -> ST s ()-doModeInHead p @ Parser {..} t =+doModeInHead p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> insertChar p t@@ -2016,7 +2016,7 @@ -- | Handles the in head no script parser mode. doModeInHeadNoscript :: Parser s -> Token -> ST s ()-doModeInHeadNoscript p @ Parser {..} t =+doModeInHeadNoscript p@Parser {..} t = case t of TDoctype {} -> warn "doctype"@@ -2054,7 +2054,7 @@ -- | Handles the after head parser mode. doModeAfterHead :: Parser s -> Token -> ST s ()-doModeAfterHead p @ Parser {..} t =+doModeAfterHead p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> insertChar p t@@ -2097,7 +2097,7 @@ -- | Handles the in body parser mode. doModeInBody :: Parser s -> Token -> ST s ()-doModeInBody p @ Parser {..} t =+doModeInBody p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> do activeFormatReconstruct p@@ -2534,7 +2534,7 @@ -- | Handle the text insertion mode. doModeText :: Parser s -> Token -> ST s ()-doModeText p @ Parser {..} t =+doModeText p@Parser {..} t = case t of TChar {} -> insertChar p t@@ -2554,7 +2554,7 @@ -- | Handle the in-table insertion mode. doModeInTable :: Parser s -> Token -> ST s ()-doModeInTable p @ Parser {..} t =+doModeInTable p@Parser {..} t = case t of TChar {} -> do a <- currentNodeHasTypeIn p $ domTypesHTML@@ -2656,7 +2656,7 @@ -- | Handle the in-table-text insertion mode. doModeInTableText :: Parser s -> Token -> ST s ()-doModeInTableText p @ Parser {..} t =+doModeInTableText p@Parser {..} t = case t of TChar {} -> pendingTableCharAppend p t@@ -2678,7 +2678,7 @@ -- | Handle the in-caption insertion mode. doModeInCaption :: Parser s -> Token -> ST s ()-doModeInCaption p @ Parser {..} t =+doModeInCaption p@Parser {..} t = case t of TEnd { tEndName = x@"caption" } -> processCaption@@ -2714,7 +2714,7 @@ -- | Handle the in-column-group insertion mode. doModeInColumnGroup :: Parser s -> Token -> ST s ()-doModeInColumnGroup p @ Parser {..} t =+doModeInColumnGroup p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> insertChar p t@@ -2759,7 +2759,7 @@ -- | Handle the in-table-body insertion mode. doModeInTableBody :: Parser s -> Token -> ST s ()-doModeInTableBody p @ Parser {..} t =+doModeInTableBody p@Parser {..} t = case t of TStart { tStartName = "tr" } -> do clearToTableBodyContext@@ -2810,7 +2810,7 @@ -- | Handle the in-row insertion mode. doModeInRow :: Parser s -> Token -> ST s ()-doModeInRow p @ Parser {..} t =+doModeInRow p@Parser {..} t = case t of TStart { tStartName = x } | elem x ["th", "td"] -> do clearToTableRowContext@@ -2862,7 +2862,7 @@ -- | Handle the in-cell insertion mode. doModeInCell :: Parser s -> Token -> ST s ()-doModeInCell p @ Parser {..} t =+doModeInCell p@Parser {..} t = case t of TEnd { tEndName = x } | elem x ["td", "th"] -> do let a = domMakeTypeHTML x@@ -2913,7 +2913,7 @@ -- | Handle the in-select insertion mode. doModeInSelect :: Parser s -> Token -> ST s ()-doModeInSelect p @ Parser {..} t =+doModeInSelect p@Parser {..} t = case t of TChar {} -> insertChar p t@@ -2983,7 +2983,7 @@ -- | Handle the in-select-in-table insertion mode. doModeInSelectInTable :: Parser s -> Token -> ST s ()-doModeInSelectInTable p @ Parser {..} t =+doModeInSelectInTable p@Parser {..} t = case t of TStart { tStartName = x } | elem x ["caption", "table", "tbody", "tfoot",@@ -3008,7 +3008,7 @@ -- | Handle the in-template insertion mode. doModeInTemplate :: Parser s -> Token -> ST s ()-doModeInTemplate p @ Parser {..} t =+doModeInTemplate p@Parser {..} t = case t of TChar {} -> doModeInBody p t@@ -3066,7 +3066,7 @@ -- | Handle the after-body insertion mode. doModeAfterBody :: Parser s -> Token -> ST s ()-doModeAfterBody p @ Parser {..} t =+doModeAfterBody p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> doModeInBody p t@@ -3095,7 +3095,7 @@ -- | Handle the in-frameset insertion mode. doModeInFrameset :: Parser s -> Token -> ST s ()-doModeInFrameset p @ Parser {..} t =+doModeInFrameset p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> insertChar p t@@ -3134,7 +3134,7 @@ -- | Handle the after-frameset insertion mode. doModeAfterFrameset :: Parser s -> Token -> ST s ()-doModeAfterFrameset p @ Parser {..} t =+doModeAfterFrameset p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> insertChar p t@@ -3158,7 +3158,7 @@ -- | Handle the after-after-body insertion mode. doModeAfterAfterBody :: Parser s -> Token -> ST s ()-doModeAfterAfterBody p @ Parser {..} t =+doModeAfterAfterBody p@Parser {..} t = case t of TComment {} -> insertDocComment p t@@ -3180,7 +3180,7 @@ -- | Handle the after-after-frameset insertion mode. doModeAfterAfterFrameset :: Parser s -> Token -> ST s ()-doModeAfterAfterFrameset p @ Parser {..} t =+doModeAfterAfterFrameset p@Parser {..} t = case t of TComment {} -> insertDocComment p t@@ -3202,7 +3202,7 @@ -- | Handle foreign content. doForeignContent :: Parser s -> Token -> ST s ()-doForeignContent p @ Parser {..} t =+doForeignContent p@Parser {..} t = case t of TChar {..} | chrWhitespace tCharData -> insertChar p t
src/Zenacy/HTML/Internal/Trie.hs view
@@ -47,7 +47,7 @@ Just (w, t) -> case Map.lookup w m of Nothing -> a- Just b @ (Trie (Just v2) _) ->+ Just b@(Trie (Just v2) _) -> go (Just (n + 1, v2)) (n + 1) b t Just b -> go a (n + 1) b t
test/Samples.hs view
@@ -115,7 +115,7 @@ go = \case HTMLDocument n c -> concatMap go c- e @ (HTMLElement "a" s a c) ->+ e@(HTMLElement "a" s a c) -> case htmlElemAttrFind (htmlAttrHasName "href") e of Just (HTMLAttr n v s) -> v : concatMap go c
zenacy-html.cabal view
@@ -1,5 +1,5 @@ cabal-version: >= 1.10-version: 2.0.3+version: 2.0.4 name: zenacy-html synopsis:@@ -70,7 +70,7 @@ 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,+ transformers >= 0.5.2 && < 0.7, vector >= 0.11 && < 0.13, word8 >= 0.1.2 && < 0.2