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, )


{- * conversion from our XML tree to HaXml tree -}

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


{- * conversion from HaXml tree to our XML tree -}

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 our XML filters to HaXml filters -}

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


{- |
Lift a filter of HaXml trees to a processor of a HaXml document.

cf. 'Text.XML.HaXml.Wrappers.onContent'
-}
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