{-# LANGUAGE GHC2024 #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Parsing and tree operations for markup.
module Data.Markup.Parser
  ( -- * high-level parsers
    markup,
    markup_,
    tokenize,
    tokenize_,
    tokenP,

    -- * token-stream tree builder
    gather,
    gather_,
    degather,
    degather_,

    -- * normalisation & well-formedness
    normalize,
    normContent,
    wellFormed,
    isWellFormed,

    -- * element construction
    element,
    element_,
    emptyElem,
    elementc,
    contentRaw,
    addAttrs,

    -- * token parser helpers
    runMarkupParser,
    runParser_,
    runParserWarn,
    nameP,
    attrsP,
    ws,
    ws_,

    -- * constants
    doctypeHtml,
    doctypeXml,
    selfClosers,

    -- * internal token parsers (exported for reuse / testing)
    tokenHtmlP,
    tokenXmlP,
    isWhitespace,
    isNameChar,
    isNameCharXml,
    isNameStartChar,
    isAttrName,
    isBooleanAttrName,
    bs,
    eq_,
    wrappedQ,
    nameStartCharXmlP,
    nameCharXmlP,
    nameXmlP,
    commentP_,
    contentP_,
    declXmlP_,
    doctypeXmlP_,
    startTagsXmlP_,
    attrXmlP_,
    endTagXmlP_,
    nameHtmlP,
    startTagsHtmlP_,
    endTagHtmlP_,
    attrHtmlP_,
    attrsHtmlP_,
    doctypeHtmlP_,
    bogusCommentHtmlP_,
  )
where

import Circuit.Parser
  ( Parser,
    capturedBS,
    char,
    many,
    satisfy,
    skipWhile,
    some,
    string,
    (<|>),
  )
import Circuit.Parser qualified as CP
import Circuit.Parser.Primitives (isLatinLetter)
import Control.Category ((>>>))
import Control.Monad
import Data.Bifunctor
import Data.Bool
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.Function
import Data.Functor.Identity (Identity)
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.Markup
import Data.Markup.Warn
import Data.Maybe
import Data.These
import Data.Tree

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.Markup
-- >>> import Data.Tree

-- | Convert bytestrings to 'Markup'
--
-- Two-phase pipeline: lexical (tokenize) then semantic (gather)
--
-- >>> markup Html "<foo><br></foo><baz"
-- These [MarkupParser (ParserLeftover "<baz")] (Markup {elements = [Node {rootLabel = OpenTag StartTag "foo" [], subForest = [Node {rootLabel = OpenTag StartTag "br" [], subForest = []}]}]})
markup :: Standard -> ByteString -> Warn Markup
markup :: Standard -> ByteString -> Warn Markup
markup Standard
s ByteString
b = ByteString
b ByteString -> (ByteString -> Warn Markup) -> Warn Markup
forall a b. a -> (a -> b) -> b
& (Standard -> ByteString -> Warn [Token]
tokenize Standard
s (ByteString -> Warn [Token])
-> ([Token] -> Warn Markup) -> ByteString -> Warn Markup
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Standard -> [Token] -> Warn Markup
gatherTokens Standard
s)

-- | 'markup' but errors on warnings.
markup_ :: Standard -> ByteString -> Markup
markup_ :: Standard -> ByteString -> Markup
markup_ Standard
s ByteString
b = Standard -> ByteString -> Warn Markup
markup Standard
s ByteString
b Warn Markup -> (Warn Markup -> Markup) -> Markup
forall a b. a -> (a -> b) -> b
& Warn Markup -> Markup
forall a. Warn a -> a
warnError

-- | Wrapper for gather to work with Kleisli composition in markup pipeline
gatherTokens :: Standard -> [Token] -> Warn Markup
gatherTokens :: Standard -> [Token] -> Warn Markup
gatherTokens Standard
s [Token]
ts = case TokenParser [MarkupWarning] Markup
-> [Token] -> ([Token], Warn Markup)
forall e a. TokenParser e a -> [Token] -> ([Token], These e a)
runTP (Standard -> TokenParser [MarkupWarning] Markup
gather Standard
s) [Token]
ts of
  ([], Warn Markup
result) -> Warn Markup
result
  ([Token], Warn Markup)
_ -> [Char] -> Warn Markup
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: gather should consume all tokens"

-- | A 'Token' parser.
--
-- >>> runMarkupParser (tokenP Html) "<foo>content</foo>"
-- ("content</foo>",These () (OpenTag StartTag "foo" []))
tokenP :: Standard -> Parser Identity ByteString Char Token
tokenP :: Standard -> Parser Identity ByteString Char Token
tokenP Standard
Html = Parser Identity ByteString Char Token
tokenHtmlP
tokenP Standard
Xml = Parser Identity ByteString Char Token
tokenXmlP

-- | Parse a bytestring into tokens
--
-- >>> tokenize Html "<foo>content</foo>"
-- That [OpenTag StartTag "foo" [],Content "content",EndTag "foo"]
tokenize :: Standard -> ByteString -> Warn [Token]
tokenize :: Standard -> ByteString -> Warn [Token]
tokenize Standard
s ByteString
b = (ParserWarning -> [MarkupWarning])
-> These ParserWarning [Token] -> Warn [Token]
forall a b c. (a -> b) -> These a c -> These b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((MarkupWarning -> [MarkupWarning] -> [MarkupWarning]
forall a. a -> [a] -> [a]
: []) (MarkupWarning -> [MarkupWarning])
-> (ParserWarning -> MarkupWarning)
-> ParserWarning
-> [MarkupWarning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserWarning -> MarkupWarning
MarkupParser) (These ParserWarning [Token] -> Warn [Token])
-> These ParserWarning [Token] -> Warn [Token]
forall a b. (a -> b) -> a -> b
$ Parser Identity ByteString Char [Token]
-> ByteString -> These ParserWarning [Token]
forall a.
Parser Identity ByteString Char a
-> ByteString -> These ParserWarning a
runParserWarn (Parser Identity ByteString Char Token
-> Parser Identity ByteString Char [Token]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many (Standard -> Parser Identity ByteString Char Token
tokenP Standard
s)) ByteString
b

-- | tokenize but errors on warnings.
tokenize_ :: Standard -> ByteString -> [Token]
tokenize_ :: Standard -> ByteString -> [Token]
tokenize_ Standard
s ByteString
b = Standard -> ByteString -> Warn [Token]
tokenize Standard
s ByteString
b Warn [Token] -> (Warn [Token] -> [Token]) -> [Token]
forall a b. a -> (a -> b) -> b
& Warn [Token] -> [Token]
forall a. Warn a -> a
warnError

-- | Standard Html Doctype
doctypeHtml :: Markup
doctypeHtml :: Markup
doctypeHtml = [Element] -> Markup
Markup ([Element] -> Markup) -> [Element] -> Markup
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Element -> [Element]) -> Element -> [Element]
forall a b. (a -> b) -> a -> b
$ Token -> Element
forall a. a -> Tree a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Token
Doctype ByteString
"DOCTYPE html")

-- | Standard Xml Doctype
doctypeXml :: Markup
doctypeXml :: Markup
doctypeXml =
  [Element] -> Markup
Markup
    [ Token -> Element
forall a. a -> Tree a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> Element) -> Token -> Element
forall a b. (a -> b) -> a -> b
$ ByteString -> [Attr] -> Token
Decl ByteString
"xml" [ByteString -> ByteString -> Attr
Attr ByteString
"version" ByteString
"1.0", ByteString -> ByteString -> Attr
Attr ByteString
"encoding" ByteString
"utf-8"],
      Token -> Element
forall a. a -> Tree a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> Element) -> Token -> Element
forall a b. (a -> b) -> a -> b
$ ByteString -> Token
Doctype ByteString
"DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.1//EN\"\n    \"http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd\""
    ]

-- ============================================================================
-- Character predicates (local, replacing mpar imports)
-- ============================================================================

isWhitespace :: Char -> Bool
isWhitespace :: Char -> Bool
isWhitespace Char
' ' = Bool
True
isWhitespace Char
'\n' = Bool
True
isWhitespace Char
'\t' = Bool
True
isWhitespace Char
'\r' = Bool
True
isWhitespace Char
_ = Bool
False

-- ============================================================================
-- Token parsers (Circuit.Parser, ByteString stream)
-- ============================================================================

-- | Matched span as a 'ByteString' ('capturedBS' — flatparse specialty).
bs :: Parser Identity ByteString Char a -> Parser Identity ByteString Char ByteString
bs :: forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs Parser Identity ByteString Char a
p = (ByteString, a) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, a) -> ByteString)
-> Parser Identity ByteString Char (ByteString, a)
-> Parser Identity ByteString Char ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Identity ByteString Char a
-> Parser Identity ByteString Char (ByteString, a)
forall (m :: * -> *) a.
Monad m =>
Parser m ByteString Char a
-> Parser m ByteString Char (ByteString, a)
capturedBS Parser Identity ByteString Char a
p

-- | equals sign with optional whitespace
eq_ :: Parser Identity ByteString Char ()
eq_ :: Parser Identity ByteString Char ()
eq_ = (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char Char
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'=' Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace

-- | quoted string: single or double quoted
wrappedQ :: Parser Identity ByteString Char ByteString
wrappedQ :: Parser Identity ByteString Char ByteString
wrappedQ =
  (Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'\'' Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\''))) Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'\'')
    Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'"' Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'"'))) Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'"')

tokenXmlP :: Parser Identity ByteString Char Token
tokenXmlP :: Parser Identity ByteString Char Token
tokenXmlP =
  ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"<!--" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
commentP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"<!" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
doctypeXmlP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"</" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
endTagXmlP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"<?" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
declXmlP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"<" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
startTagsXmlP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identity ByteString Char Token
contentP_

tokenHtmlP :: Parser Identity ByteString Char Token
tokenHtmlP :: Parser Identity ByteString Char Token
tokenHtmlP =
  ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"<!--" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
commentP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"<!" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
doctypeHtmlP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"</" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
endTagHtmlP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"<?" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
bogusCommentHtmlP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"<" Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Token
startTagsHtmlP_)
    Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identity ByteString Char Token
contentP_

-- XML name start char (production [4])
isNameStartChar :: Char -> Bool
isNameStartChar :: Char -> Bool
isNameStartChar Char
x =
  Char -> Bool
isLatinLetter Char
x
    Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':'
    Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
    Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xC0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xD6')
    Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xD8' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xF6')
    Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xF8' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFF')

-- XML/HMTL name char
isNameChar :: Char -> Bool
isNameChar :: Char -> Bool
isNameChar Char
x = Bool -> Bool
not (Char -> Bool
isWhitespace Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>')

isNameCharXml :: Char -> Bool
isNameCharXml :: Char -> Bool
isNameCharXml Char
x =
  Char -> Bool
isLatinLetter Char
x
    Bool -> Bool -> Bool
|| Char -> Bool
Data.Char.isDigit Char
x
    Bool -> Bool -> Bool
|| Char
x Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
":_-.·" :: String)
    Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xC0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xD6')
    Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xD8' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xF6')
    Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\xF8' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFF')

isAttrName :: Char -> Bool
isAttrName :: Char -> Bool
isAttrName Char
x = Bool -> Bool
not (Char -> Bool
isWhitespace Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<')

isBooleanAttrName :: Char -> Bool
isBooleanAttrName :: Char -> Bool
isBooleanAttrName Char
x = Bool -> Bool
not (Char -> Bool
isWhitespace Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>' Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'<')

-- XML parsers

nameStartCharXmlP :: Parser Identity ByteString Char Char
nameStartCharXmlP :: Parser Identity ByteString Char Char
nameStartCharXmlP = (Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isNameStartChar

nameCharXmlP :: Parser Identity ByteString Char Char
nameCharXmlP :: Parser Identity ByteString Char Char
nameCharXmlP = (Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isNameCharXml

nameXmlP :: Parser Identity ByteString Char ByteString
nameXmlP :: Parser Identity ByteString Char ByteString
nameXmlP = Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
nameStartCharXmlP Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char [Char]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many Parser Identity ByteString Char Char
nameCharXmlP)

commentP_ :: Parser Identity ByteString Char Token
commentP_ :: Parser Identity ByteString Char Token
commentP_ = ByteString -> Token
Comment (ByteString -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') Parser Identity ByteString Char Char
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char Char
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'-' Parser Identity ByteString Char Char
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char Char
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-')))) Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"-->")

contentP_ :: Parser Identity ByteString Char Token
contentP_ :: Parser Identity ByteString Char Token
contentP_ = ByteString -> Token
Content (ByteString -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
some ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<')))

declXmlP_ :: Parser Identity ByteString Char Token
declXmlP_ :: Parser Identity ByteString Char Token
declXmlP_ =
  let attr :: [Char] -> Parser Identity ByteString Char Attr
attr [Char]
key = ByteString -> ByteString -> Attr
Attr ([Char] -> ByteString
B.pack [Char]
key) (ByteString -> Attr)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char ()
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char [Char]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
key Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char ()
eq_ Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char ByteString
wrappedQ)
      one :: a -> [a]
one a
x = [a
x]
   in [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"xml"
        Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> [Attr] -> Token
Decl ByteString
"xml" ([Attr] -> Token)
-> Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) (Attr -> [Attr] -> [Attr])
-> Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char ([Attr] -> [Attr])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser Identity ByteString Char Attr
attr [Char]
"version" Parser Identity ByteString Char ([Attr] -> [Attr])
-> Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char (a -> b)
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Attr -> [Attr]
forall a. a -> [a]
one (Attr -> [Attr])
-> Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Parser Identity ByteString Char Attr
attr [Char]
"encoding")))
        Parser Identity ByteString Char Token
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace
        Parser Identity ByteString Char Token
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"?>"

doctypeXmlP_ :: Parser Identity ByteString Char Token
doctypeXmlP_ :: Parser Identity ByteString Char Token
doctypeXmlP_ =
  ByteString -> Token
Doctype
    (ByteString -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs
            ( [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"DOCTYPE"
                Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace
                Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Identity ByteString Char ByteString
nameXmlP
                Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace
                Parser Identity ByteString Char ()
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char [Char]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>'))
            )
            Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'>'
        )

startTagsXmlP_ :: Parser Identity ByteString Char Token
startTagsXmlP_ :: Parser Identity ByteString Char Token
startTagsXmlP_ =
  OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
EmptyElemTag
    (ByteString -> [Attr] -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ([Attr] -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char ByteString
nameXmlP Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace)
    Parser Identity ByteString Char ([Attr] -> Token)
-> Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char (a -> b)
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char [Attr]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char Attr
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Attr
attrXmlP_) Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"/>")
      Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
StartTag
    (ByteString -> [Attr] -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ([Attr] -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char ByteString
nameXmlP Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace)
    Parser Identity ByteString Char ([Attr] -> Token)
-> Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char (a -> b)
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char [Attr]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char Attr
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Attr
attrXmlP_) Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
">")

attrXmlP_ :: Parser Identity ByteString Char Attr
attrXmlP_ :: Parser Identity ByteString Char Attr
attrXmlP_ = ByteString -> ByteString -> Attr
Attr (ByteString -> ByteString -> Attr)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char (ByteString -> Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char ByteString
nameXmlP Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Identity ByteString Char ()
eq_) Parser Identity ByteString Char (ByteString -> Attr)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Attr
forall a b.
Parser Identity ByteString Char (a -> b)
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Identity ByteString Char ByteString
wrappedQ

endTagXmlP_ :: Parser Identity ByteString Char Token
endTagXmlP_ :: Parser Identity ByteString Char Token
endTagXmlP_ = ByteString -> Token
EndTag (ByteString -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char ByteString
nameXmlP Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'>')

-- HTML parsers

nameHtmlP :: Parser Identity ByteString Char ByteString
nameHtmlP :: Parser Identity ByteString Char ByteString
nameHtmlP = Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isLatinLetter Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char [Char]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isNameChar))

startTagsHtmlP_ :: Parser Identity ByteString Char Token
startTagsHtmlP_ :: Parser Identity ByteString Char Token
startTagsHtmlP_ =
  OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
StartTag
    (ByteString -> [Attr] -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ([Attr] -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char ByteString
nameHtmlP Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace)
    Parser Identity ByteString Char ([Attr] -> Token)
-> Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char (a -> b)
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Identity ByteString Char [Attr]
attrsHtmlP_ Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
">")
      Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
-> Parser Identity ByteString Char Token
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
EmptyElemTag
    (ByteString -> [Attr] -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ([Attr] -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char ByteString
nameHtmlP Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace)
    Parser Identity ByteString Char ([Attr] -> Token)
-> Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char Token
forall a b.
Parser Identity ByteString Char (a -> b)
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Identity ByteString Char [Attr]
attrsHtmlP_ Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"/>")

endTagHtmlP_ :: Parser Identity ByteString Char Token
endTagHtmlP_ :: Parser Identity ByteString Char Token
endTagHtmlP_ = ByteString -> Token
EndTag (ByteString -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char ByteString
nameHtmlP Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'>')

attrHtmlP_ :: Parser Identity ByteString Char Attr
attrHtmlP_ :: Parser Identity ByteString Char Attr
attrHtmlP_ =
  (ByteString -> ByteString -> Attr
Attr (ByteString -> ByteString -> Attr)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char (ByteString -> Attr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isAttrName)) Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Identity ByteString Char ()
eq_) Parser Identity ByteString Char (ByteString -> Attr)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Attr
forall a b.
Parser Identity ByteString Char (a -> b)
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Identity ByteString Char ByteString
wrappedQ Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
some ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isBooleanAttrName))))
    Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char Attr
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((ByteString -> ByteString -> Attr)
-> ByteString -> ByteString -> Attr
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> Attr
Attr ByteString
B.empty (ByteString -> Attr)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Attr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
some ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isBooleanAttrName)))

attrsHtmlP_ :: Parser Identity ByteString Char [Attr]
attrsHtmlP_ :: Parser Identity ByteString Char [Attr]
attrsHtmlP_ = Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char [Attr]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char Attr
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Attr
attrHtmlP_) Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace

doctypeHtmlP_ :: Parser Identity ByteString Char Token
doctypeHtmlP_ :: Parser Identity ByteString Char Token
doctypeHtmlP_ =
  ByteString -> Token
Doctype
    (ByteString -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs
            ( [Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"DOCTYPE"
                Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace
                Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser Identity ByteString Char ByteString
nameHtmlP
                Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace
            )
            Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ByteString
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'>'
        )

bogusCommentHtmlP_ :: Parser Identity ByteString Char Token
bogusCommentHtmlP_ :: Parser Identity ByteString Char Token
bogusCommentHtmlP_ = ByteString -> Token
Comment (ByteString -> Token)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Identity ByteString Char [Char]
-> Parser Identity ByteString Char ByteString
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char ByteString
bs (Parser Identity ByteString Char Char
-> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
some ((Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'<')))

-- | Parse a tag name.
nameP :: Standard -> Parser Identity ByteString Char ByteString
nameP :: Standard -> Parser Identity ByteString Char ByteString
nameP Standard
Html = Parser Identity ByteString Char ByteString
nameHtmlP
nameP Standard
Xml = Parser Identity ByteString Char ByteString
nameXmlP

-- | Parse an attribute.
-- | Parse attributes list.
attrsP :: Standard -> Parser Identity ByteString Char [Attr]
attrsP :: Standard -> Parser Identity ByteString Char [Attr]
attrsP Standard
Html = Parser Identity ByteString Char [Attr]
attrsHtmlP_
attrsP Standard
Xml = Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char [Attr]
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s [a]
many ((Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Attr
-> Parser Identity ByteString Char Attr
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Attr
attrXmlP_) Parser Identity ByteString Char [Attr]
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char [Attr]
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace

-- | Alias for single whitespace (backward compat with mpar)
ws :: Parser Identity ByteString Char Char
ws :: Parser Identity ByteString Char Char
ws = (Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isWhitespace

-- | Alias for skip whitespace (backward compat with mpar)
ws_ :: Parser Identity ByteString Char ()
ws_ :: Parser Identity ByteString Char ()
ws_ = (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isWhitespace

-- | Run parser, returning leftovers and errors as 'ParserWarning's.
--
-- >>> runParserWarn ws " "
-- That ' '
--
-- >>> runParserWarn ws "x"
-- This ParserUncaught
--
-- >>> runParserWarn ws " x"
-- These (ParserLeftover "x") ' '
runParserWarn :: Parser Identity ByteString Char a -> ByteString -> These ParserWarning a
runParserWarn :: forall a.
Parser Identity ByteString Char a
-> ByteString -> These ParserWarning a
runParserWarn Parser Identity ByteString Char a
p ByteString
s = case Parser Identity ByteString Char a
-> ByteString -> These a ByteString
forall {k} f (s :: k) a. Parser Identity f s a -> f -> These a f
CP.runParserIdentity Parser Identity ByteString Char a
p ByteString
s of
  These a
a ByteString
rest | ByteString -> Bool
B.null ByteString
rest -> a -> These ParserWarning a
forall a b. b -> These a b
That a
a
  These a
a ByteString
rest -> ParserWarning -> a -> These ParserWarning a
forall a b. a -> b -> These a b
These ([Char] -> ParserWarning
ParserLeftover (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
200 (ByteString -> [Char]
B.unpack ByteString
rest))) a
a
  This a
a -> a -> These ParserWarning a
forall a b. b -> These a b
That a
a
  That ByteString
_ -> ParserWarning -> These ParserWarning a
forall a b. a -> These a b
This ParserWarning
ParserUncaught

-- | Run a parser and return the remaining input and result as a tuple
runMarkupParser :: Parser Identity ByteString Char a -> ByteString -> (ByteString, These () a)
runMarkupParser :: forall a.
Parser Identity ByteString Char a
-> ByteString -> (ByteString, These () a)
runMarkupParser Parser Identity ByteString Char a
p ByteString
s = case Parser Identity ByteString Char a
-> ByteString -> These a ByteString
forall {k} f (s :: k) a. Parser Identity f s a -> f -> These a f
CP.runParserIdentity Parser Identity ByteString Char a
p ByteString
s of
  These a
a ByteString
s' | ByteString -> Bool
B.null ByteString
s' -> (ByteString
B.empty, a -> These () a
forall a b. b -> These a b
That a
a)
  These a
a ByteString
s' -> (ByteString
s', () -> a -> These () a
forall a b. a -> b -> These a b
These () a
a)
  This a
a -> (ByteString
B.empty, a -> These () a
forall a b. b -> These a b
That a
a)
  That ByteString
s' -> (ByteString
s', () -> These () a
forall a b. a -> These a b
This ())

runParser_ :: Parser Identity ByteString Char a -> ByteString -> a
runParser_ :: forall a. Parser Identity ByteString Char a -> ByteString -> a
runParser_ Parser Identity ByteString Char a
p ByteString
s = case Parser Identity ByteString Char a
-> ByteString -> These a ByteString
forall {k} f (s :: k) a. Parser Identity f s a -> f -> These a f
CP.runParserIdentity Parser Identity ByteString Char a
p ByteString
s of
  These a
a ByteString
_ -> a
a
  This a
a -> a
a
  That ByteString
_ -> [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Uncaught parse failure"

-- ============================================================================
-- Tree operations
-- ============================================================================

-- | Append attributes to an existing Token attribute list. Returns Nothing for tokens that do not have attributes.
addAttrs :: [Attr] -> Token -> Maybe Token
addAttrs :: [Attr] -> Token -> Maybe Token
addAttrs [Attr]
as (OpenTag OpenTagType
t ByteString
n [Attr]
as') = Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token) -> Token -> Maybe Token
forall a b. (a -> b) -> a -> b
$ OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
t ByteString
n ([Attr]
as [Attr] -> [Attr] -> [Attr]
forall a. Semigroup a => a -> a -> a
<> [Attr]
as')
addAttrs [Attr]
_ Token
_ = Maybe Token
forall a. Maybe a
Nothing

-- | Html tags that self-close
selfClosers :: [NameTag]
selfClosers :: [ByteString]
selfClosers =
  [ ByteString
"area",
    ByteString
"base",
    ByteString
"br",
    ByteString
"col",
    ByteString
"embed",
    ByteString
"hr",
    ByteString
"img",
    ByteString
"input",
    ByteString
"link",
    ByteString
"meta",
    ByteString
"param",
    ByteString
"source",
    ByteString
"track",
    ByteString
"wbr"
  ]

-- | Create 'Markup' from a name tag and attributes that wraps some other markup.
--
-- >>> element "div" [] (element_ "br" [])
-- Markup {elements = [Node {rootLabel = OpenTag StartTag "div" [], subForest = [Node {rootLabel = OpenTag StartTag "br" [], subForest = []}]}]}
element :: NameTag -> [Attr] -> Markup -> Markup
element :: ByteString -> [Attr] -> Markup -> Markup
element ByteString
n [Attr]
as (Markup [Element]
xs) = [Element] -> Markup
Markup [Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node (OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
StartTag ByteString
n [Attr]
as) [Element]
xs]

-- | Create 'Markup' from a name tag and attributes that doesn't wrap some other markup. The 'OpenTagType' used is 'StartTag'. Use 'emptyElem' if you want to create 'EmptyElemTag' based markup.
--
-- >>> (element_ "br" [])
-- Markup {elements = [Node {rootLabel = OpenTag StartTag "br" [], subForest = []}]}
element_ :: NameTag -> [Attr] -> Markup
element_ :: ByteString -> [Attr] -> Markup
element_ ByteString
n [Attr]
as = [Element] -> Markup
Markup [Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node (OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
StartTag ByteString
n [Attr]
as) []]

-- | Create 'Markup' from a name tag and attributes using 'EmptyElemTag', that doesn't wrap some other markup. No checks are made on whether this creates well-formed markup.
--
-- >>> emptyElem "br" []
-- Markup {elements = [Node {rootLabel = OpenTag EmptyElemTag "br" [], subForest = []}]}
emptyElem :: NameTag -> [Attr] -> Markup
emptyElem :: ByteString -> [Attr] -> Markup
emptyElem ByteString
n [Attr]
as = [Element] -> Markup
Markup [Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node (OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
EmptyElemTag ByteString
n [Attr]
as) []]

-- | Create 'Markup' from a name tag and attributes that wraps some 'Content'. No escaping is performed.
--
-- >>> elementc "div" [] "content"
-- Markup {elements = [Node {rootLabel = OpenTag StartTag "div" [], subForest = [Node {rootLabel = Content "content", subForest = []}]}]}
elementc :: NameTag -> [Attr] -> ByteString -> Markup
elementc :: ByteString -> [Attr] -> ByteString -> Markup
elementc ByteString
n [Attr]
as ByteString
b = ByteString -> [Attr] -> Markup -> Markup
element ByteString
n [Attr]
as (ByteString -> Markup
contentRaw ByteString
b)

-- | Create a Markup element from a bytestring, not escaping the usual characters.
--
-- >>> contentRaw "<content>"
-- Markup {elements = [Node {rootLabel = Content "<content>", subForest = []}]}
contentRaw :: ByteString -> Markup
contentRaw :: ByteString -> Markup
contentRaw ByteString
b = [Element] -> Markup
Markup [Token -> Element
forall a. a -> Tree a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> Element) -> Token -> Element
forall a b. (a -> b) -> a -> b
$ ByteString -> Token
Content ByteString
b]

normTokenAttrs :: Token -> Token
normTokenAttrs :: Token -> Token
normTokenAttrs (OpenTag OpenTagType
t ByteString
n [Attr]
as) = OpenTagType -> ByteString -> [Attr] -> Token
OpenTag OpenTagType
t ByteString
n ([Attr] -> [Attr]
normAttrs [Attr]
as)
normTokenAttrs Token
x = Token
x

-- | normalize an attribution list, removing duplicate AttrNames, and space concatenating class values.
normAttrs :: [Attr] -> [Attr]
normAttrs :: [Attr] -> [Attr]
normAttrs [Attr]
as =
  (ByteString -> ByteString -> Attr)
-> (ByteString, ByteString) -> Attr
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Attr
Attr
    ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ByteString ByteString -> [(ByteString, ByteString)]
forall k a. Map k a -> [(k, a)]
Map.toList
      ( (Map ByteString ByteString -> Attr -> Map ByteString ByteString)
-> Map ByteString ByteString -> [Attr] -> Map ByteString ByteString
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
          ( \Map ByteString ByteString
s (Attr ByteString
n ByteString
v) ->
              (ByteString -> ByteString -> ByteString -> ByteString)
-> ByteString
-> ByteString
-> Map ByteString ByteString
-> Map ByteString ByteString
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWithKey
                ( \ByteString
k ByteString
new ByteString
old ->
                    case ByteString
k of
                      ByteString
"class" -> ByteString
old ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
new
                      ByteString
_ -> ByteString
new
                )
                ByteString
n
                ByteString
v
                Map ByteString ByteString
s
          )
          Map ByteString ByteString
forall k a. Map k a
Map.empty
          [Attr]
as
      )

-- | Concatenate sequential content and normalize attributes; unwording class values and removing duplicate attributes (taking last).
normalize :: Markup -> Markup
normalize :: Markup -> Markup
normalize Markup
m = Markup -> Markup
normContent (Markup -> Markup) -> Markup -> Markup
forall a b. (a -> b) -> a -> b
$ [Element] -> Markup
Markup ([Element] -> Markup) -> [Element] -> Markup
forall a b. (a -> b) -> a -> b
$ (Element -> Element) -> [Element] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Token -> Token) -> Element -> Element
forall a b. (a -> b) -> Tree a -> Tree b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Token -> Token
normTokenAttrs) (Markup -> [Element]
elements Markup
m)

-- | Are the trees in the markup well-formed?
isWellFormed :: Standard -> Markup -> Bool
isWellFormed :: Standard -> Markup -> Bool
isWellFormed Standard
s = ([MarkupWarning] -> [MarkupWarning] -> Bool
forall a. Eq a => a -> a -> Bool
== []) ([MarkupWarning] -> Bool)
-> (Markup -> [MarkupWarning]) -> Markup -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Standard -> Markup -> [MarkupWarning]
wellFormed Standard
s

-- | Check for well-formedness and return warnings encountered.
--
-- >>> wellFormed Html $ Markup [Node (Comment "") [], Node (EndTag "foo") [], Node (OpenTag EmptyElemTag "foo" []) [Node (Content "bar") []], Node (OpenTag EmptyElemTag "foo" []) []]
-- [EmptyContent,EndTagInTree,LeafWithChildren,BadEmptyElemTag]
wellFormed :: Standard -> Markup -> [MarkupWarning]
wellFormed :: Standard -> Markup -> [MarkupWarning]
wellFormed Standard
s (Markup [Element]
trees) = [MarkupWarning] -> [MarkupWarning]
forall a. Eq a => [a] -> [a]
List.nub ([MarkupWarning] -> [MarkupWarning])
-> [MarkupWarning] -> [MarkupWarning]
forall a b. (a -> b) -> a -> b
$ [[MarkupWarning]] -> [MarkupWarning]
forall a. Monoid a => [a] -> a
mconcat ((Token -> [[MarkupWarning]] -> [MarkupWarning])
-> Element -> [MarkupWarning]
forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree Token -> [[MarkupWarning]] -> [MarkupWarning]
checkNode (Element -> [MarkupWarning]) -> [Element] -> [[MarkupWarning]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Element]
trees)
  where
    checkNode :: Token -> [[MarkupWarning]] -> [MarkupWarning]
checkNode (OpenTag OpenTagType
StartTag ByteString
_ [Attr]
_) [[MarkupWarning]]
xs = [[MarkupWarning]] -> [MarkupWarning]
forall a. Monoid a => [a] -> a
mconcat [[MarkupWarning]]
xs
    checkNode (OpenTag OpenTagType
EmptyElemTag ByteString
n [Attr]
_) [] =
      [MarkupWarning] -> [MarkupWarning] -> Bool -> [MarkupWarning]
forall a. a -> a -> Bool -> a
bool [] [MarkupWarning
BadEmptyElemTag] (ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem ByteString
n [ByteString]
selfClosers Bool -> Bool -> Bool
&& Standard
s Standard -> Standard -> Bool
forall a. Eq a => a -> a -> Bool
== Standard
Html)
    checkNode (EndTag ByteString
_) [] = [MarkupWarning
EndTagInTree]
    checkNode (Content ByteString
b) [] = [MarkupWarning] -> [MarkupWarning] -> Bool -> [MarkupWarning]
forall a. a -> a -> Bool -> a
bool [] [MarkupWarning
EmptyContent] (ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"")
    checkNode (Comment ByteString
b) [] = [MarkupWarning] -> [MarkupWarning] -> Bool -> [MarkupWarning]
forall a. a -> a -> Bool -> a
bool [] [MarkupWarning
EmptyContent] (ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"")
    checkNode (Decl ByteString
b [Attr]
as) []
      | ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"" = [MarkupWarning
EmptyContent]
      | Standard
s Standard -> Standard -> Bool
forall a. Eq a => a -> a -> Bool
== Standard
Html Bool -> Bool -> Bool
&& [Attr]
as [Attr] -> [Attr] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = [MarkupWarning
BadDecl]
      | Standard
s Standard -> Standard -> Bool
forall a. Eq a => a -> a -> Bool
== Standard
Xml Bool -> Bool -> Bool
&& (ByteString
"version" ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Attr -> ByteString
attrName (Attr -> ByteString) -> [Attr] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Attr]
as)) Bool -> Bool -> Bool
&& (ByteString
"encoding" ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Attr -> ByteString
attrName (Attr -> ByteString) -> [Attr] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Attr]
as)) =
          [MarkupWarning
BadDecl]
      | Bool
otherwise = []
    checkNode (Doctype ByteString
b) [] = [MarkupWarning] -> [MarkupWarning] -> Bool -> [MarkupWarning]
forall a. a -> a -> Bool -> a
bool [] [MarkupWarning
EmptyContent] (ByteString
b ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"")
    checkNode Token
_ [[MarkupWarning]]
_ = [MarkupWarning
LeafWithChildren]

-- | Normalise Content in Markup, concatenating adjacent Content, and removing mempty Content.
normContent :: Markup -> Markup
normContent :: Markup -> Markup
normContent (Markup [Element]
trees) = [Element] -> Markup
Markup ([Element] -> Markup) -> [Element] -> Markup
forall a b. (a -> b) -> a -> b
$ (Token -> [Element] -> Element) -> Element -> Element
forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree (\Token
x [Element]
xs -> Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node Token
x ((Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> Token
Content ByteString
"") (Token -> Bool) -> (Element -> Token) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Token
forall a. Tree a -> a
rootLabel) ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ [Element] -> [Element]
concatContent [Element]
xs)) (Element -> Element) -> [Element] -> [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Element] -> [Element]
concatContent [Element]
trees

concatContent :: [Tree Token] -> [Tree Token]
concatContent :: [Element] -> [Element]
concatContent = \case
  ((Node (Content ByteString
t) [Element]
_) : (Node (Content ByteString
t') [Element]
_) : [Element]
ts) -> [Element] -> [Element]
concatContent ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node (ByteString -> Token
Content (ByteString
t ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
t')) [] Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
ts
  (Element
t : [Element]
ts) -> Element
t Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element] -> [Element]
concatContent [Element]
ts
  [] -> []

-- | Gather together token trees from a token list, placing child elements in nodes and removing EndTags.
gather :: Standard -> TokenParser [MarkupWarning] Markup
gather :: Standard -> TokenParser [MarkupWarning] Markup
gather Standard
s = ([Token] -> ([Token], Warn Markup))
-> TokenParser [MarkupWarning] Markup
forall e a. ([Token] -> ([Token], These e a)) -> TokenParser e a
TokenParser (([Token] -> ([Token], Warn Markup))
 -> TokenParser [MarkupWarning] Markup)
-> ([Token] -> ([Token], Warn Markup))
-> TokenParser [MarkupWarning] Markup
forall a b. (a -> b) -> a -> b
$ \[Token]
ts ->
  let (Cursor [Element]
finalSibs [(Token, [Element])]
finalParents, [MarkupWarning]
warnings) =
        ((Cursor, [MarkupWarning]) -> Token -> (Cursor, [MarkupWarning]))
-> (Cursor, [MarkupWarning])
-> [Token]
-> (Cursor, [MarkupWarning])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(Cursor
c, [MarkupWarning]
xs) Token
t -> Standard -> Token -> Cursor -> (Cursor, Maybe MarkupWarning)
incCursor Standard
s Token
t Cursor
c (Cursor, Maybe MarkupWarning)
-> ((Cursor, Maybe MarkupWarning) -> (Cursor, [MarkupWarning]))
-> (Cursor, [MarkupWarning])
forall a b. a -> (a -> b) -> b
& (Maybe MarkupWarning -> [MarkupWarning])
-> (Cursor, Maybe MarkupWarning) -> (Cursor, [MarkupWarning])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Maybe MarkupWarning -> [MarkupWarning]
forall a. Maybe a -> [a]
maybeToList (Maybe MarkupWarning -> [MarkupWarning])
-> ([MarkupWarning] -> [MarkupWarning])
-> Maybe MarkupWarning
-> [MarkupWarning]
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ([MarkupWarning] -> [MarkupWarning] -> [MarkupWarning]
forall a. Semigroup a => a -> a -> a
<> [MarkupWarning]
xs))) ([Element] -> [(Token, [Element])] -> Cursor
Cursor [] [], []) [Token]
ts
   in case ([Element]
finalSibs, [(Token, [Element])]
finalParents, [MarkupWarning]
warnings) of
        ([Element]
sibs, [], []) -> ([], Markup -> Warn Markup
forall a b. b -> These a b
That ([Element] -> Markup
Markup ([Element] -> [Element]
forall a. [a] -> [a]
reverse [Element]
sibs)))
        ([], [], [MarkupWarning]
xs) -> ([], [MarkupWarning] -> Warn Markup
forall a b. a -> These a b
This [MarkupWarning]
xs)
        ([Element]
sibs, [(Token, [Element])]
ps, [MarkupWarning]
xs) ->
          let result :: [Element]
result = [Element] -> [Element]
forall a. [a] -> [a]
reverse ([Element] -> [Element]) -> [Element] -> [Element]
forall a b. (a -> b) -> a -> b
$ ([Element] -> (Token, [Element]) -> [Element])
-> [Element] -> [(Token, [Element])] -> [Element]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\[Element]
ss' (Token
p, [Element]
ss) -> Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node Token
p ([Element] -> [Element]
forall a. [a] -> [a]
reverse [Element]
ss') Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
ss) [Element]
sibs [(Token, [Element])]
ps
           in ([], [MarkupWarning] -> Markup -> Warn Markup
forall a b. a -> b -> These a b
These ([MarkupWarning]
xs [MarkupWarning] -> [MarkupWarning] -> [MarkupWarning]
forall a. Semigroup a => a -> a -> a
<> [MarkupWarning
UnclosedTag]) ([Element] -> Markup
Markup [Element]
result))

-- | 'gather' but errors on warnings.
gather_ :: Standard -> [Token] -> Markup
gather_ :: Standard -> [Token] -> Markup
gather_ Standard
s [Token]
ts = case TokenParser [MarkupWarning] Markup
-> [Token] -> ([Token], Warn Markup)
forall e a. TokenParser e a -> [Token] -> ([Token], These e a)
runTP (Standard -> TokenParser [MarkupWarning] Markup
gather Standard
s) [Token]
ts of
  ([], That Markup
m) -> Markup
m
  ([], This [MarkupWarning]
w) -> [Char] -> Markup
forall a. HasCallStack => [Char] -> a
error ([MarkupWarning] -> [Char]
showWarnings [MarkupWarning]
w)
  ([], These [MarkupWarning]
w Markup
m) -> if [MarkupWarning] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MarkupWarning]
w then Markup
m else [Char] -> Markup
forall a. HasCallStack => [Char] -> a
error ([MarkupWarning] -> [Char]
showWarnings [MarkupWarning]
w)
  ([Token], Warn Markup)
_ -> [Char] -> Markup
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: gather should consume all tokens"

incCursor :: Standard -> Token -> Cursor -> (Cursor, Maybe MarkupWarning)
-- Only StartTags are ever pushed on to the parent list, here:
incCursor :: Standard -> Token -> Cursor -> (Cursor, Maybe MarkupWarning)
incCursor Standard
Xml t :: Token
t@(OpenTag OpenTagType
StartTag ByteString
_ [Attr]
_) (Cursor [Element]
ss [(Token, [Element])]
ps) = ([Element] -> [(Token, [Element])] -> Cursor
Cursor [] ((Token
t, [Element]
ss) (Token, [Element]) -> [(Token, [Element])] -> [(Token, [Element])]
forall a. a -> [a] -> [a]
: [(Token, [Element])]
ps), Maybe MarkupWarning
forall a. Maybe a
Nothing)
incCursor Standard
Html t :: Token
t@(OpenTag OpenTagType
StartTag ByteString
n [Attr]
_) (Cursor [Element]
ss [(Token, [Element])]
ps) =
  (Cursor -> Cursor -> Bool -> Cursor
forall a. a -> a -> Bool -> a
bool ([Element] -> [(Token, [Element])] -> Cursor
Cursor [] ((Token
t, [Element]
ss) (Token, [Element]) -> [(Token, [Element])] -> [(Token, [Element])]
forall a. a -> [a] -> [a]
: [(Token, [Element])]
ps)) ([Element] -> [(Token, [Element])] -> Cursor
Cursor (Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node Token
t [] Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
ss) [(Token, [Element])]
ps) (ByteString
n ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
selfClosers), Maybe MarkupWarning
forall a. Maybe a
Nothing)
incCursor Standard
Xml t :: Token
t@(OpenTag OpenTagType
EmptyElemTag ByteString
_ [Attr]
_) (Cursor [Element]
ss [(Token, [Element])]
ps) = ([Element] -> [(Token, [Element])] -> Cursor
Cursor (Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node Token
t [] Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
ss) [(Token, [Element])]
ps, Maybe MarkupWarning
forall a. Maybe a
Nothing)
incCursor Standard
Html t :: Token
t@(OpenTag OpenTagType
EmptyElemTag ByteString
n [Attr]
_) (Cursor [Element]
ss [(Token, [Element])]
ps) =
  ( [Element] -> [(Token, [Element])] -> Cursor
Cursor (Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node Token
t [] Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
ss) [(Token, [Element])]
ps,
    Maybe MarkupWarning
-> Maybe MarkupWarning -> Bool -> Maybe MarkupWarning
forall a. a -> a -> Bool -> a
bool (MarkupWarning -> Maybe MarkupWarning
forall a. a -> Maybe a
Just MarkupWarning
BadEmptyElemTag) Maybe MarkupWarning
forall a. Maybe a
Nothing (ByteString
n ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
selfClosers)
  )
incCursor Standard
_ (EndTag ByteString
n) (Cursor [Element]
ss ((p :: Token
p@(OpenTag OpenTagType
StartTag ByteString
n' [Attr]
_), [Element]
ss') : [(Token, [Element])]
ps)) =
  ( [Element] -> [(Token, [Element])] -> Cursor
Cursor (Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node Token
p ([Element] -> [Element]
forall a. [a] -> [a]
reverse [Element]
ss) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
ss') [(Token, [Element])]
ps,
    Maybe MarkupWarning
-> Maybe MarkupWarning -> Bool -> Maybe MarkupWarning
forall a. a -> a -> Bool -> a
bool (MarkupWarning -> Maybe MarkupWarning
forall a. a -> Maybe a
Just (ByteString -> ByteString -> MarkupWarning
TagMismatch ByteString
n ByteString
n')) Maybe MarkupWarning
forall a. Maybe a
Nothing (ByteString
n ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
n')
  )
-- Non-StartTag on parent list
incCursor Standard
_ (EndTag ByteString
_) (Cursor [Element]
ss ((Token
p, [Element]
ss') : [(Token, [Element])]
ps)) =
  ( [Element] -> [(Token, [Element])] -> Cursor
Cursor (Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node Token
p ([Element] -> [Element]
forall a. [a] -> [a]
reverse [Element]
ss) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
ss') [(Token, [Element])]
ps,
    MarkupWarning -> Maybe MarkupWarning
forall a. a -> Maybe a
Just MarkupWarning
LeafWithChildren
  )
incCursor Standard
_ (EndTag ByteString
_) (Cursor [Element]
ss []) =
  ( [Element] -> [(Token, [Element])] -> Cursor
Cursor [Element]
ss [],
    MarkupWarning -> Maybe MarkupWarning
forall a. a -> Maybe a
Just MarkupWarning
UnmatchedEndTag
  )
incCursor Standard
_ Token
t (Cursor [Element]
ss [(Token, [Element])]
ps) = ([Element] -> [(Token, [Element])] -> Cursor
Cursor (Token -> [Element] -> Element
forall a. a -> [Tree a] -> Tree a
Node Token
t [] Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: [Element]
ss) [(Token, [Element])]
ps, Maybe MarkupWarning
forall a. Maybe a
Nothing)

data Cursor = Cursor
  { -- siblings, not (yet) part of another element
    Cursor -> [Element]
_sibs :: [Tree Token],
    -- open elements and their siblings.
    Cursor -> [(Token, [Element])]
_stack :: [(Token, [Tree Token])]
  }

-- | Convert a markup into a token list, adding end tags.
degather :: Standard -> Markup -> Warn [Token]
degather :: Standard -> Markup -> Warn [Token]
degather Standard
s (Markup [Element]
tree) = [Warn [Token]] -> Warn [Token]
forall a. [Warn [a]] -> Warn [a]
concatWarns ([Warn [Token]] -> Warn [Token]) -> [Warn [Token]] -> Warn [Token]
forall a b. (a -> b) -> a -> b
$ (Token -> [Warn [Token]] -> Warn [Token])
-> Element -> Warn [Token]
forall a b. (a -> [b] -> b) -> Tree a -> b
foldTree (Standard -> Token -> [Warn [Token]] -> Warn [Token]
addCloseTags Standard
s) (Element -> Warn [Token]) -> [Element] -> [Warn [Token]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Element]
tree

-- | 'degather' but errors on warning
degather_ :: Standard -> Markup -> [Token]
degather_ :: Standard -> Markup -> [Token]
degather_ Standard
s Markup
m = Standard -> Markup -> Warn [Token]
degather Standard
s Markup
m Warn [Token] -> (Warn [Token] -> [Token]) -> [Token]
forall a b. a -> (a -> b) -> b
& Warn [Token] -> [Token]
forall a. Warn a -> a
warnError

addCloseTags :: Standard -> Token -> [Warn [Token]] -> Warn [Token]
addCloseTags :: Standard -> Token -> [Warn [Token]] -> Warn [Token]
addCloseTags Standard
std s :: Token
s@(OpenTag OpenTagType
StartTag ByteString
n [Attr]
_) [Warn [Token]]
children
  | [Warn [Token]]
children [Warn [Token]] -> [Warn [Token]] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& ByteString
n ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
selfClosers Bool -> Bool -> Bool
&& Standard
std Standard -> Standard -> Bool
forall a. Eq a => a -> a -> Bool
== Standard
Html =
      [MarkupWarning] -> [Token] -> Warn [Token]
forall a b. a -> b -> These a b
These [MarkupWarning
SelfCloserWithChildren] [Token
s] Warn [Token] -> Warn [Token] -> Warn [Token]
forall a. Semigroup a => a -> a -> a
<> [Warn [Token]] -> Warn [Token]
forall a. [Warn [a]] -> Warn [a]
concatWarns [Warn [Token]]
children
  | ByteString
n ByteString -> [ByteString] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ByteString]
selfClosers Bool -> Bool -> Bool
&& Standard
std Standard -> Standard -> Bool
forall a. Eq a => a -> a -> Bool
== Standard
Html =
      [Token] -> Warn [Token]
forall a b. b -> These a b
That [Token
s] Warn [Token] -> Warn [Token] -> Warn [Token]
forall a. Semigroup a => a -> a -> a
<> [Warn [Token]] -> Warn [Token]
forall a. [Warn [a]] -> Warn [a]
concatWarns [Warn [Token]]
children
  | Bool
otherwise =
      [Token] -> Warn [Token]
forall a b. b -> These a b
That [Token
s] Warn [Token] -> Warn [Token] -> Warn [Token]
forall a. Semigroup a => a -> a -> a
<> [Warn [Token]] -> Warn [Token]
forall a. [Warn [a]] -> Warn [a]
concatWarns [Warn [Token]]
children Warn [Token] -> Warn [Token] -> Warn [Token]
forall a. Semigroup a => a -> a -> a
<> [Token] -> Warn [Token]
forall a b. b -> These a b
That [ByteString -> Token
EndTag ByteString
n]
addCloseTags Standard
_ Token
x [Warn [Token]]
xs = case [Warn [Token]]
xs of
  [] -> [Token] -> Warn [Token]
forall a b. b -> These a b
That [Token
x]
  [Warn [Token]]
cs -> [MarkupWarning] -> [Token] -> Warn [Token]
forall a b. a -> b -> These a b
These [MarkupWarning
LeafWithChildren] [Token
x] Warn [Token] -> Warn [Token] -> Warn [Token]
forall a. Semigroup a => a -> a -> a
<> [Warn [Token]] -> Warn [Token]
forall a. [Warn [a]] -> Warn [a]
concatWarns [Warn [Token]]
cs