{-
    Copyright 2009-2012 Mario Blazevic

    This file is part of the Streaming Component Combinators (SCC) project.

    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public
    License as published by the Free Software Foundation, either version 3 of the License, or (at your moptional) any later
    version.

    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along with SCC.  If not, see
    <http://www.gnu.org/licenses/>.
-}

-- | Module "XML" defines primitives and combinators for parsing and manipulating XML.

{-# LANGUAGE PatternGuards, FlexibleContexts, MultiParamTypeClasses, OverloadedStrings,
             ScopedTypeVariables, Rank2Types #-}
{-# OPTIONS_HADDOCK hide #-}

module Control.Concurrent.SCC.XML (
   -- * Parsing XML
   xmlTokens, parseXMLTokens, expandXMLEntity, XMLToken(..),
   -- * XML splitters
   xmlElement, xmlElementContent, xmlElementName, xmlAttribute, xmlAttributeName, xmlAttributeValue,
   xmlElementHavingTagWith
   )
where

import Prelude hiding (takeWhile)

import Control.Applicative (Alternative ((<|>)))
import Control.Arrow ((>>>))
import Control.Monad (when)
import Data.Char
import Data.Maybe (mapMaybe)
import Data.Monoid (Monoid(..))
import Data.List (find)
import Data.String (IsString(fromString))
import Data.Text (Text, pack, unpack, singleton)
import qualified Data.Text as Text
import Numeric (readDec, readHex)

import Text.ParserCombinators.Incremental (Parser, more, feed, anyToken, satisfy, concatMany, takeWhile, takeWhile1, 
                                           string, moptional, skip, lookAhead, notFollowedBy, mapIncremental, (><))
import qualified Text.ParserCombinators.Incremental.LeftBiasedLocal as LeftBiasedLocal (Parser)
import Text.ParserCombinators.Incremental.LeftBiasedLocal (leftmost)
import Control.Monad.Coroutine (Coroutine, sequentialBinder)

import Control.Concurrent.SCC.Streams
import Control.Concurrent.SCC.Types hiding (Parser)
import Control.Concurrent.SCC.Coercions (coerce)
import Control.Concurrent.SCC.Combinators (parserToSplitter, findsTrueIn)

data XMLToken = StartTag | EndTag | EmptyTag
              | ElementName | AttributeName | AttributeValue
              | EntityReference | EntityName
              | ProcessingInstruction | ProcessingInstructionText
              | Comment | CommentText
              | StartMarkedSectionCDATA | EndMarkedSection | DoctypeDeclaration
              | ErrorToken String
                deriving (XMLToken -> XMLToken -> Bool
(XMLToken -> XMLToken -> Bool)
-> (XMLToken -> XMLToken -> Bool) -> Eq XMLToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XMLToken -> XMLToken -> Bool
$c/= :: XMLToken -> XMLToken -> Bool
== :: XMLToken -> XMLToken -> Bool
$c== :: XMLToken -> XMLToken -> Bool
Eq, Int -> XMLToken -> ShowS
[XMLToken] -> ShowS
XMLToken -> String
(Int -> XMLToken -> ShowS)
-> (XMLToken -> String) -> ([XMLToken] -> ShowS) -> Show XMLToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XMLToken] -> ShowS
$cshowList :: [XMLToken] -> ShowS
show :: XMLToken -> String
$cshow :: XMLToken -> String
showsPrec :: Int -> XMLToken -> ShowS
$cshowsPrec :: Int -> XMLToken -> ShowS
Show)

-- | Converts an XML entity name into the text value it represents: @expandXMLEntity \"lt\" = \"<\"@.
expandXMLEntity :: String -> String
expandXMLEntity :: ShowS
expandXMLEntity String
"lt" = String
"<"
expandXMLEntity String
"gt" = String
">"
expandXMLEntity String
"quot" = String
"\""
expandXMLEntity String
"apos" = String
"'"
expandXMLEntity String
"amp" = String
"&"
expandXMLEntity (Char
'#' : Char
'x' : String
codePoint) = [Int -> Char
chr ((Int, String) -> Int
forall a b. (a, b) -> a
fst ((Int, String) -> Int) -> (Int, String) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, String)] -> (Int, String)
forall a. [a] -> a
head ([(Int, String)] -> (Int, String))
-> [(Int, String)] -> (Int, String)
forall a b. (a -> b) -> a -> b
$ ReadS Int
forall a. (Eq a, Num a) => ReadS a
readHex String
codePoint)]
expandXMLEntity (Char
'#' : String
codePoint) = [Int -> Char
chr ((Int, String) -> Int
forall a b. (a, b) -> a
fst ((Int, String) -> Int) -> (Int, String) -> Int
forall a b. (a -> b) -> a -> b
$ [(Int, String)] -> (Int, String)
forall a. [a] -> a
head ([(Int, String)] -> (Int, String))
-> [(Int, String)] -> (Int, String)
forall a b. (a -> b) -> a -> b
$ ReadS Int
forall a. (Eq a, Num a) => ReadS a
readDec String
codePoint)]
expandXMLEntity String
e = ShowS
forall a. HasCallStack => String -> a
error (String
"String \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" is not a built-in entity name.")

newtype XMLStream = XMLStream {XMLStream -> [Markup XMLToken Text]
chunk :: [Markup XMLToken Text]} deriving (Int -> XMLStream -> ShowS
[XMLStream] -> ShowS
XMLStream -> String
(Int -> XMLStream -> ShowS)
-> (XMLStream -> String)
-> ([XMLStream] -> ShowS)
-> Show XMLStream
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XMLStream] -> ShowS
$cshowList :: [XMLStream] -> ShowS
show :: XMLStream -> String
$cshow :: XMLStream -> String
showsPrec :: Int -> XMLStream -> ShowS
$cshowsPrec :: Int -> XMLStream -> ShowS
Show)

instance Semigroup XMLStream where
   XMLStream
l <> :: XMLStream -> XMLStream -> XMLStream
<> XMLStream [] = XMLStream
l
   XMLStream [] <> XMLStream
r = XMLStream
r
   XMLStream [Markup XMLToken Text]
l <> XMLStream r :: [Markup XMLToken Text]
r@((Content Text
rc):[Markup XMLToken Text]
rt) =
      case [Markup XMLToken Text] -> Markup XMLToken Text
forall a. [a] -> a
last [Markup XMLToken Text]
l
      of Content Text
lc -> [Markup XMLToken Text] -> XMLStream
XMLStream ([Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a]
init [Markup XMLToken Text]
l [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content (Text
lc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rc) Markup XMLToken Text
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> [a] -> [a]
: [Markup XMLToken Text]
rt)
         Markup XMLToken Text
_ -> [Markup XMLToken Text] -> XMLStream
XMLStream ([Markup XMLToken Text]
l [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text]
r)
   XMLStream [Markup XMLToken Text]
l <> XMLStream [Markup XMLToken Text]
r = [Markup XMLToken Text] -> XMLStream
XMLStream ([Markup XMLToken Text]
l [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text]
r)

instance Monoid XMLStream where
   mempty :: XMLStream
mempty = [Markup XMLToken Text] -> XMLStream
XMLStream []
   mappend :: XMLStream -> XMLStream -> XMLStream
mappend = XMLStream -> XMLStream -> XMLStream
forall a. Semigroup a => a -> a -> a
(<>)

xmlParser :: LeftBiasedLocal.Parser Text XMLStream
xmlParser :: Parser Text XMLStream
xmlParser = Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany (Parser Text XMLStream
forall p. Parser p Text XMLStream
xmlContent Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
xmlMarkup)
   where xmlContent :: Parser p Text XMLStream
xmlContent = Parser p Text Text -> Parser p Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Parser p Text Text -> Parser p Text XMLStream)
-> Parser p Text Text -> Parser p Text XMLStream
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> Parser p Text Text
forall s t.
(FactorialMonoid s, MonoidNull s) =>
(s -> Bool) -> Parser t s s
takeWhile1 (\Text
x-> Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"<" Bool -> Bool -> Bool
&& Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"&")
         xmlMarkup :: Parser Text XMLStream
xmlMarkup = (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"<" Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Parser Text XMLStream
startTag Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
endTag Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
processingInstruction Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
declaration)
                                     Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
errorUnescapedContentLT,
                                                             Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content (Char -> Text
singleton Char
'<')])))
                     Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                     Text -> Parser Text XMLStream
forall t.
Alternative (Parser t Text) =>
Text -> Parser t Text XMLStream
entityReference Text
"&"
         startTag :: Parser Text XMLStream
startTag = XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
StartTag), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content (Char -> Text
singleton Char
'<'), Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
ElementName)])
                    Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
name
                    Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
ElementName)])
                    Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace
                    Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
attributes
                    Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
moptional (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"/" Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
EmptyTag), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content (Char -> Text
singleton Char
'/')]))
                    Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace
                    Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
">" Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content (Char -> Text
singleton Char
'>'), Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
StartTag)])
                        Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
unterminatedStartTag, Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
StartTag]))
         entityReference :: Text -> Parser t Text XMLStream
entityReference Text
s = Text -> Parser t Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
s
                             Parser t Text Text
-> Parser t Text XMLStream -> Parser t Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (XMLStream -> Parser t Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
EntityReference), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
s,
                                                    Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
EntityName)])
                                 Parser t Text XMLStream
-> Parser t Text XMLStream -> Parser t Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser t Text XMLStream
forall p. Parser p Text XMLStream
name
                                 Parser t Text XMLStream
-> Parser t Text XMLStream -> Parser t Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Text -> Parser t Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
";" Parser t Text Text
-> Parser t Text XMLStream -> Parser t Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser t Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
EntityName), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content (Char -> Text
singleton Char
';'),
                                                                      Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
EntityReference)]))
                                 Parser t Text XMLStream
-> Parser t Text XMLStream -> Parser t Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser t Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point (XMLToken -> Boundary XMLToken) -> XMLToken -> Boundary XMLToken
forall a b. (a -> b) -> a -> b
$ XMLToken
errorBadEntityReference, Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
s]))
         attributes :: Parser Text XMLStream
attributes = Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany (Parser Text XMLStream
attribute Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace)
         attribute :: Parser Text XMLStream
attribute = XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
AttributeName)])
                     Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
name
                     Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
AttributeName)])
                     Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"=")
                         Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((Text -> XMLStream)
-> Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Text
x-> [Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point (XMLToken -> Boundary XMLToken) -> XMLToken -> Boundary XMLToken
forall a b. (a -> b) -> a -> b
$ Text -> XMLToken
forall a. Show a => a -> XMLToken
errorBadAttribute Text
x]) Parser LeftBiasedLocal Text Text
forall s t. FactorialMonoid s => Parser t s s
anyToken
                               Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
moptional (Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Parser LeftBiasedLocal Text Text -> Parser Text XMLStream)
-> Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall a b. (a -> b) -> a -> b
$ Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"=")))
                     Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< ((Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"\"" Parser LeftBiasedLocal Text Text
-> Parser LeftBiasedLocal Text Text
-> Parser LeftBiasedLocal Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"\'")
                         Parser LeftBiasedLocal Text Text
-> (Text -> Parser Text XMLStream) -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
quote-> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
quote, Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
AttributeValue)])
                                      Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent ((Text -> Bool) -> Parser LeftBiasedLocal Text Text
forall s t.
(FactorialMonoid s, MonoidNull s) =>
(s -> Bool) -> Parser t s s
takeWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
quote))
                                      Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
AttributeValue), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
quote])
                                      Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall s r t r'.
(Monoid s, Monoid r, Semigroup r) =>
Parser t s r' -> Parser t s r
skip (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
quote)
                         Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser LeftBiasedLocal Text Text
forall s t. FactorialMonoid s => Parser t s s
anyToken Parser LeftBiasedLocal Text Text
-> (Text -> Parser Text XMLStream) -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
q-> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point (XMLToken -> Boundary XMLToken) -> XMLToken -> Boundary XMLToken
forall a b. (a -> b) -> a -> b
$ Text -> XMLToken
forall a. Show a => a -> XMLToken
errorBadQuoteCharacter Text
q,
                                                                    Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
quote])))
         endTag :: Parser Text XMLStream
endTag = (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"/" Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
EndTag), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"</", Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
ElementName)]))
                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
name
                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
ElementName)])
                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace
                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
">" Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content (Char -> Text
singleton Char
'>'), Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
EndTag)])
                      Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
unterminatedEndTag, Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
EndTag)]))
         processingInstruction :: Parser Text XMLStream
processingInstruction = (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"?"
                                  Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
ProcessingInstruction), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"<?",
                                                        Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
ProcessingInstructionText)]))
                                 Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< String -> Parser Text XMLStream
forall p.
Alternative (Parser p Text) =>
String -> Parser p Text XMLStream
upto String
"?>"
                                 Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"?>"
                                     Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
ProcessingInstructionText), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"?>",
                                                           Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
ProcessingInstruction)])
                                     Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
unterminatedProcessingInstruction]))
         declaration :: Parser Text XMLStream
declaration = Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"!"
                       Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((Parser Text XMLStream
comment Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
cdataMarkedSection Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
doctypeDeclaration)
                           Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point (XMLToken -> Boundary XMLToken) -> XMLToken -> Boundary XMLToken
forall a b. (a -> b) -> a -> b
$ XMLToken
errorBadDeclarationType, Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"<"]))
         comment :: Parser Text XMLStream
comment = (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"--" Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
Comment), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"<!--",
                                                       Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
CommentText)]))
                   Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< String -> Parser Text XMLStream
forall p.
Alternative (Parser p Text) =>
String -> Parser p Text XMLStream
upto String
"-->"
                   Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"-->" Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
CommentText), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"-->",
                                                          Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
Comment)])
                       Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
unterminatedComment]))
         cdataMarkedSection :: Parser Text XMLStream
cdataMarkedSection = (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"[CDATA["
                               Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
StartMarkedSectionCDATA), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"<![CDATA[",
                                                     Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
StartMarkedSectionCDATA)]))
                              Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< String -> Parser Text XMLStream
forall p.
Alternative (Parser p Text) =>
String -> Parser p Text XMLStream
upto String
"]]>"
                              Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"]]>"
                                  Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
EndMarkedSection), Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"]]>",
                                                        Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
EndMarkedSection)])
                                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
unterminatedMarkedSection]))
         doctypeDeclaration :: Parser Text XMLStream
doctypeDeclaration = (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"DOCTYPE" Parser LeftBiasedLocal Text Text
-> Parser Text XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
DoctypeDeclaration),
                                                                       Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
"<!DOCTYPE"]))
                              Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace
                              Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Parser Text XMLStream
forall p. Parser p Text XMLStream
name
                                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace
                                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
moptional ((Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"SYSTEM")
                                              Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"PUBLIC") Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
literal)
                                             Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
literal Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace)
                                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
moptional (Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"[") Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace
                                             Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany ((Parser Text XMLStream
markupDeclaration Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
comment Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
processingInstruction
                                                        Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text XMLStream
forall t.
Alternative (Parser t Text) =>
Text -> Parser t Text XMLStream
entityReference Text
"%")
                                                       Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace)
                                             Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"]") Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser Text XMLStream
forall p. Parser p Text XMLStream
whiteSpace)
                                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
">")
                                  Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
errorMalformedDoctypeDeclaration)]))
                              Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
DoctypeDeclaration)])
         literal :: Parser Text XMLStream
literal = (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"\"" Parser LeftBiasedLocal Text Text
-> Parser LeftBiasedLocal Text Text
-> Parser LeftBiasedLocal Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"\'")
                   Parser LeftBiasedLocal Text Text
-> (Text -> Parser Text XMLStream) -> Parser Text XMLStream
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
quote-> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
quote])
                                Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent ((Text -> Bool) -> Parser LeftBiasedLocal Text Text
forall s t.
(FactorialMonoid s, MonoidNull s) =>
(s -> Bool) -> Parser t s s
takeWhile (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
quote))
                                Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content Text
quote])
                                Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall s r t r'.
(Monoid s, Monoid r, Semigroup r) =>
Parser t s r' -> Parser t s r
skip (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
quote)
         markupDeclaration :: Parser Text XMLStream
markupDeclaration= Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
"<!")
                            Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< (Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany (Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent ((Text -> Bool) -> Parser LeftBiasedLocal Text Text
forall s t.
(FactorialMonoid s, MonoidNull s) =>
(s -> Bool) -> Parser t s s
takeWhile1 (\Text
x-> Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
">" Bool -> Bool -> Bool
&& Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"\"" Bool -> Bool -> Bool
&& Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"\'")) Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text XMLStream
literal)
                                Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser LeftBiasedLocal Text Text -> Parser Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Text -> Parser LeftBiasedLocal Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string Text
">")
                                Parser Text XMLStream
-> Parser Text XMLStream -> Parser Text XMLStream
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLStream -> Parser Text XMLStream
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> XMLStream
XMLStream [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (Boundary XMLToken -> Markup XMLToken Text)
-> Boundary XMLToken -> Markup XMLToken Text
forall a b. (a -> b) -> a -> b
$ XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Point XMLToken
unterminatedMarkupDeclaration]))
         name :: Parser p Text XMLStream
name = Parser p Text Text -> Parser p Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent ((Text -> Bool) -> Parser p Text Text
forall s t.
(FactorialMonoid s, MonoidNull s) =>
(s -> Bool) -> Parser t s s
takeWhile1 (Char -> Bool
isNameChar (Char -> Bool) -> (Text -> Char) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
Text.head))
         mapContent :: Parser p Text Text -> Parser p Text XMLStream
mapContent = (Text -> XMLStream)
-> Parser p Text Text -> Parser p Text XMLStream
forall s a b p.
(Monoid s, Monoid a, Monoid b) =>
(a -> b) -> Parser p s a -> Parser p s b
mapIncremental ([Markup XMLToken Text] -> XMLStream
XMLStream ([Markup XMLToken Text] -> XMLStream)
-> (Text -> [Markup XMLToken Text]) -> Text -> XMLStream
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup XMLToken Text
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> [a] -> [a]
:[]) (Markup XMLToken Text -> [Markup XMLToken Text])
-> (Text -> Markup XMLToken Text) -> Text -> [Markup XMLToken Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Markup XMLToken Text
forall y x. x -> Markup y x
Content)
         whiteSpace :: Parser p Text XMLStream
whiteSpace = Parser p Text Text -> Parser p Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent ((Text -> Bool) -> Parser p Text Text
forall s t.
(FactorialMonoid s, MonoidNull s) =>
(s -> Bool) -> Parser t s s
takeWhile (Char -> Bool
isSpace (Char -> Bool) -> (Text -> Char) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
Text.head))
         upto :: String -> Parser p Text XMLStream
upto end :: String
end@(Char
lead:String
_) = Parser p Text Text -> Parser p Text XMLStream
forall p. Parser p Text Text -> Parser p Text XMLStream
mapContent (Parser p Text Text -> Parser p Text Text
forall (f :: * -> *) a.
(MonoidAlternative f, Semigroup a, Monoid a) =>
f a -> f a
concatMany ((Text -> Bool) -> Parser p Text Text
forall s t.
(FactorialMonoid s, MonoidNull s) =>
(s -> Bool) -> Parser t s s
takeWhile1 ((Char
lead Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Char -> Bool) -> (Text -> Char) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
Text.head)
                                                     Parser p Text Text -> Parser p Text Text -> Parser p Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser p Text Text -> Parser p Text Text
forall s r t r'.
(Monoid s, Monoid r) =>
Parser t s r' -> Parser t s r
notFollowedBy (Text -> Parser p Text Text
forall s t.
(LeftReductiveMonoid s, MonoidNull s, Semigroup s) =>
s -> Parser t s s
string (Text -> Parser p Text Text) -> Text -> Parser p Text Text
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
end) Parser p Text Text -> Parser p Text Text -> Parser p Text Text
forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< Parser p Text Text
forall s t. FactorialMonoid s => Parser t s s
anyToken))

errorBadQuoteCharacter :: a -> XMLToken
errorBadQuoteCharacter a
q = String -> XMLToken
ErrorToken (String
"Invalid quote character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
q)
errorBadAttribute :: a -> XMLToken
errorBadAttribute a
x = String -> XMLToken
ErrorToken (String
"Invalid character " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" following attribute name")
errorBadEntityReference :: XMLToken
errorBadEntityReference = String -> XMLToken
ErrorToken String
"Invalid entity reference."
errorBadDeclarationType :: XMLToken
errorBadDeclarationType = String -> XMLToken
ErrorToken String
"The \"<!\" sequence must be followed by \"[CDATA[\" or \"--\"."
errorMalformedDoctypeDeclaration :: XMLToken
errorMalformedDoctypeDeclaration = String -> XMLToken
ErrorToken String
"Malformed DOCTYPE declaration."
errorUnescapedContentLT :: XMLToken
errorUnescapedContentLT = String -> XMLToken
ErrorToken String
"Unescaped character '<' in content"
unterminatedComment :: XMLToken
unterminatedComment = String -> XMLToken
ErrorToken String
"Unterminated comment."
unterminatedMarkedSection :: XMLToken
unterminatedMarkedSection = String -> XMLToken
ErrorToken String
"Unterminated marked section."
unterminatedMarkupDeclaration :: XMLToken
unterminatedMarkupDeclaration = String -> XMLToken
ErrorToken String
"Unterminated markup declaration."
unterminatedStartTag :: XMLToken
unterminatedStartTag = String -> XMLToken
ErrorToken String
"Missing '>' at the end of start tag."
unterminatedEndTag :: XMLToken
unterminatedEndTag = String -> XMLToken
ErrorToken String
"Missing '>' at the end of end tag."
unterminatedProcessingInstruction :: XMLToken
unterminatedProcessingInstruction = String -> XMLToken
ErrorToken String
"Unterminated processing instruction."

isNameStart :: Char -> Bool
isNameStart Char
x = Char -> Bool
isLetter Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

isNameChar :: Char -> Bool
isNameChar Char
x = Char -> Bool
isAlphaNum 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 markup splitter wrapping 'parseXMLTokens'.
xmlTokens :: Monad m => Splitter m Text
xmlTokens :: Splitter m Text
xmlTokens = Parser m Text XMLToken -> Splitter m Text
forall (m :: * -> *) x b.
(Monad m, Monoid x) =>
Parser m x b -> Splitter m x
parserToSplitter Parser m Text XMLToken
forall (m :: * -> *).
Monad m =>
Transducer m Text [Markup XMLToken Text]
parseXMLTokens

-- | The XML token parser. This parser converts plain text to parsed text, which is a precondition for using the
-- remaining XML components.
parseXMLTokens :: Monad m => Transducer m Text [Markup XMLToken Text]
parseXMLTokens :: Transducer m Text [Markup XMLToken Text]
parseXMLTokens = (forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
 OpenTransducer m a1 a2 d Text [Markup XMLToken Text] ())
-> Transducer m Text [Markup XMLToken Text]
forall (m :: * -> *) x y.
(forall (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
 OpenTransducer m a1 a2 d x y ())
-> Transducer m x y
Transducer (Parser LeftBiasedLocal Text [Markup XMLToken Text]
-> Source m a1 Text
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m ()
forall (m :: * -> *) p (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *)
       x y.
(Monad m, MonoidNull x, MonoidNull y, AncestorFunctor a1 d,
 AncestorFunctor a2 d) =>
Parser p x y -> Source m a1 x -> Sink m a2 y -> Coroutine d m ()
pourParsed ((XMLStream -> [Markup XMLToken Text])
-> Parser Text XMLStream
-> Parser LeftBiasedLocal Text [Markup XMLToken Text]
forall s a b p.
(Monoid s, Monoid a, Monoid b) =>
(a -> b) -> Parser p s a -> Parser p s b
mapIncremental XMLStream -> [Markup XMLToken Text]
chunk Parser Text XMLStream
xmlParser))

dispatchOnString :: forall m a d r. (Monad m, AncestorFunctor a d) =>
                    Source m a [Char] -> (String -> Coroutine d m r) -> [(String, String -> Coroutine d m r)]
                 -> Coroutine d m r
dispatchOnString :: Source m a String
-> (String -> Coroutine d m r)
-> [(String, String -> Coroutine d m r)]
-> Coroutine d m r
dispatchOnString Source m a String
source String -> Coroutine d m r
failure [(String, String -> Coroutine d m r)]
fullCases = [(String, String -> Coroutine d m r)] -> ShowS -> Coroutine d m r
dispatch [(String, String -> Coroutine d m r)]
fullCases ShowS
forall a. a -> a
id
   where dispatch :: [(String, String -> Coroutine d m r)] -> ShowS -> Coroutine d m r
dispatch [(String, String -> Coroutine d m r)]
cases ShowS
consumed
            = case ((String, String -> Coroutine d m r) -> Bool)
-> [(String, String -> Coroutine d m r)]
-> Maybe (String, String -> Coroutine d m r)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool)
-> ((String, String -> Coroutine d m r) -> String)
-> (String, String -> Coroutine d m r)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String -> Coroutine d m r) -> String
forall a b. (a, b) -> a
fst) [(String, String -> Coroutine d m r)]
cases
              of Just (~String
"", String -> Coroutine d m r
rhs) -> String -> Coroutine d m r
rhs (ShowS
consumed String
"")
                 Maybe (String, String -> Coroutine d m r)
Nothing -> Source m a String -> Coroutine d m (Maybe Char)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
get Source m a String
source
                            Coroutine d m (Maybe Char)
-> (Maybe Char -> Coroutine d m r) -> Coroutine d m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m r
-> (Char -> Coroutine d m r) -> Maybe Char -> Coroutine d m r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                   (String -> Coroutine d m r
failure (ShowS
consumed String
""))
                                   (\Char
x-> case ((String, String -> Coroutine d m r)
 -> Maybe (String, String -> Coroutine d m r))
-> [(String, String -> Coroutine d m r)]
-> [(String, String -> Coroutine d m r)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Char
-> (String, String -> Coroutine d m r)
-> Maybe (String, String -> Coroutine d m r)
forall a b. Eq a => a -> ([a], b) -> Maybe ([a], b)
startingWith Char
x) [(String, String -> Coroutine d m r)]
cases
                                         of [] -> String -> Coroutine d m r
failure (ShowS
consumed [Char
x])
                                            [(String, String -> Coroutine d m r)]
subcases -> [(String, String -> Coroutine d m r)] -> ShowS -> Coroutine d m r
dispatch ([(String, String -> Coroutine d m r)]
subcases [(String, String -> Coroutine d m r)]
-> [(String, String -> Coroutine d m r)]
-> [(String, String -> Coroutine d m r)]
forall a. [a] -> [a] -> [a]
++ [(String, String -> Coroutine d m r)]
fullCases) (ShowS
consumed ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
x Char -> ShowS
forall a. a -> [a] -> [a]
:)))
         startingWith :: a -> ([a], b) -> Maybe ([a], b)
startingWith a
x ~(a
y:[a]
rest, b
rhs) | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = ([a], b) -> Maybe ([a], b)
forall a. a -> Maybe a
Just ([a]
rest, b
rhs)
                                       | Bool
otherwise = Maybe ([a], b)
forall a. Maybe a
Nothing

getElementName :: forall m a d. (Monad m, AncestorFunctor a d) =>
                  Source m a [Markup XMLToken Text] -> ([Markup XMLToken Text] -> [Markup XMLToken Text])
               -> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName :: Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName Source m a [Markup XMLToken Text]
source [Markup XMLToken Text] -> [Markup XMLToken Text]
f = Source m a [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
get Source m a [Markup XMLToken Text]
source
                          Coroutine d m (Maybe (Markup XMLToken Text))
-> (Maybe (Markup XMLToken Text)
    -> Coroutine d m ([Markup XMLToken Text], Maybe Text))
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m ([Markup XMLToken Text], Maybe Text)
-> (Markup XMLToken Text
    -> Coroutine d m ([Markup XMLToken Text], Maybe Text))
-> Maybe (Markup XMLToken Text)
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                 (([Markup XMLToken Text], Maybe Text)
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> [Markup XMLToken Text]
f [], Maybe Text
forall a. Maybe a
Nothing))
                                 (\Markup XMLToken Text
x-> let f' :: [Markup XMLToken Text] -> [Markup XMLToken Text]
f' = [Markup XMLToken Text] -> [Markup XMLToken Text]
f ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> [Markup XMLToken Text]
-> [Markup XMLToken Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup XMLToken Text
xMarkup XMLToken Text
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> [a] -> [a]
:)
                                       in case Markup XMLToken Text
x
                                          of Markup (Start XMLToken
ElementName) -> XMLToken
-> Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> (Text -> Text)
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
XMLToken
-> Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> (Text -> Text)
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getRestOfRegion XMLToken
ElementName Source m a [Markup XMLToken Text]
source [Markup XMLToken Text] -> [Markup XMLToken Text]
f' Text -> Text
forall a. a -> a
id
                                             Markup (Point ErrorToken{}) -> Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName Source m a [Markup XMLToken Text]
source [Markup XMLToken Text] -> [Markup XMLToken Text]
f'
                                             Content{} -> Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName Source m a [Markup XMLToken Text]
source [Markup XMLToken Text] -> [Markup XMLToken Text]
f'
                                             Markup XMLToken Text
_ -> String -> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall a. HasCallStack => String -> a
error (String
"Expected an ElementName, received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Markup XMLToken Text -> String
forall a. Show a => a -> String
show Markup XMLToken Text
x))

getRestOfRegion :: forall m a d. (Monad m, AncestorFunctor a d) =>
                   XMLToken -> Source m a [Markup XMLToken Text]
                -> ([Markup XMLToken Text] -> [Markup XMLToken Text]) -> (Text -> Text)
                -> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getRestOfRegion :: XMLToken
-> Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> (Text -> Text)
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getRestOfRegion XMLToken
token Source m a [Markup XMLToken Text]
source [Markup XMLToken Text] -> [Markup XMLToken Text]
f Text -> Text
g = ([Markup XMLToken Text] -> Bool)
-> Source m a [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
(x -> Bool) -> Source m a x -> Coroutine d m x
getWhile [Markup XMLToken Text] -> Bool
forall b x. [Markup b x] -> Bool
isContent Source m a [Markup XMLToken Text]
source
                                   Coroutine d m [Markup XMLToken Text]
-> ([Markup XMLToken Text]
    -> Coroutine d m ([Markup XMLToken Text], Maybe Text))
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Markup XMLToken Text]
content-> Source m a [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
get Source m a [Markup XMLToken Text]
source
                                   Coroutine d m (Maybe (Markup XMLToken Text))
-> (Maybe (Markup XMLToken Text)
    -> Coroutine d m ([Markup XMLToken Text], Maybe Text))
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe (Markup XMLToken Text)
x-> case Maybe (Markup XMLToken Text)
x
                                            of Just y :: Markup XMLToken Text
y@(Markup End{})
                                                  -> ([Markup XMLToken Text], Maybe Text)
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> [Markup XMLToken Text]
f ([Markup XMLToken Text]
content [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text
y]),
                                                             Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Text
g (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Markup XMLToken Text -> Text) -> [Markup XMLToken Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Markup XMLToken Text -> Text
forall b x. Markup b x -> x
fromContent [Markup XMLToken Text]
content))
                                               Maybe (Markup XMLToken Text)
_ -> String -> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall a. HasCallStack => String -> a
error (String
"Expected rest of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ XMLToken -> String
forall a. Show a => a -> String
show XMLToken
token String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe (Markup XMLToken Text) -> String
forall a. Show a => a -> String
show Maybe (Markup XMLToken Text)
x)

pourRestOfRegion :: forall m a1 a2 a3 d. (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d, AncestorFunctor a3 d) =>
                    XMLToken -> Source m a1 [Markup XMLToken Text]
                           -> Sink m a2 [Markup XMLToken Text] -> Sink m a3 [Markup XMLToken Text]
                 -> Coroutine d m Bool
pourRestOfRegion :: XMLToken
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m Bool
pourRestOfRegion XMLToken
token Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
sink Sink m a3 [Markup XMLToken Text]
endSink = ([Markup XMLToken Text] -> Bool)
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a1 d,
 AncestorFunctor a2 d) =>
(x -> Bool) -> Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pourWhile [Markup XMLToken Text] -> Bool
forall b x. [Markup b x] -> Bool
isContent Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
sink
                                             Coroutine d m ()
-> Coroutine d m (Maybe (Markup XMLToken Text))
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Source m a1 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
get Source m a1 [Markup XMLToken Text]
source
                                             Coroutine d m (Maybe (Markup XMLToken Text))
-> (Maybe (Markup XMLToken Text) -> Coroutine d m Bool)
-> Coroutine d m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m Bool
-> (Markup XMLToken Text -> Coroutine d m Bool)
-> Maybe (Markup XMLToken Text)
-> Coroutine d m Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                                    (Bool -> Coroutine d m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
                                                    (\Markup XMLToken Text
x-> case Markup XMLToken Text
x
                                                          of Markup (End XMLToken
token') | XMLToken
token XMLToken -> XMLToken -> Bool
forall a. Eq a => a -> a -> Bool
== XMLToken
token' -> Sink m a3 [Markup XMLToken Text]
-> Markup XMLToken Text -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m a3 [Markup XMLToken Text]
endSink Markup XMLToken Text
x
                                                                                                      Coroutine d m () -> Coroutine d m Bool -> Coroutine d m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Coroutine d m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                                                             Markup XMLToken Text
_ -> String -> Coroutine d m Bool
forall a. HasCallStack => String -> a
error (String
"Expected rest of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ XMLToken -> String
forall a. Show a => a -> String
show XMLToken
token
                                                                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Markup XMLToken Text -> String
forall a. Show a => a -> String
show Markup XMLToken Text
x))

getRestOfStartTag :: forall m a d. (Monad m, AncestorFunctor a d) =>
                     Source m a [Markup XMLToken Text] -> Coroutine d m ([Markup XMLToken Text], Bool)
getRestOfStartTag :: Source m a [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
getRestOfStartTag Source m a [Markup XMLToken Text]
source = do [Markup XMLToken Text]
rest <- ([Markup XMLToken Text] -> Bool)
-> Source m a [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
(x -> Bool) -> Source m a x -> Coroutine d m x
getWhile [Markup XMLToken Text] -> Bool
forall x. [Markup XMLToken x] -> Bool
notEndTag Source m a [Markup XMLToken Text]
source
                              Maybe (Markup XMLToken Text)
end <- Source m a [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
get Source m a [Markup XMLToken Text]
source
                              case Maybe (Markup XMLToken Text)
end of Maybe (Markup XMLToken Text)
Nothing -> ([Markup XMLToken Text], Bool)
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text]
rest, Bool
False)
                                          Just e :: Markup XMLToken Text
e@(Markup (End XMLToken
StartTag)) -> ([Markup XMLToken Text], Bool)
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text]
rest [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text
e], Bool
True)
                                          Just e :: Markup XMLToken Text
e@(Markup (Point XMLToken
EmptyTag)) ->
                                             Source m a [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
getRestOfStartTag Source m a [Markup XMLToken Text]
source
                                             Coroutine d m ([Markup XMLToken Text], Bool)
-> (([Markup XMLToken Text], Bool)
    -> Coroutine d m ([Markup XMLToken Text], Bool))
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \([Markup XMLToken Text]
rest', Bool
_)-> ([Markup XMLToken Text], Bool)
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text]
rest [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ (Markup XMLToken Text
eMarkup XMLToken Text
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> [a] -> [a]
: [Markup XMLToken Text]
rest'), Bool
False)
                                          Maybe (Markup XMLToken Text)
_ -> String -> Coroutine d m ([Markup XMLToken Text], Bool)
forall a. HasCallStack => String -> a
error String
"getWhile returned early!"
   where notEndTag :: [Markup XMLToken x] -> Bool
notEndTag [Markup (End XMLToken
StartTag)] = Bool
False
         notEndTag [Markup (Point XMLToken
EmptyTag)] = Bool
False
         notEndTag [Markup XMLToken x]
_ = Bool
True

getRestOfEndTag :: forall m a d. (Monad m, AncestorFunctor a d) =>
                   Source m a [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
getRestOfEndTag :: Source m a [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
getRestOfEndTag Source m a [Markup XMLToken Text]
source = ([Markup XMLToken Text] -> Bool)
-> Source m a [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
(x -> Bool) -> Source m a x -> Coroutine d m x
getWhile ([Markup XMLToken Text] -> [Markup XMLToken Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
End XMLToken
EndTag)]) Source m a [Markup XMLToken Text]
source
                         Coroutine d m [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text])
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Markup XMLToken Text]
tokens-> Source m a [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
get Source m a [Markup XMLToken Text]
source
                                       Coroutine d m (Maybe (Markup XMLToken Text))
-> (Maybe (Markup XMLToken Text)
    -> Coroutine d m [Markup XMLToken Text])
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m [Markup XMLToken Text]
-> (Markup XMLToken Text -> Coroutine d m [Markup XMLToken Text])
-> Maybe (Markup XMLToken Text)
-> Coroutine d m [Markup XMLToken Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Coroutine d m [Markup XMLToken Text]
forall a. HasCallStack => String -> a
error String
"No end to the end tag!") ([Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text])
-> (Markup XMLToken Text -> [Markup XMLToken Text])
-> Markup XMLToken Text
-> Coroutine d m [Markup XMLToken Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Markup XMLToken Text]
tokens [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++) ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> (Markup XMLToken Text -> [Markup XMLToken Text])
-> Markup XMLToken Text
-> [Markup XMLToken Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Markup XMLToken Text
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> [a] -> [a]
:[]))

findEndTag :: forall m a1 a2 a3 d. (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d, AncestorFunctor a3 d) =>
              Source m a1 [Markup XMLToken Text] -> Sink m a2 [Markup XMLToken Text] -> Sink m a3 [Markup XMLToken Text]
              -> Text
              -> Coroutine d m ()
findEndTag :: Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
findEndTag Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
sink Sink m a3 [Markup XMLToken Text]
endSink Text
name = Coroutine d m ()
findTag where
   findTag :: Coroutine d m ()
findTag = ([Markup XMLToken Text] -> Bool)
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a1 d,
 AncestorFunctor a2 d) =>
(x -> Bool) -> Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pourWhile [Markup XMLToken Text] -> Bool
forall x. [Markup XMLToken x] -> Bool
noTagStart Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
sink
             Coroutine d m ()
-> Coroutine d m (Maybe (Markup XMLToken Text))
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Source m a1 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
get Source m a1 [Markup XMLToken Text]
source
             Coroutine d m (Maybe (Markup XMLToken Text))
-> (Maybe (Markup XMLToken Text) -> Coroutine d m ())
-> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m ()
-> (Markup XMLToken Text -> Coroutine d m ())
-> Maybe (Markup XMLToken Text)
-> Coroutine d m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Markup XMLToken Text -> Coroutine d m ()
consumeOne
   noTagStart :: [Markup XMLToken x] -> Bool
noTagStart [Markup (Start XMLToken
StartTag)] = Bool
False
   noTagStart [Markup (Start XMLToken
EndTag)] = Bool
False
   noTagStart [Markup XMLToken x]
_ = Bool
True
   consumeOne :: Markup XMLToken Text -> Coroutine d m ()
consumeOne x :: Markup XMLToken Text
x@(Markup (Start XMLToken
EndTag)) = do ([Markup XMLToken Text]
tokens, Maybe Text
mn) <- Source m a1 [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName Source m a1 [Markup XMLToken Text]
source (Markup XMLToken Text
x Markup XMLToken Text
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> [a] -> [a]
:)
                                             Coroutine d m ()
-> (Text -> Coroutine d m ()) -> Maybe Text -> Coroutine d m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                                (() -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                                (\Text
name'-> Source m a1 [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
getRestOfEndTag Source m a1 [Markup XMLToken Text]
source
                                                          Coroutine d m [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Markup XMLToken Text]
rest-> if Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name'
                                                                      then [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll ([Markup XMLToken Text]
tokens [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text]
rest) Sink m a3 [Markup XMLToken Text]
endSink
                                                                           Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                                                      else [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll ([Markup XMLToken Text]
tokens [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text]
rest) Sink m a2 [Markup XMLToken Text]
sink
                                                                           Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
findTag)
                                                Maybe Text
mn
   consumeOne x :: Markup XMLToken Text
x@(Markup (Start XMLToken
StartTag)) = do ([Markup XMLToken Text]
tokens, Maybe Text
mn) <- Source m a1 [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName Source m a1 [Markup XMLToken Text]
source (Markup XMLToken Text
x Markup XMLToken Text
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> [a] -> [a]
:)
                                               Coroutine d m ()
-> (Text -> Coroutine d m ()) -> Maybe Text -> Coroutine d m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                                  (() -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                                  (\Text
name'-> do ([Markup XMLToken Text]
rest, Bool
hasContent) <- Source m a1 [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
getRestOfStartTag Source m a1 [Markup XMLToken Text]
source
                                                               [Markup XMLToken Text]
_ <- [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll ([Markup XMLToken Text]
tokens [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text]
rest) Sink m a2 [Markup XMLToken Text]
sink
                                                               Bool -> Coroutine d m () -> Coroutine d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasContent (Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d,
 AncestorFunctor a3 d) =>
Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
findEndTag Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
sink Sink m a2 [Markup XMLToken Text]
sink Text
name')
                                                               Coroutine d m ()
findTag)
                                                  Maybe Text
mn
   consumeOne Markup XMLToken Text
_ = String -> Coroutine d m ()
forall a. HasCallStack => String -> a
error String
"pourWhile returned early!"

findStartTag :: forall m a1 a2 d. (Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
                Source m a1 [Markup XMLToken Text] -> Sink m a2 [Markup XMLToken Text]
             -> Coroutine d m (Maybe (Markup XMLToken Text))
findStartTag :: Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
findStartTag Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
sink = ([Markup XMLToken Text] -> Bool)
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a1 d,
 AncestorFunctor a2 d) =>
(x -> Bool) -> Source m a1 x -> Sink m a2 x -> Coroutine d m ()
pourWhile ([Markup XMLToken Text] -> [Markup XMLToken Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Boundary XMLToken -> Markup XMLToken Text
forall y x. Boundary y -> Markup y x
Markup (XMLToken -> Boundary XMLToken
forall y. y -> Boundary y
Start XMLToken
StartTag)]) Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
sink Coroutine d m ()
-> Coroutine d m (Maybe (Markup XMLToken Text))
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Source m a1 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Source m a [x] -> Coroutine d m (Maybe x)
get Source m a1 [Markup XMLToken Text]
source

-- | Splits all top-level elements with all their content to /true/, all other input to /false/.
xmlElement :: Monad m => Splitter m [Markup XMLToken Text]
xmlElement :: Splitter m [Markup XMLToken Text]
xmlElement = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter ((forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
         (d :: * -> *).
  OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
 -> Splitter m [Markup XMLToken Text])
-> (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
           (d :: * -> *).
    OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall a b. (a -> b) -> a -> b
$
             \Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a3 [Markup XMLToken Text]
false->
             let split0 :: Coroutine d m [Markup XMLToken Text]
split0 = Source m a1 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
findStartTag Source m a1 [Markup XMLToken Text]
source Sink m a3 [Markup XMLToken Text]
false
                          Coroutine d m (Maybe (Markup XMLToken Text))
-> (Maybe (Markup XMLToken Text)
    -> Coroutine d m [Markup XMLToken Text])
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m [Markup XMLToken Text]
-> (Markup XMLToken Text -> Coroutine d m [Markup XMLToken Text])
-> Maybe (Markup XMLToken Text)
-> Coroutine d m [Markup XMLToken Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
                                 (\Markup XMLToken Text
x-> do Sink m a3 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a3 [Markup XMLToken Text]
false [Markup XMLToken Text]
forall a. Monoid a => a
mempty
                                          Sink m a2 [Markup XMLToken Text]
-> Markup XMLToken Text -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m a2 [Markup XMLToken Text]
true Markup XMLToken Text
x
                                          ([Markup XMLToken Text]
tokens, Maybe Text
mn) <- Source m a1 [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName Source m a1 [Markup XMLToken Text]
source [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> a
id
                                          Coroutine d m [Markup XMLToken Text]
-> (Text -> Coroutine d m [Markup XMLToken Text])
-> Maybe Text
-> Coroutine d m [Markup XMLToken Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                             ([Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll [Markup XMLToken Text]
tokens Sink m a2 [Markup XMLToken Text]
true)
                                             (\Text
name-> do ([Markup XMLToken Text]
rest, Bool
hasContent) <- Source m a1 [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
getRestOfStartTag Source m a1 [Markup XMLToken Text]
source
                                                         [Markup XMLToken Text]
_ <- [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll ([Markup XMLToken Text]
tokens [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text]
rest) Sink m a2 [Markup XMLToken Text]
true
                                                         if Bool
hasContent
                                                            then Text -> Coroutine d m [Markup XMLToken Text]
split1 Text
name
                                                            else Coroutine d m [Markup XMLToken Text]
split0)
                                                Maybe Text
mn)
                 split1 :: Text -> Coroutine d m [Markup XMLToken Text]
split1 Text
name = Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d,
 AncestorFunctor a3 d) =>
Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
findEndTag Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a2 [Markup XMLToken Text]
true Text
name
                               Coroutine d m ()
-> Coroutine d m [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m [Markup XMLToken Text]
split0
             in Coroutine d m [Markup XMLToken Text]
split0 Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Splits the content of all top-level elements to /true/, their tags and intervening input to /false/.
xmlElementContent :: Monad m => Splitter m [Markup XMLToken Text]
xmlElementContent :: Splitter m [Markup XMLToken Text]
xmlElementContent = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter ((forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
         (d :: * -> *).
  OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
 -> Splitter m [Markup XMLToken Text])
-> (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
           (d :: * -> *).
    OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall a b. (a -> b) -> a -> b
$
                    \Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a3 [Markup XMLToken Text]
false->
                    let split0 :: Coroutine d m [Markup XMLToken Text]
split0 = Source m a1 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
findStartTag Source m a1 [Markup XMLToken Text]
source Sink m a3 [Markup XMLToken Text]
false
                                 Coroutine d m (Maybe (Markup XMLToken Text))
-> (Maybe (Markup XMLToken Text)
    -> Coroutine d m [Markup XMLToken Text])
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m [Markup XMLToken Text]
-> (Markup XMLToken Text -> Coroutine d m [Markup XMLToken Text])
-> Maybe (Markup XMLToken Text)
-> Coroutine d m [Markup XMLToken Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
                                        (\Markup XMLToken Text
x-> do Sink m a3 [Markup XMLToken Text]
-> Markup XMLToken Text -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, AncestorFunctor a d) =>
Sink m a [x] -> x -> Coroutine d m ()
put Sink m a3 [Markup XMLToken Text]
false Markup XMLToken Text
x
                                                 ([Markup XMLToken Text]
tokens, Maybe Text
mn) <- Source m a1 [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName Source m a1 [Markup XMLToken Text]
source [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> a
id
                                                 Coroutine d m [Markup XMLToken Text]
-> (Text -> Coroutine d m [Markup XMLToken Text])
-> Maybe Text
-> Coroutine d m [Markup XMLToken Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                                    ([Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll [Markup XMLToken Text]
tokens Sink m a3 [Markup XMLToken Text]
false)
                                                    (\Text
name-> do ([Markup XMLToken Text]
rest, Bool
hasContent) <- Source m a1 [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
getRestOfStartTag Source m a1 [Markup XMLToken Text]
source
                                                                [Markup XMLToken Text]
_ <- [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll ([Markup XMLToken Text]
tokens [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text]
rest) Sink m a3 [Markup XMLToken Text]
false
                                                                if Bool
hasContent
                                                                   then Text -> Coroutine d m [Markup XMLToken Text]
split1 Text
name
                                                                   else Coroutine d m [Markup XMLToken Text]
split0)
                                                    Maybe Text
mn)
                        split1 :: Text -> Coroutine d m [Markup XMLToken Text]
split1 Text
name = Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d,
 AncestorFunctor a3 d) =>
Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
findEndTag Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a3 [Markup XMLToken Text]
false Text
name
                                      Coroutine d m ()
-> Coroutine d m [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m [Markup XMLToken Text]
split0
                    in Coroutine d m [Markup XMLToken Text]
split0 Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Similiar to @('Control.Concurrent.SCC.Combinators.having' 'element')@, except it runs the argument splitter
-- only on each element's start tag, not on the entire element with its content.
xmlElementHavingTagWith :: forall m b. Monad m => Splitter m [Markup XMLToken Text] -> Splitter m [Markup XMLToken Text]
xmlElementHavingTagWith :: Splitter m [Markup XMLToken Text]
-> Splitter m [Markup XMLToken Text]
xmlElementHavingTagWith Splitter m [Markup XMLToken Text]
test =
      (forall (d :: * -> *).
 Functor d =>
 Source m d [Markup XMLToken Text]
 -> Sink m d [Markup XMLToken Text]
 -> Sink m d [Markup XMLToken Text]
 -> Coroutine d m ())
-> Splitter m [Markup XMLToken Text]
forall (m :: * -> *) x b.
(Monad m, Monoid x) =>
(forall (d :: * -> *).
 Functor d =>
 Source m d x -> Sink m d x -> Sink m d x -> Coroutine d m ())
-> Splitter m x
isolateSplitter ((forall (d :: * -> *).
  Functor d =>
  Source m d [Markup XMLToken Text]
  -> Sink m d [Markup XMLToken Text]
  -> Sink m d [Markup XMLToken Text]
  -> Coroutine d m ())
 -> Splitter m [Markup XMLToken Text])
-> (forall (d :: * -> *).
    Functor d =>
    Source m d [Markup XMLToken Text]
    -> Sink m d [Markup XMLToken Text]
    -> Sink m d [Markup XMLToken Text]
    -> Coroutine d m ())
-> Splitter m [Markup XMLToken Text]
forall a b. (a -> b) -> a -> b
$ \ Source m d [Markup XMLToken Text]
source Sink m d [Markup XMLToken Text]
true Sink m d [Markup XMLToken Text]
false ->
         let split0 :: Coroutine d m ()
split0 = Source m d [Markup XMLToken Text]
-> Sink m d [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d) =>
Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m (Maybe (Markup XMLToken Text))
findStartTag Source m d [Markup XMLToken Text]
source Sink m d [Markup XMLToken Text]
false
                      Coroutine d m (Maybe (Markup XMLToken Text))
-> (Maybe (Markup XMLToken Text) -> Coroutine d m ())
-> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Coroutine d m ()
-> (Markup XMLToken Text -> Coroutine d m ())
-> Maybe (Markup XMLToken Text)
-> Coroutine d m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                             (\Markup XMLToken Text
x-> do ([Markup XMLToken Text]
tokens, Maybe Text
mn) <- Source m d [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> [Markup XMLToken Text])
-> Coroutine d m ([Markup XMLToken Text], Maybe Text)
getElementName Source m d [Markup XMLToken Text]
source (Markup XMLToken Text
x Markup XMLToken Text
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. a -> [a] -> [a]
:)
                                      Coroutine d m ()
-> (Text -> Coroutine d m ()) -> Maybe Text -> Coroutine d m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                                         (() -> Coroutine d m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                                         (\Text
name-> do ([Markup XMLToken Text]
rest, Bool
hasContent) <- Source m d [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) (a :: * -> *) (d :: * -> *).
(Monad m, AncestorFunctor a d) =>
Source m a [Markup XMLToken Text]
-> Coroutine d m ([Markup XMLToken Text], Bool)
getRestOfStartTag Source m d [Markup XMLToken Text]
source
                                                     let tag :: [Markup XMLToken Text]
tag = [Markup XMLToken Text]
tokens [Markup XMLToken Text]
-> [Markup XMLToken Text] -> [Markup XMLToken Text]
forall a. [a] -> [a] -> [a]
++ [Markup XMLToken Text]
rest
                                                     ([Markup XMLToken Text]
_, Bool
found) <- (Sink
   m (SinkFunctor d [Markup XMLToken Text]) [Markup XMLToken Text]
 -> Coroutine
      (SinkFunctor d [Markup XMLToken Text]) m [Markup XMLToken Text])
-> (Source
      m (SourceFunctor d [Markup XMLToken Text]) [Markup XMLToken Text]
    -> Coroutine (SourceFunctor d [Markup XMLToken Text]) m Bool)
-> Coroutine d m ([Markup XMLToken Text], Bool)
forall (m :: * -> *) (a :: * -> *) (a1 :: * -> *) (a2 :: * -> *) x
       r1 r2.
(Monad m, Monoid x, Functor a, a1 ~ SinkFunctor a x,
 a2 ~ SourceFunctor a x) =>
(Sink m a1 x -> Coroutine a1 m r1)
-> (Source m a2 x -> Coroutine a2 m r2) -> Coroutine a m (r1, r2)
pipe ([Markup XMLToken Text]
-> Sink
     m (SinkFunctor d [Markup XMLToken Text]) [Markup XMLToken Text]
-> Coroutine
     (SinkFunctor d [Markup XMLToken Text]) m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll [Markup XMLToken Text]
tag) (Splitter m [Markup XMLToken Text]
-> Source
     m (SourceFunctor d [Markup XMLToken Text]) [Markup XMLToken Text]
-> Coroutine (SourceFunctor d [Markup XMLToken Text]) m Bool
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
Splitter m x -> Source m a x -> Coroutine d m Bool
findsTrueIn Splitter m [Markup XMLToken Text]
test)
                                                     if Bool
found then Sink m d [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m d [Markup XMLToken Text]
false [Markup XMLToken Text]
forall a. Monoid a => a
mempty
                                                                   Coroutine d m [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Markup XMLToken Text]
-> Sink m d [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll [Markup XMLToken Text]
tag Sink m d [Markup XMLToken Text]
true
                                                                   Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Sink m d [Markup XMLToken Text] -> Text -> Coroutine d m ()
split1 Bool
hasContent Sink m d [Markup XMLToken Text]
true Text
name
                                                        else [Markup XMLToken Text]
-> Sink m d [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, MonoidNull x, AncestorFunctor a d) =>
x -> Sink m a x -> Coroutine d m x
putAll [Markup XMLToken Text]
tag Sink m d [Markup XMLToken Text]
false
                                                             Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Sink m d [Markup XMLToken Text] -> Text -> Coroutine d m ()
split1 Bool
hasContent Sink m d [Markup XMLToken Text]
false Text
name)
                                         Maybe Text
mn)
             split1 :: Bool -> Sink m d [Markup XMLToken Text] -> Text -> Coroutine d m ()
split1 Bool
hasContent Sink m d [Markup XMLToken Text]
sink Text
name = Bool -> Coroutine d m () -> Coroutine d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasContent (Source m d [Markup XMLToken Text]
-> Sink m d [Markup XMLToken Text]
-> Sink m d [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d,
 AncestorFunctor a3 d) =>
Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Text
-> Coroutine d m ()
findEndTag Source m d [Markup XMLToken Text]
source Sink m d [Markup XMLToken Text]
sink Sink m d [Markup XMLToken Text]
sink Text
name)
                                           Coroutine d m () -> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
split0
      in Coroutine d m ()
split0

-- | Splits every attribute specification to /true/, everything else to /false/.
xmlAttribute :: Monad m => Splitter m [Markup XMLToken Text]
xmlAttribute :: Splitter m [Markup XMLToken Text]
xmlAttribute = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter ((forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
         (d :: * -> *).
  OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
 -> Splitter m [Markup XMLToken Text])
-> (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
           (d :: * -> *).
    OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall a b. (a -> b) -> a -> b
$
               \Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a3 [Markup XMLToken Text]
false->
               let split0 :: Coroutine d m ()
split0 = Source m a1 [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
Source m a x -> (x -> Coroutine d m ()) -> Coroutine d m ()
getWith Source m a1 [Markup XMLToken Text]
source
                               (\[Markup XMLToken Text]
x-> case [Markup XMLToken Text]
x
                                     of [Markup (Start AttributeName)] ->
                                           do Sink m a3 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a3 [Markup XMLToken Text]
false [Markup XMLToken Text]
forall a. Monoid a => a
mempty
                                              Sink m a2 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a2 [Markup XMLToken Text]
true [Markup XMLToken Text]
x
                                              XMLToken
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m Bool
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d,
 AncestorFunctor a3 d) =>
XMLToken
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m Bool
pourRestOfRegion XMLToken
AttributeName Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a2 [Markup XMLToken Text]
true
                                                 Coroutine d m Bool
-> (Bool -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> Coroutine d m () -> Coroutine d m ())
-> Coroutine d m () -> Bool -> Coroutine d m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Coroutine d m () -> Coroutine d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Coroutine d m ()
split1
                                        [Markup XMLToken Text]
_ -> Sink m a3 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a3 [Markup XMLToken Text]
false [Markup XMLToken Text]
x Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
split0)
                   split1 :: Coroutine d m ()
split1 = Source m a1 [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
Source m a x -> (x -> Coroutine d m ()) -> Coroutine d m ()
getWith Source m a1 [Markup XMLToken Text]
source
                               (\[Markup XMLToken Text]
x-> case [Markup XMLToken Text]
x
                                     of [Markup (Start AttributeValue)]
                                           -> Sink m a2 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a2 [Markup XMLToken Text]
true [Markup XMLToken Text]
x
                                              Coroutine d m [Markup XMLToken Text]
-> Coroutine d m Bool -> Coroutine d m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLToken
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Coroutine d m Bool
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d,
 AncestorFunctor a3 d) =>
XMLToken
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m Bool
pourRestOfRegion XMLToken
AttributeValue Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a2 [Markup XMLToken Text]
true
                                              Coroutine d m Bool
-> (Bool -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> Coroutine d m () -> Coroutine d m ())
-> Coroutine d m () -> Bool -> Coroutine d m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Coroutine d m () -> Coroutine d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Coroutine d m ()
split0
                                        [Markup XMLToken Text]
_ -> Sink m a2 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a2 [Markup XMLToken Text]
true [Markup XMLToken Text]
x Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
split1)
               in Coroutine d m ()
split0

-- | Splits every element name, including the names of nested elements and names in end tags, to /true/, all the rest of
-- input to /false/.
xmlElementName :: Monad m => Splitter m [Markup XMLToken Text]
xmlElementName :: Splitter m [Markup XMLToken Text]
xmlElementName = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter (XMLToken -> OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
Monad m =>
XMLToken -> OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ()
splitSimpleRegions XMLToken
ElementName)

-- | Splits every attribute name to /true/, all the rest of input to /false/.
xmlAttributeName :: Monad m => Splitter m [Markup XMLToken Text]
xmlAttributeName :: Splitter m [Markup XMLToken Text]
xmlAttributeName = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter  (XMLToken -> OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
Monad m =>
XMLToken -> OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ()
splitSimpleRegions XMLToken
AttributeName)

-- | Splits every attribute value, excluding the quote delimiters, to /true/, all the rest of input to /false/.
xmlAttributeValue :: Monad m => Splitter m [Markup XMLToken Text]
xmlAttributeValue :: Splitter m [Markup XMLToken Text]
xmlAttributeValue = (forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ())
-> Splitter m [Markup XMLToken Text]
forall (m :: * -> *) x.
(forall (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *) (d :: * -> *).
 OpenSplitter m a1 a2 a3 d x ())
-> Splitter m x
Splitter (XMLToken -> OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ()
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
Monad m =>
XMLToken -> OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ()
splitSimpleRegions XMLToken
AttributeValue)

splitSimpleRegions :: Monad m => XMLToken -> OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ()
splitSimpleRegions :: XMLToken -> OpenSplitter m a1 a2 a3 d [Markup XMLToken Text] ()
splitSimpleRegions XMLToken
token Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a3 [Markup XMLToken Text]
false = Coroutine d m ()
split0
   where split0 :: Coroutine d m ()
split0 = Source m a1 [Markup XMLToken Text]
-> ([Markup XMLToken Text] -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) (a :: * -> *) (d :: * -> *) x.
(Monad m, FactorialMonoid x, AncestorFunctor a d) =>
Source m a x -> (x -> Coroutine d m ()) -> Coroutine d m ()
getWith Source m a1 [Markup XMLToken Text]
source [Markup XMLToken Text] -> Coroutine d m ()
consumeOne
         consumeOne :: [Markup XMLToken Text] -> Coroutine d m ()
consumeOne x :: [Markup XMLToken Text]
x@[Markup (Start XMLToken
token')] | XMLToken
token XMLToken -> XMLToken -> Bool
forall a. Eq a => a -> a -> Bool
== XMLToken
token' = Sink m a3 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a3 [Markup XMLToken Text]
false [Markup XMLToken Text]
x
                                                                  Coroutine d m [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
-> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sink m a2 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a2 [Markup XMLToken Text]
true [Markup XMLToken Text]
forall a. Monoid a => a
mempty
                                                                  Coroutine d m [Markup XMLToken Text]
-> Coroutine d m Bool -> Coroutine d m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> XMLToken
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m Bool
forall (m :: * -> *) (a1 :: * -> *) (a2 :: * -> *) (a3 :: * -> *)
       (d :: * -> *).
(Monad m, AncestorFunctor a1 d, AncestorFunctor a2 d,
 AncestorFunctor a3 d) =>
XMLToken
-> Source m a1 [Markup XMLToken Text]
-> Sink m a2 [Markup XMLToken Text]
-> Sink m a3 [Markup XMLToken Text]
-> Coroutine d m Bool
pourRestOfRegion XMLToken
token Source m a1 [Markup XMLToken Text]
source Sink m a2 [Markup XMLToken Text]
true Sink m a3 [Markup XMLToken Text]
false
                                                                  Coroutine d m Bool
-> (Bool -> Coroutine d m ()) -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> Coroutine d m () -> Coroutine d m ())
-> Coroutine d m () -> Bool -> Coroutine d m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> Coroutine d m () -> Coroutine d m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Coroutine d m ()
split0
         consumeOne [Markup XMLToken Text]
x = Sink m a3 [Markup XMLToken Text]
-> [Markup XMLToken Text] -> Coroutine d m [Markup XMLToken Text]
forall (m :: * -> *) (a :: * -> *) x.
Sink m a x
-> forall (d :: * -> *).
   AncestorFunctor a d =>
   x -> Coroutine d m x
putChunk Sink m a3 [Markup XMLToken Text]
false [Markup XMLToken Text]
x Coroutine d m [Markup XMLToken Text]
-> Coroutine d m () -> Coroutine d m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Coroutine d m ()
split0

isContent :: [Markup b x] -> Bool
isContent :: [Markup b x] -> Bool
isContent [Content{}] = Bool
True
isContent [Markup b x]
_ = Bool
False

fromContent :: Markup b x -> x
fromContent :: Markup b x -> x
fromContent (Content x
x) = x
x
fromContent Markup b x
_ = String -> x
forall a. HasCallStack => String -> a
error String
"fromContent expects Content!"