summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2022-09-29 10:53:16 -0700
committerJohn MacFarlane <jgm@berkeley.edu>2022-09-29 10:53:16 -0700
commite099de1d4d2f4ca865596a6608774c7c0940a0d9 (patch)
tree457ee54fde35b62f2f277fa8f0d707f3db4cf19f /src/Text
parent931ccd03766f339ab1053b4d5ad8344f20733d5e (diff)
Factor out xml-light into an internal library.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/XML/Light.hs113
-rw-r--r--src/Text/Pandoc/XML/Light/Output.hs234
-rw-r--r--src/Text/Pandoc/XML/Light/Proc.hs137
-rw-r--r--src/Text/Pandoc/XML/Light/Types.hs191
4 files changed, 0 insertions, 675 deletions
diff --git a/src/Text/Pandoc/XML/Light.hs b/src/Text/Pandoc/XML/Light.hs
deleted file mode 100644
index 61025cb5c..000000000
--- a/src/Text/Pandoc/XML/Light.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{- |
- Module : Text.Pandoc.XML.Light
- Copyright : Copyright (C) 2021-2022 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-xml-light, which we used in pandoc's the XML-based readers, has
-some limitations: in particular, it produces nodes with String
-instead of Text, and the parser falls over on processing instructions
-(see #7091).
-
-This module exports much of the API of xml-light, but using Text instead
-of String. In addition, the xml-light parsers are replaced by xml-conduit's
-well-tested parser. (The xml-conduit types are mapped to types
-isomorphic to xml-light's, to avoid the need for massive code modifications
-elsewhere.) Bridge functions to map xml-light types to this module's
-types are also provided (since libraries like texmath still use xml-light).
-
-Another advantage of the xml-conduit parser is that it gives us
-detailed information on xml parse errors.
-
-In the future we may want to move to using xml-conduit or another
-xml library in the code base, but this change gives us
-better performance and accuracy without much change in the
-code that used xml-light.
--}
-module Text.Pandoc.XML.Light
- ( module Text.Pandoc.XML.Light.Types
- , module Text.Pandoc.XML.Light.Proc
- , module Text.Pandoc.XML.Light.Output
- -- * Replacement for xml-light's Text.XML.Input
- , parseXMLElement
- , parseXMLContents
- -- * Versions that allow passing in a custom entity table
- , parseXMLElementWithEntities
- , parseXMLContentsWithEntities
- ) where
-
-import qualified Control.Exception as E
-import qualified Text.XML as Conduit
-import Text.XML.Unresolved (InvalidEventStream(..))
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import qualified Data.Map as M
-import Data.Maybe (mapMaybe)
-import Text.Pandoc.XML.Light.Types
-import Text.Pandoc.XML.Light.Proc
-import Text.Pandoc.XML.Light.Output
-import qualified Data.XML.Types as XML
-
--- Drop in replacement for parseXMLDoc in xml-light.
-parseXMLElement :: TL.Text -> Either T.Text Element
-parseXMLElement = parseXMLElementWithEntities mempty
-
--- Drop in replacement for parseXMLDoc in xml-light.
-parseXMLElementWithEntities :: M.Map T.Text T.Text
- -> TL.Text -> Either T.Text Element
-parseXMLElementWithEntities entityMap t =
- elementToElement . Conduit.documentRoot <$>
- either (Left . T.pack . E.displayException) Right
- (Conduit.parseText Conduit.def{ Conduit.psRetainNamespaces = True
- , Conduit.psDecodeEntities = decodeEnts } t)
- where
- decodeEnts ref = case M.lookup ref entityMap of
- Nothing -> XML.ContentEntity ref
- Just t' -> XML.ContentText t'
-
-parseXMLContents :: TL.Text -> Either T.Text [Content]
-parseXMLContents = parseXMLContentsWithEntities mempty
-
-parseXMLContentsWithEntities :: M.Map T.Text T.Text
- -> TL.Text -> Either T.Text [Content]
-parseXMLContentsWithEntities entityMap t =
- case Conduit.parseText Conduit.def{ Conduit.psRetainNamespaces = True
- , Conduit.psDecodeEntities = decodeEnts
- } t of
- Left e ->
- case E.fromException e of
- Just (ContentAfterRoot _) ->
- elContent <$> parseXMLElementWithEntities entityMap
- ("<wrapper>" <> t <> "</wrapper>")
- _ -> Left . T.pack . E.displayException $ e
- Right x -> Right [Elem . elementToElement . Conduit.documentRoot $ x]
- where
- decodeEnts ref = case M.lookup ref entityMap of
- Nothing -> XML.ContentEntity ref
- Just t' -> XML.ContentText t'
-
-elementToElement :: Conduit.Element -> Element
-elementToElement (Conduit.Element name attribMap nodes) =
- Element (nameToQname name) attrs (mapMaybe nodeToContent nodes) Nothing
- where
- attrs = map (\(n,v) -> Attr (nameToQname n) v) $
- M.toList attribMap
- nameToQname (Conduit.Name localName mbns mbpref) =
- case mbpref of
- Nothing ->
- case T.stripPrefix "xmlns:" localName of
- Just rest -> QName rest mbns (Just "xmlns")
- Nothing -> QName localName mbns mbpref
- _ -> QName localName mbns mbpref
-
-nodeToContent :: Conduit.Node -> Maybe Content
-nodeToContent (Conduit.NodeElement el) =
- Just (Elem (elementToElement el))
-nodeToContent (Conduit.NodeContent t) =
- Just (Text (CData CDataText t Nothing))
-nodeToContent _ = Nothing
diff --git a/src/Text/Pandoc/XML/Light/Output.hs b/src/Text/Pandoc/XML/Light/Output.hs
deleted file mode 100644
index 6a2a73924..000000000
--- a/src/Text/Pandoc/XML/Light/Output.hs
+++ /dev/null
@@ -1,234 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
-{- |
- Module : Text.Pandoc.XML.Light.Output
- Copyright : Copyright (C) 2007 Galois, Inc., 2021-2022 John MacFarlane
- License : GNU GPL, version 2 or above
-
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
- This code is based on code from xml-light, released under the BSD3 license.
- We use a text Builder instead of ShowS.
--}
-module Text.Pandoc.XML.Light.Output
- ( -- * Replacement for xml-light's Text.XML.Output
- ppTopElement
- , ppElement
- , ppContent
- , ppcElement
- , ppcContent
- , showTopElement
- , showElement
- , showContent
- , useShortEmptyTags
- , defaultConfigPP
- , ConfigPP(..)
- ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Lazy as TL
-import Data.Text.Lazy.Builder (Builder, singleton, fromText, toLazyText)
-import Text.Pandoc.XML.Light.Types
-
---
--- duplicates functinos from Text.XML.Output
---
-
--- | The XML 1.0 header
-xmlHeader :: Text
-xmlHeader = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
-
-
---------------------------------------------------------------------------------
-data ConfigPP = ConfigPP
- { shortEmptyTag :: QName -> Bool
- , prettify :: Bool
- }
-
--- | Default pretty orinting configuration.
--- * Always use abbreviate empty tags.
-defaultConfigPP :: ConfigPP
-defaultConfigPP = ConfigPP { shortEmptyTag = const True
- , prettify = False
- }
-
--- | The predicate specifies for which empty tags we should use XML's
--- abbreviated notation <TAG />. This is useful if we are working with
--- some XML-ish standards (such as certain versions of HTML) where some
--- empty tags should always be displayed in the <TAG></TAG> form.
-useShortEmptyTags :: (QName -> Bool) -> ConfigPP -> ConfigPP
-useShortEmptyTags p c = c { shortEmptyTag = p }
-
-
--- | Specify if we should use extra white-space to make document more readable.
--- WARNING: This adds additional white-space to text elements,
--- and so it may change the meaning of the document.
-useExtraWhiteSpace :: Bool -> ConfigPP -> ConfigPP
-useExtraWhiteSpace p c = c { prettify = p }
-
--- | A configuration that tries to make things pretty
--- (possibly at the cost of changing the semantics a bit
--- through adding white space.)
-prettyConfigPP :: ConfigPP
-prettyConfigPP = useExtraWhiteSpace True defaultConfigPP
-
-
---------------------------------------------------------------------------------
-
-
--- | Pretty printing renders XML documents faithfully,
--- with the exception that whitespace may be added\/removed
--- in non-verbatim character data.
-ppTopElement :: Element -> Text
-ppTopElement = ppcTopElement prettyConfigPP
-
--- | Pretty printing elements
-ppElement :: Element -> Text
-ppElement = ppcElement prettyConfigPP
-
--- | Pretty printing content
-ppContent :: Content -> Text
-ppContent = ppcContent prettyConfigPP
-
--- | Pretty printing renders XML documents faithfully,
--- with the exception that whitespace may be added\/removed
--- in non-verbatim character data.
-ppcTopElement :: ConfigPP -> Element -> Text
-ppcTopElement c e = T.unlines [xmlHeader,ppcElement c e]
-
--- | Pretty printing elements
-ppcElement :: ConfigPP -> Element -> Text
-ppcElement c = TL.toStrict . toLazyText . ppElementS c mempty
-
--- | Pretty printing content
-ppcContent :: ConfigPP -> Content -> Text
-ppcContent c = TL.toStrict . toLazyText . ppContentS c mempty
-
-ppcCData :: ConfigPP -> CData -> Text
-ppcCData c = TL.toStrict . toLazyText . ppCDataS c mempty
-
-type Indent = Builder
-
--- | Pretty printing content using ShowT
-ppContentS :: ConfigPP -> Indent -> Content -> Builder
-ppContentS c i x = case x of
- Elem e -> ppElementS c i e
- Text t -> ppCDataS c i t
- CRef r -> showCRefS r
-
-ppElementS :: ConfigPP -> Indent -> Element -> Builder
-ppElementS c i e = i <> tagStart (elName e) (elAttribs e) <>
- (case elContent e of
- [] | "?" `T.isPrefixOf` qName name -> fromText " ?>"
- | shortEmptyTag c name -> fromText " />"
- [Text t] -> singleton '>' <> ppCDataS c mempty t <> tagEnd name
- cs -> singleton '>' <> nl <>
- mconcat (map ((<> nl) . ppContentS c (sp <> i)) cs) <>
- i <> tagEnd name
- where (nl,sp) = if prettify c then ("\n"," ") else ("","")
- )
- where name = elName e
-
-ppCDataS :: ConfigPP -> Indent -> CData -> Builder
-ppCDataS c i t = i <> if cdVerbatim t /= CDataText || not (prettify c)
- then showCDataS t
- else foldr cons mempty (T.unpack (showCData t))
- where cons :: Char -> Builder -> Builder
- cons '\n' ys = singleton '\n' <> i <> ys
- cons y ys = singleton y <> ys
-
-
-
---------------------------------------------------------------------------------
-
--- | Adds the <?xml?> header.
-showTopElement :: Element -> Text
-showTopElement c = xmlHeader <> showElement c
-
-showContent :: Content -> Text
-showContent = ppcContent defaultConfigPP
-
-showElement :: Element -> Text
-showElement = ppcElement defaultConfigPP
-
-showCData :: CData -> Text
-showCData = ppcCData defaultConfigPP
-
--- Note: crefs should not contain '&', ';', etc.
-showCRefS :: Text -> Builder
-showCRefS r = singleton '&' <> fromText r <> singleton ';'
-
--- | Convert a text element to characters.
-showCDataS :: CData -> Builder
-showCDataS cd =
- case cdVerbatim cd of
- CDataText -> escStr (cdData cd)
- CDataVerbatim -> fromText "<![CDATA[" <> escCData (cdData cd) <>
- fromText "]]>"
- CDataRaw -> fromText (cdData cd)
-
---------------------------------------------------------------------------------
-escCData :: Text -> Builder
-escCData t
- | "]]>" `T.isPrefixOf` t =
- fromText "]]]]><![CDATA[>" <> fromText (T.drop 3 t)
-escCData t
- = case T.uncons t of
- Nothing -> mempty
- Just (c,t') -> singleton c <> escCData t'
-
-escChar :: Char -> Builder
-escChar c = case c of
- '<' -> fromText "&lt;"
- '>' -> fromText "&gt;"
- '&' -> fromText "&amp;"
- '"' -> fromText "&quot;"
- -- we use &#39 instead of &apos; because IE apparently has difficulties
- -- rendering &apos; in xhtml.
- -- Reported by Rohan Drape <rohan.drape@gmail.com>.
- '\'' -> fromText "&#39;"
- _ -> singleton c
-
- {- original xml-light version:
- -- NOTE: We escape '\r' explicitly because otherwise they get lost
- -- when parsed back in because of then end-of-line normalization rules.
- _ | isPrint c || c == '\n' -> singleton c
- | otherwise -> showText "&#" . showsT oc . singleton ';'
- where oc = ord c
- -}
-
-escStr :: Text -> Builder
-escStr cs = if T.any needsEscape cs
- then mconcat (map escChar (T.unpack cs))
- else fromText cs
- where
- needsEscape '<' = True
- needsEscape '>' = True
- needsEscape '&' = True
- needsEscape '"' = True
- needsEscape '\'' = True
- needsEscape _ = False
-
-tagEnd :: QName -> Builder
-tagEnd qn = fromText "</" <> showQName qn <> singleton '>'
-
-tagStart :: QName -> [Attr] -> Builder
-tagStart qn as = singleton '<' <> showQName qn <> as_str
- where as_str = if null as
- then mempty
- else mconcat (map showAttr as)
-
-showAttr :: Attr -> Builder
-showAttr (Attr qn v) = singleton ' ' <> showQName qn <>
- singleton '=' <>
- singleton '"' <> escStr v <> singleton '"'
-
-showQName :: QName -> Builder
-showQName q =
- case qPrefix q of
- Nothing -> fromText (qName q)
- Just p -> fromText p <> singleton ':' <> fromText (qName q)
diff --git a/src/Text/Pandoc/XML/Light/Proc.hs b/src/Text/Pandoc/XML/Light/Proc.hs
deleted file mode 100644
index 87104f3a4..000000000
--- a/src/Text/Pandoc/XML/Light/Proc.hs
+++ /dev/null
@@ -1,137 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{- |
- Module : Text.Pandoc.XML.Light.Proc
- Copyright : Copyright (C) 2007 Galois, Inc., 2021-2022 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
- This code is taken from xml-light, released under the BSD3 license.
--}
-module Text.Pandoc.XML.Light.Proc
- (
- -- * Replacement for xml-light's Text.XML.Proc
- strContent
- , onlyElems
- , elChildren
- , onlyText
- , findChildren
- , filterChildren
- , filterChildrenName
- , findChild
- , filterChild
- , filterChildName
- , findElement
- , filterElement
- , filterElementName
- , findElements
- , filterElements
- , filterElementsName
- , findAttr
- , lookupAttr
- , lookupAttrBy
- , findAttrBy
- ) where
-
-import Data.Text (Text)
-import Data.Maybe (listToMaybe)
-import Data.List(find)
-import Text.Pandoc.XML.Light.Types
-
---
--- copied from xml-light Text.XML.Proc
---
-
--- | Get the text value of an XML element. This function
--- ignores non-text elements, and concatenates all text elements.
-strContent :: Element -> Text
-strContent = mconcat . map cdData . onlyText . elContent
-
--- | Select only the elements from a list of XML content.
-onlyElems :: [Content] -> [Element]
-onlyElems xs = [ x | Elem x <- xs ]
-
--- | Select only the elements from a parent.
-elChildren :: Element -> [Element]
-elChildren e = [ x | Elem x <- elContent e ]
-
--- | Select only the text from a list of XML content.
-onlyText :: [Content] -> [CData]
-onlyText xs = [ x | Text x <- xs ]
-
--- | Find all immediate children with the given name.
-findChildren :: QName -> Element -> [Element]
-findChildren q e = filterChildren ((q ==) . elName) e
-
--- | Filter all immediate children wrt a given predicate.
-filterChildren :: (Element -> Bool) -> Element -> [Element]
-filterChildren p e = filter p (onlyElems (elContent e))
-
-
--- | Filter all immediate children wrt a given predicate over their names.
-filterChildrenName :: (QName -> Bool) -> Element -> [Element]
-filterChildrenName p e = filter (p.elName) (onlyElems (elContent e))
-
-
--- | Find an immediate child with the given name.
-findChild :: QName -> Element -> Maybe Element
-findChild q e = listToMaybe (findChildren q e)
-
--- | Find an immediate child with the given name.
-filterChild :: (Element -> Bool) -> Element -> Maybe Element
-filterChild p e = listToMaybe (filterChildren p e)
-
--- | Find an immediate child with name matching a predicate.
-filterChildName :: (QName -> Bool) -> Element -> Maybe Element
-filterChildName p e = listToMaybe (filterChildrenName p e)
-
--- | Find the left-most occurrence of an element matching given name.
-findElement :: QName -> Element -> Maybe Element
-findElement q e = listToMaybe (findElements q e)
-
--- | Filter the left-most occurrence of an element wrt. given predicate.
-filterElement :: (Element -> Bool) -> Element -> Maybe Element
-filterElement p e = listToMaybe (filterElements p e)
-
--- | Filter the left-most occurrence of an element wrt. given predicate.
-filterElementName :: (QName -> Bool) -> Element -> Maybe Element
-filterElementName p e = listToMaybe (filterElementsName p e)
-
--- | Find all non-nested occurrences of an element.
--- (i.e., once we have found an element, we do not search
--- for more occurrences among the element's children).
-findElements :: QName -> Element -> [Element]
-findElements qn e = filterElementsName (qn==) e
-
--- | Find all non-nested occurrences of an element wrt. given predicate.
--- (i.e., once we have found an element, we do not search
--- for more occurrences among the element's children).
-filterElements :: (Element -> Bool) -> Element -> [Element]
-filterElements p e
- | p e = [e]
- | otherwise = concatMap (filterElements p) $ onlyElems $ elContent e
-
--- | Find all non-nested occurrences of an element wrt a predicate over element names.
--- (i.e., once we have found an element, we do not search
--- for more occurrences among the element's children).
-filterElementsName :: (QName -> Bool) -> Element -> [Element]
-filterElementsName p e = filterElements (p.elName) e
-
--- | Lookup the value of an attribute.
-findAttr :: QName -> Element -> Maybe Text
-findAttr x e = lookupAttr x (elAttribs e)
-
--- | Lookup attribute name from list.
-lookupAttr :: QName -> [Attr] -> Maybe Text
-lookupAttr x = lookupAttrBy (x ==)
-
--- | Lookup the first attribute whose name satisfies the given predicate.
-lookupAttrBy :: (QName -> Bool) -> [Attr] -> Maybe Text
-lookupAttrBy p as = attrVal `fmap` find (p . attrKey) as
-
--- | Lookup the value of the first attribute whose name
--- satisfies the given predicate.
-findAttrBy :: (QName -> Bool) -> Element -> Maybe Text
-findAttrBy p e = lookupAttrBy p (elAttribs e)
diff --git a/src/Text/Pandoc/XML/Light/Types.hs b/src/Text/Pandoc/XML/Light/Types.hs
deleted file mode 100644
index 59edb8979..000000000
--- a/src/Text/Pandoc/XML/Light/Types.hs
+++ /dev/null
@@ -1,191 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{- |
- Module : Text.Pandoc.XML.Light.Types
- Copyright : Copyright (C) 2007 Galois, Inc., 2021-2022 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
- This code is taken from xml-light, released under the BSD3 license.
- It has been modified to use Text instead of String, and the fromXL*
- functions have been added.
--}
-module Text.Pandoc.XML.Light.Types
- ( -- * Basic types, duplicating those from xml-light but with Text
- -- instead of String
- Line
- , Content(..)
- , Element(..)
- , Attr(..)
- , CData(..)
- , CDataKind(..)
- , QName(..)
- , Node(..)
- , unode
- , unqual
- , add_attr
- , add_attrs
- -- * Conversion functions from xml-light types
- , fromXLQName
- , fromXLCData
- , fromXLElement
- , fromXLAttr
- , fromXLContent
- ) where
-
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Data (Data)
-import Data.Typeable (Typeable)
-import qualified Text.XML.Light as XL
-
---
--- type definitions lightly modified from xml-light
---
-
--- | A line is an Integer
-type Line = Integer
-
--- | XML content
-data Content = Elem Element
- | Text CData
- | CRef Text
- deriving (Show, Typeable, Data, Ord, Eq)
-
--- | XML elements
-data Element = Element {
- elName :: QName,
- elAttribs :: [Attr],
- elContent :: [Content],
- elLine :: Maybe Line
- } deriving (Show, Typeable, Data, Ord, Eq)
-
--- | XML attributes
-data Attr = Attr {
- attrKey :: QName,
- attrVal :: Text
- } deriving (Eq, Ord, Show, Typeable, Data)
-
--- | XML CData
-data CData = CData {
- cdVerbatim :: CDataKind,
- cdData :: Text,
- cdLine :: Maybe Line
- } deriving (Show, Typeable, Data, Ord, Eq)
-
-data CDataKind
- = CDataText -- ^ Ordinary character data; pretty printer escapes &, < etc.
- | CDataVerbatim -- ^ Unescaped character data; pretty printer embeds it in <![CDATA[..
- | CDataRaw -- ^ As-is character data; pretty printer passes it along without any escaping or CDATA wrap-up.
- deriving ( Eq, Ord, Show, Typeable, Data )
-
--- | XML qualified names
-data QName = QName {
- qName :: Text,
- qURI :: Maybe Text,
- qPrefix :: Maybe Text
- } deriving (Show, Typeable, Data)
-
-
-instance Eq QName where
- q1 == q2 = compare q1 q2 == EQ
-
-instance Ord QName where
- compare q1 q2 =
- case compare (qName q1) (qName q2) of
- EQ -> case (qURI q1, qURI q2) of
- (Nothing,Nothing) -> compare (qPrefix q1) (qPrefix q2)
- (u1,u2) -> compare u1 u2
- x -> x
-
-class Node t where
- node :: QName -> t -> Element
-
-instance Node ([Attr],[Content]) where
- node n (attrs,cont) = Element { elName = n
- , elAttribs = attrs
- , elContent = cont
- , elLine = Nothing
- }
-
-instance Node [Attr] where node n as = node n (as,[]::[Content])
-instance Node Attr where node n a = node n [a]
-instance Node () where node n () = node n ([]::[Attr])
-
-instance Node [Content] where node n cs = node n ([]::[Attr],cs)
-instance Node Content where node n c = node n [c]
-instance Node ([Attr],Content) where node n (as,c) = node n (as,[c])
-instance Node (Attr,Content) where node n (a,c) = node n ([a],[c])
-
-instance Node ([Attr],[Element]) where
- node n (as,cs) = node n (as,map Elem cs)
-
-instance Node ([Attr],Element) where node n (as,c) = node n (as,[c])
-instance Node (Attr,Element) where node n (a,c) = node n ([a],c)
-instance Node [Element] where node n es = node n ([]::[Attr],es)
-instance Node Element where node n e = node n [e]
-
-instance Node ([Attr],[CData]) where
- node n (as,cs) = node n (as,map Text cs)
-
-instance Node ([Attr],CData) where node n (as,c) = node n (as,[c])
-instance Node (Attr,CData) where node n (a,c) = node n ([a],c)
-instance Node [CData] where node n es = node n ([]::[Attr],es)
-instance Node CData where node n e = node n [e]
-
-instance Node ([Attr],Text) where
- node n (as,t) = node n (as, CData { cdVerbatim = CDataText
- , cdData = t
- , cdLine = Nothing })
-
-instance Node (Attr,Text ) where node n (a,t) = node n ([a],t)
-instance Node Text where node n t = node n ([]::[Attr],t)
-
--- | Create node with unqualified name
-unode :: Node t => Text -> t -> Element
-unode = node . unqual
-
-unqual :: Text -> QName
-unqual x = QName x Nothing Nothing
-
--- | Add an attribute to an element.
-add_attr :: Attr -> Element -> Element
-add_attr a e = add_attrs [a] e
-
--- | Add some attributes to an element.
-add_attrs :: [Attr] -> Element -> Element
-add_attrs as e = e { elAttribs = as ++ elAttribs e }
-
---
--- conversion from xml-light
---
-
-fromXLQName :: XL.QName -> QName
-fromXLQName qn = QName { qName = T.pack $ XL.qName qn
- , qURI = T.pack <$> XL.qURI qn
- , qPrefix = T.pack <$> XL.qPrefix qn }
-
-fromXLCData :: XL.CData -> CData
-fromXLCData cd = CData { cdVerbatim = case XL.cdVerbatim cd of
- XL.CDataText -> CDataText
- XL.CDataVerbatim -> CDataVerbatim
- XL.CDataRaw -> CDataRaw
- , cdData = T.pack $ XL.cdData cd
- , cdLine = XL.cdLine cd }
-
-fromXLElement :: XL.Element -> Element
-fromXLElement el = Element { elName = fromXLQName $ XL.elName el
- , elAttribs = map fromXLAttr $ XL.elAttribs el
- , elContent = map fromXLContent $ XL.elContent el
- , elLine = XL.elLine el }
-
-fromXLAttr :: XL.Attr -> Attr
-fromXLAttr (XL.Attr qn s) = Attr (fromXLQName qn) (T.pack s)
-
-fromXLContent :: XL.Content -> Content
-fromXLContent (XL.Elem el) = Elem $ fromXLElement el
-fromXLContent (XL.Text cd) = Text $ fromXLCData cd
-fromXLContent (XL.CRef s) = CRef (T.pack s)