module Text.XML.WraXML.Tree.HaXml (
fromXmlTree,
multiFromXmlTree,
toXmlTree, toXmlTree',
lift,
onContent,
liftFilterToDocument,
processWith,
) where
import qualified Text.XML.HaXml as HaXml
import Text.XML.HaXml.Posn(Posn, posInNewCxt)
import Text.XML.WraXML.Tree
(Branch(Tag), Leaf(Text, PI, Comment, CData, Warning), )
import qualified Text.XML.WraXML.Element as Elem
import qualified Text.XML.WraXML.Tree as XmlTree
import qualified Text.XML.WraXML.Tree.Literal as XmlTreeL
import qualified Data.Tree.BranchLeafLabel as Tree
import qualified Text.XML.WraXML.String as XmlString
import qualified Text.XML.WraXML.String.HaXml as HaXmlString
import qualified Text.XML.Basic.Character as XmlChar
import qualified Text.XML.Basic.Attribute as Attr
import qualified Text.XML.Basic.Name as Name
import qualified Text.XML.Basic.ProcessingInstruction as PI
import Data.Tuple.HT (mapPair, )
fromXmlTree ::
(Name.Tag name, Name.Attribute name) =>
XmlTree.T i name XmlString.T -> HaXml.Content i
fromXmlTree :: forall name i.
(Tag name, Attribute name) =>
T i name T -> Content i
fromXmlTree T i name T
x =
case forall name i.
(Tag name, Attribute name) =>
T i name T -> [Content i]
multiFromXmlTree T i name T
x of
[Content i
y] -> Content i
y
[Content i]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"top branch can't be a string"
haxmlName :: (Name.C name) => name -> HaXml.QName
haxmlName :: forall name. C name => name -> QName
haxmlName = [Char] -> QName
HaXml.N forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name. C name => name -> [Char]
Name.toString
fromAttribute ::
(Name.Attribute name) => Attr.T name XmlString.T -> HaXml.Attribute
fromAttribute :: forall name. Attribute name => T name T -> Attribute
fromAttribute =
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ([Char] -> QName
HaXml.N, T -> AttValue
HaXmlString.fromXmlString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name string.
Attribute name =>
T name string -> ([Char], string)
Attr.toPair
multiFromXmlTree ::
(Name.Tag name, Name.Attribute name) =>
XmlTree.T i name XmlString.T -> [HaXml.Content i]
multiFromXmlTree :: forall name i.
(Tag name, Attribute name) =>
T i name T -> [Content i]
multiFromXmlTree =
forall i a b branch leaf.
(i -> a -> b)
-> (branch -> [b] -> a) -> (leaf -> a) -> T i branch leaf -> b
Tree.fold
(\i
i i -> [Content i]
f -> i -> [Content i]
f i
i)
(\Branch name T
x [[Content i]]
subs i
i ->
case Branch name T
x of
Tag (Elem.Cons Name name
name [T name T]
attrs) ->
[forall i. Element i -> i -> Content i
HaXml.CElem (forall i. QName -> [Attribute] -> [Content i] -> Element i
HaXml.Elem (forall name. C name => name -> QName
haxmlName Name name
name)
(forall a b. (a -> b) -> [a] -> [b]
map forall name. Attribute name => T name T -> Attribute
fromAttribute [T name T]
attrs)
(forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Content i]]
subs)) i
i])
(\Leaf name T
x i
i ->
case Leaf name T
x of
Text Bool
whitespace T
str0 ->
forall a. ([Char] -> a) -> (Int -> a) -> ([Char] -> a) -> T -> [a]
XmlChar.switchUnicodeRuns
(forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall i. Bool -> [Char] -> i -> Content i
HaXml.CString Bool
whitespace) i
i)
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall i. Reference -> i -> Content i
HaXml.CRef i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Reference
HaXml.RefChar)
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall i. Reference -> i -> Content i
HaXml.CRef i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Reference
HaXml.RefEntity)
T
str0
Comment [Char]
str ->
[forall i. Misc -> i -> Content i
HaXml.CMisc ([Char] -> Misc
HaXml.Comment [Char]
str) i
i]
CData [Char]
str ->
[forall i. Bool -> [Char] -> i -> Content i
HaXml.CString Bool
True [Char]
str i
i]
PI Name name
target T name T
p ->
[forall i. Misc -> i -> Content i
HaXml.CMisc (ProcessingInstruction -> Misc
HaXml.PI (forall name. C name => name -> [Char]
Name.toString Name name
target,
case T name T
p of
PI.Known [T name T]
attrs -> forall name string.
(Attribute name, C string) =>
[T name string] -> ShowS
Attr.formatListBlankHead [T name T]
attrs [Char]
""
PI.Unknown [Char]
str -> [Char]
str)) i
i]
Warning [Char]
str ->
[forall i. Misc -> i -> Content i
HaXml.CMisc ([Char] -> Misc
HaXml.Comment ([Char]
"Warning: " forall a. [a] -> [a] -> [a]
++ [Char]
str)) i
i]) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall i name str.
T i name str -> T i (Branch name str) (Leaf name str)
XmlTree.unwrap
toXmlTree, toXmlTree' ::
(Name.Tag name, Name.Attribute name) =>
HaXml.Content i -> XmlTree.T i name XmlString.T
toXmlTree :: forall name i.
(Tag name, Attribute name) =>
Content i -> T i name T
toXmlTree = forall str i name. Monoid str => Filter i name str
XmlTree.mergeStrings forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name i.
(Tag name, Attribute name) =>
Content i -> T i name T
toXmlTree'
toAttribute :: HaXml.Attribute -> (String, XmlString.T)
toAttribute :: Attribute -> ([Char], T)
toAttribute =
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (QName -> [Char]
HaXml.qname, AttValue -> T
HaXmlString.toXmlString)
toXmlTree' :: forall name i.
(Tag name, Attribute name) =>
Content i -> T i name T
toXmlTree' Content i
x =
case Content i
x of
HaXml.CElem (HaXml.Elem QName
name [Attribute]
attrs [Content i]
subTrees) i
i ->
forall name i str.
(Tag name, Attribute name) =>
i -> [Char] -> [([Char], str)] -> [T i name str] -> T i name str
XmlTreeL.tagIndexAttr i
i
(QName -> [Char]
HaXml.qname QName
name)
(forall a b. (a -> b) -> [a] -> [b]
map Attribute -> ([Char], T)
toAttribute [Attribute]
attrs)
(forall a b. (a -> b) -> [a] -> [b]
map forall name i.
(Tag name, Attribute name) =>
Content i -> T i name T
toXmlTree' [Content i]
subTrees)
HaXml.CString Bool
whitespace [Char]
str i
i ->
forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
XmlTree.wrap2 i
i forall a b. (a -> b) -> a -> b
$
forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf (forall name str. Bool -> str -> Leaf name str
Text Bool
whitespace ([Char] -> T
XmlString.fromString [Char]
str))
HaXml.CRef Reference
ref i
i ->
forall i str name. i -> str -> T i name str
XmlTree.literalIndex i
i [Reference -> T
HaXmlString.refToXmlAtom Reference
ref]
HaXml.CMisc Misc
misc i
i ->
forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
XmlTree.wrap2 i
i forall a b. (a -> b) -> a -> b
$
forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf (case Misc
misc of
HaXml.Comment [Char]
str -> forall name str. [Char] -> Leaf name str
Comment [Char]
str
HaXml.PI ([Char]
target, [Char]
p) ->
forall name str. Name name -> T name str -> Leaf name str
PI (forall name. C name => [Char] -> name
Name.fromString [Char]
target) forall a b. (a -> b) -> a -> b
$ forall name string. [Char] -> T name string
PI.Unknown [Char]
p)
lift ::
(Name.Tag name, Name.Attribute name) =>
XmlTree.Filter i name XmlString.T -> (HaXml.Content i -> HaXml.Content i)
lift :: forall name i.
(Tag name, Attribute name) =>
Filter i name T -> Content i -> Content i
lift Filter i name T
f = forall name i.
(Tag name, Attribute name) =>
T i name T -> Content i
fromXmlTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. Filter i name T
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name i.
(Tag name, Attribute name) =>
Content i -> T i name T
toXmlTree
onContent ::
FilePath ->
(HaXml.Content Posn -> HaXml.Content Posn) ->
(HaXml.Document Posn -> HaXml.Document Posn)
onContent :: [Char]
-> (Content Posn -> Content Posn) -> Document Posn -> Document Posn
onContent [Char]
file Content Posn -> Content Posn
f (HaXml.Document Prolog
p SymTab EntityDef
s Element Posn
e [Misc]
m) =
case Content Posn -> Content Posn
f (forall i. Element i -> i -> Content i
HaXml.CElem Element Posn
e ([Char] -> Maybe Posn -> Posn
posInNewCxt [Char]
file forall a. Maybe a
Nothing)) of
HaXml.CElem Element Posn
e' Posn
_ -> forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
HaXml.Document Prolog
p SymTab EntityDef
s Element Posn
e' [Misc]
m
Content Posn
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"produced wrong output"
liftFilterToDocument ::
(Name.Tag name, Name.Attribute name) =>
FilePath -> XmlTree.Filter Posn name XmlString.T ->
(HaXml.Document Posn -> HaXml.Document Posn)
liftFilterToDocument :: forall name.
(Tag name, Attribute name) =>
[Char] -> Filter Posn name T -> Document Posn -> Document Posn
liftFilterToDocument [Char]
file =
[Char]
-> (Content Posn -> Content Posn) -> Document Posn -> Document Posn
onContent [Char]
file forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name i.
(Tag name, Attribute name) =>
Filter i name T -> Content i -> Content i
lift
processWith ::
(Name.Tag name, Name.Attribute name) =>
XmlTree.Filter Posn name XmlString.T -> IO ()
processWith :: forall name.
(Tag name, Attribute name) =>
Filter Posn name T -> IO ()
processWith = CFilter Posn -> IO ()
HaXml.processXmlWith forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> a -> [b]
XmlTree.liftTrans forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name i.
(Tag name, Attribute name) =>
Filter i name T -> Content i -> Content i
lift