{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
module Text.XML.Expat.Format (
format,
format',
formatG,
formatNode,
formatNode',
formatNodeG,
formatDocument,
formatDocument',
formatDocumentG,
xmlHeader,
treeToSAX,
documentToSAX,
formatSAX,
formatSAX',
formatSAXG,
indent,
indent_
) where
import qualified Text.XML.Expat.Internal.DocumentClass as Doc
import Text.XML.Expat.Internal.NodeClass
import Text.XML.Expat.SAX
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Internal (c2w, w2c)
import Data.Char (isSpace)
import Data.List.Class (List(..), ListItem(..), fromList)
import Data.Monoid
import Data.Word
import Data.Text (Text)
import Text.XML.Expat.Tree (UNode)
format :: (NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text
-> L.ByteString
format :: forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
format n [] tag text
node = [ByteString] -> ByteString
L.fromChunks (ByteString
xmlHeader ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: n [] tag text -> [ByteString]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
n c tag text -> c ByteString
formatNodeG n [] tag text
node)
{-# SPECIALIZE format :: UNode Text -> L.ByteString #-}
formatG :: (NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
n c tag text
-> c B.ByteString
formatG :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
n c tag text -> c ByteString
formatG n c tag text
node = ByteString -> c ByteString -> c ByteString
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons ByteString
xmlHeader (c ByteString -> c ByteString) -> c ByteString -> c ByteString
forall a b. (a -> b) -> a -> b
$ n c tag text -> c ByteString
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
n c tag text -> c ByteString
formatNodeG n c tag text
node
format' :: (NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text
-> B.ByteString
format' :: forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
format' = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (n [] tag text -> [ByteString]) -> n [] tag text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> (n [] tag text -> ByteString) -> n [] tag text -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n [] tag text -> ByteString
forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
format
formatNode :: (NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text
-> L.ByteString
formatNode :: forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
formatNode = [SAXEvent tag text] -> ByteString
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
[SAXEvent tag text] -> ByteString
formatSAX ([SAXEvent tag text] -> ByteString)
-> (n [] tag text -> [SAXEvent tag text])
-> n [] tag text
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n [] tag text -> [SAXEvent tag text]
forall tag text (n :: (* -> *) -> * -> * -> *) (c :: * -> *).
(GenericXMLString tag, GenericXMLString text, Monoid text,
NodeClass n c) =>
n c tag text -> c (SAXEvent tag text)
treeToSAX
formatNode' :: (NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text
-> B.ByteString
formatNode' :: forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
formatNode' = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (n [] tag text -> [ByteString]) -> n [] tag text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> (n [] tag text -> ByteString) -> n [] tag text -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n [] tag text -> ByteString
forall (n :: (* -> *) -> * -> * -> *) tag text.
(NodeClass n [], GenericXMLString tag, GenericXMLString text) =>
n [] tag text -> ByteString
formatNode
formatNodeG :: (NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
n c tag text
-> c B.ByteString
formatNodeG :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
n c tag text -> c ByteString
formatNodeG = c (SAXEvent tag text) -> c ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> c ByteString
formatSAXG (c (SAXEvent tag text) -> c ByteString)
-> (n c tag text -> c (SAXEvent tag text))
-> n c tag text
-> c ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n c tag text -> c (SAXEvent tag text)
forall tag text (n :: (* -> *) -> * -> * -> *) (c :: * -> *).
(GenericXMLString tag, GenericXMLString text, Monoid text,
NodeClass n c) =>
n c tag text -> c (SAXEvent tag text)
treeToSAX
{-# SPECIALIZE formatNodeG :: UNode Text -> [B.ByteString] #-}
formatDocument :: (Doc.DocumentClass d [], GenericXMLString tag, GenericXMLString text) =>
d [] tag text
-> L.ByteString
formatDocument :: forall (d :: (* -> *) -> * -> * -> *) tag text.
(DocumentClass d [], GenericXMLString tag,
GenericXMLString text) =>
d [] tag text -> ByteString
formatDocument = [SAXEvent tag text] -> ByteString
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
[SAXEvent tag text] -> ByteString
formatSAX ([SAXEvent tag text] -> ByteString)
-> (d [] tag text -> [SAXEvent tag text])
-> d [] tag text
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d [] tag text -> [SAXEvent tag text]
forall tag text (d :: (* -> *) -> * -> * -> *) (c :: * -> *).
(GenericXMLString tag, GenericXMLString text, Monoid text,
DocumentClass d c) =>
d c tag text -> c (SAXEvent tag text)
documentToSAX
formatDocument' :: (Doc.DocumentClass d [], GenericXMLString tag, GenericXMLString text) =>
d [] tag text
-> B.ByteString
formatDocument' :: forall (d :: (* -> *) -> * -> * -> *) tag text.
(DocumentClass d [], GenericXMLString tag,
GenericXMLString text) =>
d [] tag text -> ByteString
formatDocument' = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (d [] tag text -> [ByteString]) -> d [] tag text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString])
-> (d [] tag text -> ByteString) -> d [] tag text -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d [] tag text -> ByteString
forall (d :: (* -> *) -> * -> * -> *) tag text.
(DocumentClass d [], GenericXMLString tag,
GenericXMLString text) =>
d [] tag text -> ByteString
formatDocument
formatDocumentG :: (Doc.DocumentClass d c, GenericXMLString tag, GenericXMLString text) =>
d c tag text
-> c B.ByteString
formatDocumentG :: forall (d :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(DocumentClass d c, GenericXMLString tag, GenericXMLString text) =>
d c tag text -> c ByteString
formatDocumentG = c (SAXEvent tag text) -> c ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> c ByteString
formatSAXG (c (SAXEvent tag text) -> c ByteString)
-> (d c tag text -> c (SAXEvent tag text))
-> d c tag text
-> c ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d c tag text -> c (SAXEvent tag text)
forall tag text (d :: (* -> *) -> * -> * -> *) (c :: * -> *).
(GenericXMLString tag, GenericXMLString text, Monoid text,
DocumentClass d c) =>
d c tag text -> c (SAXEvent tag text)
documentToSAX
xmlHeader :: B.ByteString
= [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w [Char]
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
documentToSAX :: forall tag text d c . (GenericXMLString tag, GenericXMLString text,
Monoid text, Doc.DocumentClass d c) =>
d c tag text -> c (SAXEvent tag text)
documentToSAX :: forall tag text (d :: (* -> *) -> * -> * -> *) (c :: * -> *).
(GenericXMLString tag, GenericXMLString text, Monoid text,
DocumentClass d c) =>
d c tag text -> c (SAXEvent tag text)
documentToSAX d c tag text
doc =
(case d c tag text -> Maybe (XMLDeclaration text)
forall tag text. d c tag text -> Maybe (XMLDeclaration text)
forall (d :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
DocumentClass d c =>
d c tag text -> Maybe (XMLDeclaration text)
Doc.getXMLDeclaration d c tag text
doc of
Just (Doc.XMLDeclaration text
ver Maybe text
mEnc Maybe Bool
sd) -> [SAXEvent tag text] -> c (SAXEvent tag text)
forall (l :: * -> *) a. List l => [a] -> l a
fromList [
text -> Maybe text -> Maybe Bool -> SAXEvent tag text
forall tag text.
text -> Maybe text -> Maybe Bool -> SAXEvent tag text
XMLDeclaration text
ver Maybe text
mEnc Maybe Bool
sd, text -> SAXEvent tag text
forall tag text. text -> SAXEvent tag text
CharacterData ([Char] -> text
forall s. GenericXMLString s => [Char] -> s
gxFromString [Char]
"\n")]
Maybe (XMLDeclaration text)
Nothing -> c (SAXEvent tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero) c (SAXEvent tag text)
-> c (SAXEvent tag text) -> c (SAXEvent tag text)
forall a. c a -> c a -> c a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
c (c (SAXEvent tag text)) -> c (SAXEvent tag text)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ((Misc text -> c (SAXEvent tag text))
-> c (Misc text) -> c (c (SAXEvent tag text))
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Misc text
misc -> [SAXEvent tag text] -> c (SAXEvent tag text)
forall (l :: * -> *) a. List l => [a] -> l a
fromList [case Misc text
misc of
Doc.ProcessingInstruction text
target text
text -> text -> text -> SAXEvent tag text
forall tag text. text -> text -> SAXEvent tag text
ProcessingInstruction text
target text
text
Doc.Comment text
text -> text -> SAXEvent tag text
forall tag text. text -> SAXEvent tag text
Comment text
text,
text -> SAXEvent tag text
forall tag text. text -> SAXEvent tag text
CharacterData ([Char] -> text
forall s. GenericXMLString s => [Char] -> s
gxFromString [Char]
"\n")]
) (d c tag text -> c (Misc text)
forall tag text. d c tag text -> c (Misc text)
forall (d :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
DocumentClass d c =>
d c tag text -> c (Misc text)
Doc.getTopLevelMiscs d c tag text
doc)) c (SAXEvent tag text)
-> c (SAXEvent tag text) -> c (SAXEvent tag text)
forall a. c a -> c a -> c a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
NodeType d c tag text -> c (SAXEvent tag text)
forall tag text (n :: (* -> *) -> * -> * -> *) (c :: * -> *).
(GenericXMLString tag, GenericXMLString text, Monoid text,
NodeClass n c) =>
n c tag text -> c (SAXEvent tag text)
treeToSAX (d c tag text -> NodeType d c tag text
forall tag text. d c tag text -> NodeType d c tag text
forall (d :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
DocumentClass d c =>
d c tag text -> NodeType d c tag text
Doc.getRoot d c tag text
doc)
treeToSAX :: forall tag text n c . (GenericXMLString tag, GenericXMLString text,
Monoid text, NodeClass n c) =>
n c tag text -> c (SAXEvent tag text)
treeToSAX :: forall tag text (n :: (* -> *) -> * -> * -> *) (c :: * -> *).
(GenericXMLString tag, GenericXMLString text, Monoid text,
NodeClass n c) =>
n c tag text -> c (SAXEvent tag text)
treeToSAX n c tag text
node
| n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement n c tag text
node =
let name :: tag
name = n c tag text -> tag
forall tag text. Monoid tag => n c tag text -> tag
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, Monoid tag) =>
n c tag text -> tag
getName n c tag text
node
atts :: [(tag, text)]
atts = n c tag text -> [(tag, text)]
forall tag text. n c tag text -> [(tag, text)]
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> [(tag, text)]
getAttributes n c tag text
node
children :: c (n c tag text)
children = n c tag text -> c (n c tag text)
forall tag text. n c tag text -> c (n c tag text)
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> c (n c tag text)
getChildren n c tag text
node
postpend :: c (SAXEvent tag text) -> c (SAXEvent tag text)
postpend :: c (SAXEvent tag text) -> c (SAXEvent tag text)
postpend c (SAXEvent tag text)
l = ItemM c (c (SAXEvent tag text)) -> c (SAXEvent tag text)
forall a. ItemM c (c a) -> c a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM c (c (SAXEvent tag text)) -> c (SAXEvent tag text))
-> ItemM c (c (SAXEvent tag text)) -> c (SAXEvent tag text)
forall a b. (a -> b) -> a -> b
$ do
ListItem c (SAXEvent tag text)
li <- c (SAXEvent tag text) -> ItemM c (ListItem c (SAXEvent tag text))
forall a. c a -> ItemM c (ListItem c a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList c (SAXEvent tag text)
l
c (SAXEvent tag text) -> ItemM c (c (SAXEvent tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (SAXEvent tag text) -> ItemM c (c (SAXEvent tag text)))
-> c (SAXEvent tag text) -> ItemM c (c (SAXEvent tag text))
forall a b. (a -> b) -> a -> b
$ case ListItem c (SAXEvent tag text)
li of
ListItem c (SAXEvent tag text)
Nil -> SAXEvent tag text -> c (SAXEvent tag text)
forall {a}. a -> c a
singleton (tag -> SAXEvent tag text
forall tag text. tag -> SAXEvent tag text
EndElement tag
name)
Cons SAXEvent tag text
n c (SAXEvent tag text)
l' -> SAXEvent tag text -> c (SAXEvent tag text) -> c (SAXEvent tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons SAXEvent tag text
n (c (SAXEvent tag text) -> c (SAXEvent tag text)
postpend c (SAXEvent tag text)
l')
in SAXEvent tag text -> c (SAXEvent tag text) -> c (SAXEvent tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (tag -> [(tag, text)] -> SAXEvent tag text
forall tag text. tag -> [(tag, text)] -> SAXEvent tag text
StartElement tag
name [(tag, text)]
atts) (c (SAXEvent tag text) -> c (SAXEvent tag text))
-> c (SAXEvent tag text) -> c (SAXEvent tag text)
forall a b. (a -> b) -> a -> b
$
c (SAXEvent tag text) -> c (SAXEvent tag text)
postpend (c (c (SAXEvent tag text)) -> c (SAXEvent tag text)
forall {a}. c (c a) -> c a
concatL (c (c (SAXEvent tag text)) -> c (SAXEvent tag text))
-> c (c (SAXEvent tag text)) -> c (SAXEvent tag text)
forall a b. (a -> b) -> a -> b
$ (n c tag text -> c (SAXEvent tag text))
-> c (n c tag text) -> c (c (SAXEvent tag text))
forall a b. (a -> b) -> c a -> c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap n c tag text -> c (SAXEvent tag text)
forall tag text (n :: (* -> *) -> * -> * -> *) (c :: * -> *).
(GenericXMLString tag, GenericXMLString text, Monoid text,
NodeClass n c) =>
n c tag text -> c (SAXEvent tag text)
treeToSAX c (n c tag text)
children)
| n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isCData n c tag text
node =
SAXEvent tag text -> c (SAXEvent tag text) -> c (SAXEvent tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons SAXEvent tag text
forall tag text. SAXEvent tag text
StartCData (SAXEvent tag text -> c (SAXEvent tag text) -> c (SAXEvent tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (text -> SAXEvent tag text
forall tag text. text -> SAXEvent tag text
CharacterData (text -> SAXEvent tag text) -> text -> SAXEvent tag text
forall a b. (a -> b) -> a -> b
$ n c tag text -> text
forall text tag. Monoid text => n c tag text -> text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> text
getText n c tag text
node) (SAXEvent tag text -> c (SAXEvent tag text)
forall {a}. a -> c a
singleton SAXEvent tag text
forall tag text. SAXEvent tag text
EndCData))
| n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isText n c tag text
node =
SAXEvent tag text -> c (SAXEvent tag text)
forall {a}. a -> c a
singleton (text -> SAXEvent tag text
forall tag text. text -> SAXEvent tag text
CharacterData (text -> SAXEvent tag text) -> text -> SAXEvent tag text
forall a b. (a -> b) -> a -> b
$ n c tag text -> text
forall text tag. Monoid text => n c tag text -> text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> text
getText n c tag text
node)
| n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isProcessingInstruction n c tag text
node =
SAXEvent tag text -> c (SAXEvent tag text)
forall {a}. a -> c a
singleton (text -> text -> SAXEvent tag text
forall tag text. text -> text -> SAXEvent tag text
ProcessingInstruction (n c tag text -> text
forall text tag. Monoid text => n c tag text -> text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> text
getTarget n c tag text
node) (n c tag text -> text
forall text tag. Monoid text => n c tag text -> text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> text
getText n c tag text
node))
| n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isComment n c tag text
node =
SAXEvent tag text -> c (SAXEvent tag text)
forall {a}. a -> c a
singleton (text -> SAXEvent tag text
forall tag text. text -> SAXEvent tag text
Comment (text -> SAXEvent tag text) -> text -> SAXEvent tag text
forall a b. (a -> b) -> a -> b
$ n c tag text -> text
forall text tag. Monoid text => n c tag text -> text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> text
getText n c tag text
node)
| Bool
otherwise = c (SAXEvent tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
singleton :: a -> c a
singleton = a -> c a
forall {a}. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return
concatL :: c (c a) -> c a
concatL = c (c a) -> c a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
{-# SPECIALIZE treeToSAX :: UNode Text -> [(SAXEvent Text Text)] #-}
formatSAX :: (GenericXMLString tag, GenericXMLString text) =>
[SAXEvent tag text]
-> L.ByteString
formatSAX :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
[SAXEvent tag text] -> ByteString
formatSAX = [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString)
-> ([SAXEvent tag text] -> [ByteString])
-> [SAXEvent tag text]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SAXEvent tag text] -> [ByteString]
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> c ByteString
formatSAXG
formatSAX' :: (GenericXMLString tag, GenericXMLString text) =>
[SAXEvent tag text]
-> B.ByteString
formatSAX' :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
[SAXEvent tag text] -> ByteString
formatSAX' = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> ([SAXEvent tag text] -> [ByteString])
-> [SAXEvent tag text]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SAXEvent tag text] -> [ByteString]
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> c ByteString
formatSAXG
startTagHelper :: (GenericXMLString tag, GenericXMLString text) =>
tag
-> [(tag, text)]
-> [B.ByteString]
startTagHelper :: forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
tag -> [(tag, text)] -> [ByteString]
startTagHelper tag
name [(tag, text)]
atts =
Word8 -> ByteString
B.singleton (Char -> Word8
c2w Char
'<')ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
tag -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString tag
nameByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
((tag, text) -> [ByteString]) -> [(tag, text)] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Prelude.concatMap (
\(tag
aname, text
avalue) ->
Word8 -> ByteString
B.singleton (Char -> Word8
c2w Char
' ')ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
tag -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString tag
anameByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
[Char] -> ByteString
pack [Char]
"=\""ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
ByteString -> [ByteString]
escapeText (text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString text
avalue)[ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++
[Word8 -> ByteString
B.singleton (Char -> Word8
c2w Char
'"')]
) [(tag, text)]
atts
formatSAXG :: forall c tag text . (List c, GenericXMLString tag,
GenericXMLString text) =>
c (SAXEvent tag text)
-> c B.ByteString
formatSAXG :: forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> c ByteString
formatSAXG c (SAXEvent tag text)
l1 = c (SAXEvent tag text) -> Bool -> c ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb c (SAXEvent tag text)
l1 Bool
False
{-# SPECIALIZE formatSAXG :: [SAXEvent Text Text] -> [B.ByteString] #-}
formatSAXGb :: forall c tag text . (List c, GenericXMLString tag,
GenericXMLString text) =>
c (SAXEvent tag text)
-> Bool
-> c B.ByteString
formatSAXGb :: forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb c (SAXEvent tag text)
l1 Bool
cd = ItemM c (c ByteString) -> c ByteString
forall a. ItemM c (c a) -> c a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM c (c ByteString) -> c ByteString)
-> ItemM c (c ByteString) -> c ByteString
forall a b. (a -> b) -> a -> b
$ do
ListItem c (SAXEvent tag text)
it1 <- c (SAXEvent tag text) -> ItemM c (ListItem c (SAXEvent tag text))
forall a. c a -> ItemM c (ListItem c a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList c (SAXEvent tag text)
l1
c ByteString -> ItemM c (c ByteString)
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (c ByteString -> ItemM c (c ByteString))
-> c ByteString -> ItemM c (c ByteString)
forall a b. (a -> b) -> a -> b
$ ListItem c (SAXEvent tag text) -> c ByteString
forall {l :: * -> *} {text} {tag}.
(List l, GenericXMLString text, GenericXMLString tag) =>
ListItem l (SAXEvent tag text) -> l ByteString
formatItem ListItem c (SAXEvent tag text)
it1
where
formatItem :: ListItem l (SAXEvent tag text) -> l ByteString
formatItem ListItem l (SAXEvent tag text)
it1 = case ListItem l (SAXEvent tag text)
it1 of
ListItem l (SAXEvent tag text)
Nil -> l ByteString
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Cons (XMLDeclaration text
ver Maybe text
mEnc Maybe Bool
mSD) l (SAXEvent tag text)
l2 ->
ByteString -> l ByteString
forall a. a -> l a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ByteString
pack [Char]
"<?xml version=\"") l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
[ByteString] -> l ByteString
forall (l :: * -> *) a. List l => [a] -> l a
fromList (ByteString -> [ByteString]
escapeText (text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString text
ver)) l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
ByteString -> l ByteString
forall a. a -> l a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ByteString
pack [Char]
"\"") l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(
case Maybe text
mEnc of
Maybe text
Nothing -> l ByteString
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just text
enc ->
ByteString -> l ByteString
forall a. a -> l a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ByteString
pack [Char]
" encoding=\"") l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
[ByteString] -> l ByteString
forall (l :: * -> *) a. List l => [a] -> l a
fromList (ByteString -> [ByteString]
escapeText (text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString text
enc)) l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
ByteString -> l ByteString
forall a. a -> l a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ByteString
pack [Char]
"\"")
) l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(
case Maybe Bool
mSD of
Maybe Bool
Nothing -> l ByteString
forall a. l a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
Just Bool
True -> ByteString -> l ByteString
forall a. a -> l a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ByteString
pack [Char]
" standalone=\"yes\"")
Just Bool
False -> ByteString -> l ByteString
forall a. a -> l a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ByteString
pack [Char]
" standalone=\"no\"")
) l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
ByteString -> l ByteString
forall a. a -> l a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> ByteString
pack ([Char]
"?>"))
l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l2 Bool
cd
Cons (StartElement tag
name [(tag, text)]
attrs) l (SAXEvent tag text)
l2 ->
[ByteString] -> l ByteString
forall (l :: * -> *) a. List l => [a] -> l a
fromList (tag -> [(tag, text)] -> [ByteString]
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
tag -> [(tag, text)] -> [ByteString]
startTagHelper tag
name [(tag, text)]
attrs)
l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (
ItemM l (l ByteString) -> l ByteString
forall a. ItemM l (l a) -> l a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM l (l ByteString) -> l ByteString)
-> ItemM l (l ByteString) -> l ByteString
forall a b. (a -> b) -> a -> b
$ do
ListItem l (SAXEvent tag text)
it2 <- l (SAXEvent tag text) -> ItemM l (ListItem l (SAXEvent tag text))
forall a. l a -> ItemM l (ListItem l a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList l (SAXEvent tag text)
l2
l ByteString -> ItemM l (l ByteString)
forall a. a -> ItemM l a
forall (m :: * -> *) a. Monad m => a -> m a
return (l ByteString -> ItemM l (l ByteString))
-> l ByteString -> ItemM l (l ByteString)
forall a b. (a -> b) -> a -> b
$ case ListItem l (SAXEvent tag text)
it2 of
Cons (EndElement tag
_) l (SAXEvent tag text)
l3 ->
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons ([Char] -> ByteString
pack [Char]
"/>") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l3 Bool
cd
ListItem l (SAXEvent tag text)
_ ->
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (Word8 -> ByteString
B.singleton (Char -> Word8
c2w Char
'>')) (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ListItem l (SAXEvent tag text) -> l ByteString
formatItem ListItem l (SAXEvent tag text)
it2
)
Cons (EndElement tag
name) l (SAXEvent tag text)
l2 ->
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons ([Char] -> ByteString
pack [Char]
"</") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (tag -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString tag
name) (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (Word8 -> ByteString
B.singleton (Char -> Word8
c2w Char
'>')) (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l2 Bool
cd
Cons (CharacterData text
txt) l (SAXEvent tag text)
l2 ->
(if Bool
cd then
[ByteString] -> l ByteString
forall (l :: * -> *) a. List l => [a] -> l a
fromList [text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString text
txt]
else
[ByteString] -> l ByteString
forall (l :: * -> *) a. List l => [a] -> l a
fromList (ByteString -> [ByteString]
escapeText (text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString text
txt))
) l ByteString -> l ByteString -> l ByteString
forall a. l a -> l a -> l a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l2 Bool
cd)
Cons SAXEvent tag text
StartCData l (SAXEvent tag text)
l2 ->
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons([Char] -> ByteString
pack [Char]
"<![CDATA[") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l2 Bool
True
Cons SAXEvent tag text
EndCData l (SAXEvent tag text)
l2 ->
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons([Char] -> ByteString
pack [Char]
"]]>") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l2 Bool
False
Cons (ProcessingInstruction text
target text
txt) l (SAXEvent tag text)
l2 ->
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons ([Char] -> ByteString
pack [Char]
"<?") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString text
target) (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons ([Char] -> ByteString
pack [Char]
" ") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString text
txt) (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons ([Char] -> ByteString
pack [Char]
"?>") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l2 Bool
cd
Cons (Comment text
txt) l (SAXEvent tag text)
l2 ->
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons ([Char] -> ByteString
pack [Char]
"<!--") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (text -> ByteString
forall s. GenericXMLString s => s -> ByteString
gxToByteString text
txt) (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> l ByteString -> l ByteString
forall a. a -> l a -> l a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons ([Char] -> ByteString
pack [Char]
"-->") (l ByteString -> l ByteString) -> l ByteString -> l ByteString
forall a b. (a -> b) -> a -> b
$
l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l2 Bool
cd
Cons (FailDocument XMLParseError
_) l (SAXEvent tag text)
l2 ->
l (SAXEvent tag text) -> Bool -> l ByteString
forall (c :: * -> *) tag text.
(List c, GenericXMLString tag, GenericXMLString text) =>
c (SAXEvent tag text) -> Bool -> c ByteString
formatSAXGb l (SAXEvent tag text)
l2 Bool
cd
{-# SPECIALIZE formatSAXGb :: [SAXEvent Text Text] -> Bool -> [B.ByteString] #-}
pack :: String -> B.ByteString
pack :: [Char] -> ByteString
pack = [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> ([Char] -> [Word8]) -> [Char] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
c2w
isSafeChar :: Word8 -> Bool
isSafeChar :: Word8 -> Bool
isSafeChar Word8
c =
(Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
'&')
Bool -> Bool -> Bool
&& (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
'<')
Bool -> Bool -> Bool
&& (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
'>')
Bool -> Bool -> Bool
&& (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
'"')
Bool -> Bool -> Bool
&& (Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
'\'')
{-# INLINE isSafeChar #-}
escapeText :: B.ByteString -> [B.ByteString]
escapeText :: ByteString -> [ByteString]
escapeText ByteString
str | ByteString -> Bool
B.null ByteString
str = []
escapeText ByteString
str =
let (ByteString
good, ByteString
bad) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
isSafeChar ByteString
str
in if ByteString -> Bool
B.null ByteString
good
then case Word8 -> Char
w2c (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> Word8
ByteString -> Word8
B.head ByteString
str of
Char
'&' -> [Char] -> ByteString
pack [Char]
"&"ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString]
escapeText ByteString
rema
Char
'<' -> [Char] -> ByteString
pack [Char]
"<"ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString]
escapeText ByteString
rema
Char
'>' -> [Char] -> ByteString
pack [Char]
">"ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString]
escapeText ByteString
rema
Char
'"' -> [Char] -> ByteString
pack [Char]
"""ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString]
escapeText ByteString
rema
Char
'\'' -> [Char] -> ByteString
pack [Char]
"'"ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString]
escapeText ByteString
rema
Char
_ -> [Char] -> [ByteString]
forall a. HasCallStack => [Char] -> a
error [Char]
"hexpat: impossible"
else ByteString
goodByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:ByteString -> [ByteString]
escapeText ByteString
bad
where
rema :: ByteString
rema = HasCallStack => ByteString -> ByteString
ByteString -> ByteString
B.tail ByteString
str
indent :: (NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
Int
-> n c tag text
-> n c tag text
indent :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
Int -> n c tag text -> n c tag text
indent = Int -> Int -> n c tag text -> n c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
Int -> Int -> n c tag text -> n c tag text
indent_ Int
0
indent_ :: forall n c tag text . (NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
Int
-> Int
-> n c tag text
-> n c tag text
indent_ :: forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
Int -> Int -> n c tag text -> n c tag text
indent_ Int
cur Int
perLevel n c tag text
elt | n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement n c tag text
elt =
((c (n c tag text) -> c (n c tag text))
-> n c tag text -> n c tag text)
-> n c tag text
-> (c (n c tag text) -> c (n c tag text))
-> n c tag text
forall a b c. (a -> b -> c) -> b -> a -> c
flip (c (n c tag text) -> c (n c tag text))
-> n c tag text -> n c tag text
forall tag text.
(c (n c tag text) -> c (n c tag text))
-> n c tag text -> n c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
(c (n c tag text) -> c (n c tag text))
-> n c tag text -> n c tag text
modifyChildren n c tag text
elt ((c (n c tag text) -> c (n c tag text)) -> n c tag text)
-> (c (n c tag text) -> c (n c tag text)) -> n c tag text
forall a b. (a -> b) -> a -> b
$ \c (n c tag text)
chs -> ItemM c (c (n c tag text)) -> c (n c tag text)
forall a. ItemM c (c a) -> c a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM c (c (n c tag text)) -> c (n c tag text))
-> ItemM c (c (n c tag text)) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$ do
(Bool
anyElts, c (n c tag text)
chs') <- [n c tag text]
-> c (n c tag text) -> ItemM c (Bool, c (n c tag text))
anyElements [] c (n c tag text)
chs
if Bool
anyElts
then Bool -> c (n c tag text) -> ItemM c (c (n c tag text))
addSpace Bool
True c (n c tag text)
chs'
else c (n c tag text) -> ItemM c (c (n c tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return c (n c tag text)
chs'
where
addSpace :: Bool -> c (n c tag text) -> ItemM c (c (n c tag text))
addSpace :: Bool -> c (n c tag text) -> ItemM c (c (n c tag text))
addSpace Bool
startOfText c (n c tag text)
l = do
ListItem c (n c tag text)
ch <- c (n c tag text) -> ItemM c (ListItem c (n c tag text))
forall a. c a -> ItemM c (ListItem c a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList c (n c tag text)
l
case ListItem c (n c tag text)
ch of
ListItem c (n c tag text)
Nil -> c (n c tag text) -> ItemM c (c (n c tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (n c tag text) -> ItemM c (c (n c tag text)))
-> c (n c tag text) -> ItemM c (c (n c tag text))
forall a b. (a -> b) -> a -> b
$ n c tag text -> c (n c tag text)
forall {a}. a -> c a
singleton (text -> n c tag text
forall text tag. text -> n c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
NodeClass n c =>
text -> n c tag text
mkText (text -> n c tag text) -> text -> n c tag text
forall a b. (a -> b) -> a -> b
$ [Char] -> text
forall s. GenericXMLString s => [Char] -> s
gxFromString (Char
'\n'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
cur Char
' '))
Cons n c tag text
elt c (n c tag text)
l' | n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement n c tag text
elt -> do
let cur' :: Int
cur' = Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
perLevel
c (n c tag text) -> ItemM c (c (n c tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (n c tag text) -> ItemM c (c (n c tag text)))
-> c (n c tag text) -> ItemM c (c (n c tag text))
forall a b. (a -> b) -> a -> b
$
n c tag text -> c (n c tag text) -> c (n c tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (text -> n c tag text
forall text tag. text -> n c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
NodeClass n c =>
text -> n c tag text
mkText (text -> n c tag text) -> text -> n c tag text
forall a b. (a -> b) -> a -> b
$ [Char] -> text
forall s. GenericXMLString s => [Char] -> s
gxFromString (Char
'\n'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
cur' Char
' ')) (c (n c tag text) -> c (n c tag text))
-> c (n c tag text) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$
n c tag text -> c (n c tag text) -> c (n c tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (Int -> Int -> n c tag text -> n c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
(NodeClass n c, GenericXMLString tag, GenericXMLString text) =>
Int -> Int -> n c tag text -> n c tag text
indent_ Int
cur' Int
perLevel n c tag text
elt) (c (n c tag text) -> c (n c tag text))
-> c (n c tag text) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$
ItemM c (c (n c tag text)) -> c (n c tag text)
forall a. ItemM c (c a) -> c a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (Bool -> c (n c tag text) -> ItemM c (c (n c tag text))
addSpace Bool
True c (n c tag text)
l')
Cons n c tag text
tx c (n c tag text)
l' | n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isText n c tag text
tx Bool -> Bool -> Bool
&& Bool
startOfText ->
case text -> Maybe text
forall {a}. GenericXMLString a => a -> Maybe a
strip (n c tag text -> text
forall text tag. Monoid text => n c tag text -> text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
(NodeClass n c, Monoid text) =>
n c tag text -> text
getText n c tag text
tx) of
Maybe text
Nothing -> Bool -> c (n c tag text) -> ItemM c (c (n c tag text))
addSpace Bool
True c (n c tag text)
l'
Just text
t' -> c (n c tag text) -> ItemM c (c (n c tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (n c tag text) -> ItemM c (c (n c tag text)))
-> c (n c tag text) -> ItemM c (c (n c tag text))
forall a b. (a -> b) -> a -> b
$
n c tag text -> c (n c tag text) -> c (n c tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons (text -> n c tag text
forall text tag. text -> n c tag text
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) text tag.
NodeClass n c =>
text -> n c tag text
mkText text
t') (c (n c tag text) -> c (n c tag text))
-> c (n c tag text) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$
ItemM c (c (n c tag text)) -> c (n c tag text)
forall a. ItemM c (c a) -> c a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM c (c (n c tag text)) -> c (n c tag text))
-> ItemM c (c (n c tag text)) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$ Bool -> c (n c tag text) -> ItemM c (c (n c tag text))
addSpace Bool
False c (n c tag text)
l'
Cons n c tag text
n c (n c tag text)
l' ->
c (n c tag text) -> ItemM c (c (n c tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (c (n c tag text) -> ItemM c (c (n c tag text)))
-> c (n c tag text) -> ItemM c (c (n c tag text))
forall a b. (a -> b) -> a -> b
$
n c tag text -> c (n c tag text) -> c (n c tag text)
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons n c tag text
n (c (n c tag text) -> c (n c tag text))
-> c (n c tag text) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$
ItemM c (c (n c tag text)) -> c (n c tag text)
forall a. ItemM c (c a) -> c a
forall (l :: * -> *) a. List l => ItemM l (l a) -> l a
joinL (ItemM c (c (n c tag text)) -> c (n c tag text))
-> ItemM c (c (n c tag text)) -> c (n c tag text)
forall a b. (a -> b) -> a -> b
$ Bool -> c (n c tag text) -> ItemM c (c (n c tag text))
addSpace Bool
False c (n c tag text)
l'
anyElements :: [n c tag text]
-> c (n c tag text)
-> ItemM c (Bool, c (n c tag text))
anyElements :: [n c tag text]
-> c (n c tag text) -> ItemM c (Bool, c (n c tag text))
anyElements [n c tag text]
acc c (n c tag text)
l = do
ListItem c (n c tag text)
n <- c (n c tag text) -> ItemM c (ListItem c (n c tag text))
forall a. c a -> ItemM c (ListItem c a)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
runList c (n c tag text)
l
case ListItem c (n c tag text)
n of
ListItem c (n c tag text)
Nil -> (Bool, c (n c tag text)) -> ItemM c (Bool, c (n c tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, [n c tag text] -> c (n c tag text) -> c (n c tag text)
instantiatedList [n c tag text]
acc c (n c tag text)
forall a. c a
forall (m :: * -> *) a. MonadPlus m => m a
mzero)
Cons n c tag text
n c (n c tag text)
l' | n c tag text -> Bool
forall tag text. n c tag text -> Bool
forall (n :: (* -> *) -> * -> * -> *) (c :: * -> *) tag text.
NodeClass n c =>
n c tag text -> Bool
isElement n c tag text
n -> (Bool, c (n c tag text)) -> ItemM c (Bool, c (n c tag text))
forall a. a -> ItemM c a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, [n c tag text] -> c (n c tag text) -> c (n c tag text)
instantiatedList (n c tag text
nn c tag text -> [n c tag text] -> [n c tag text]
forall a. a -> [a] -> [a]
:[n c tag text]
acc) c (n c tag text)
l')
Cons n c tag text
n c (n c tag text)
l' -> [n c tag text]
-> c (n c tag text) -> ItemM c (Bool, c (n c tag text))
anyElements (n c tag text
nn c tag text -> [n c tag text] -> [n c tag text]
forall a. a -> [a] -> [a]
:[n c tag text]
acc) c (n c tag text)
l'
where
instantiatedList :: [n c tag text] -> c (n c tag text) -> c (n c tag text)
instantiatedList :: [n c tag text] -> c (n c tag text) -> c (n c tag text)
instantiatedList [n c tag text]
acc c (n c tag text)
l' = [n c tag text] -> [n c tag text]
forall a. [a] -> [a]
reverse [n c tag text]
acc [n c tag text] -> c (n c tag text) -> c (n c tag text)
forall a. [a] -> c a -> c a
`prepend` c (n c tag text)
l'
prepend :: forall a . [a] -> c a -> c a
prepend :: forall a. [a] -> c a -> c a
prepend [a]
xs c a
l = (a -> c a -> c a) -> c a -> [a] -> c a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> c a -> c a
forall a. a -> c a -> c a
forall (l :: * -> *) a. List l => a -> l a -> l a
cons c a
l [a]
xs
strip :: a -> Maybe a
strip a
t | a -> Bool
forall s. GenericXMLString s => s -> Bool
gxNullString a
t = Maybe a
forall a. Maybe a
Nothing
strip a
t | Char -> Bool
isSpace (a -> Char
forall s. GenericXMLString s => s -> Char
gxHead a
t) = a -> Maybe a
strip (a -> a
forall s. GenericXMLString s => s -> s
gxTail a
t)
strip a
t = a -> Maybe a
forall a. a -> Maybe a
Just a
t
singleton :: a -> c a
singleton = a -> c a
forall {a}. a -> c a
forall (m :: * -> *) a. Monad m => a -> m a
return
indent_ Int
_ Int
_ n c tag text
n = n c tag text
n