module Text.XML.WraXML.Tree where

import qualified Text.HTML.WraXML.String as HtmlString
import qualified Text.XML.WraXML.String  as XmlString
import qualified Text.XML.WraXML.Element as Elem

import qualified Text.XML.Basic.Tag as Tag
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 qualified Text.XML.Basic.Format as Format

import qualified Data.Tree.BranchLeafLabel as Tree
import qualified Data.String.Unicode as Unicode
import qualified Data.Char as Char

import qualified Control.Monad.Exception.Synchronous as Exc
import Control.Monad.Trans.Writer (Writer, writer, runWriter, censor)

import           Data.Foldable (Foldable(foldMap))
import           Data.Traversable (Traversable(traverse))
import           Control.Applicative (Applicative, )
import qualified Control.Applicative as App
import           Data.List.HT (unzipEithers, )
import           Data.Tuple.HT (mapFst, mapSnd, mapPair, swap, )
import           Data.Maybe (mapMaybe, fromMaybe, )
import           Data.Monoid (Monoid, mempty, mappend, mconcat, )


{- * data structures -}

newtype T i name str =
   Cons {forall i name str.
T i name str -> T i (Branch name str) (Leaf name str)
unwrap :: Tree.T i (Branch name str) (Leaf name str)}
   deriving (Int -> T i name str -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall i name str.
(Attribute name, Show i, Show name, Show str) =>
Int -> T i name str -> ShowS
forall i name str.
(Attribute name, Show i, Show name, Show str) =>
[T i name str] -> ShowS
forall i name str.
(Attribute name, Show i, Show name, Show str) =>
T i name str -> String
showList :: [T i name str] -> ShowS
$cshowList :: forall i name str.
(Attribute name, Show i, Show name, Show str) =>
[T i name str] -> ShowS
show :: T i name str -> String
$cshow :: forall i name str.
(Attribute name, Show i, Show name, Show str) =>
T i name str -> String
showsPrec :: Int -> T i name str -> ShowS
$cshowsPrec :: forall i name str.
(Attribute name, Show i, Show name, Show str) =>
Int -> T i name str -> ShowS
Show)

data Branch name str =
     Tag    {forall name str. Branch name str -> T name str
getElement :: Elem.T name str}
   deriving (Int -> Branch name str -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall name str.
(Attribute name, Show name, Show str) =>
Int -> Branch name str -> ShowS
forall name str.
(Attribute name, Show name, Show str) =>
[Branch name str] -> ShowS
forall name str.
(Attribute name, Show name, Show str) =>
Branch name str -> String
showList :: [Branch name str] -> ShowS
$cshowList :: forall name str.
(Attribute name, Show name, Show str) =>
[Branch name str] -> ShowS
show :: Branch name str -> String
$cshow :: forall name str.
(Attribute name, Show name, Show str) =>
Branch name str -> String
showsPrec :: Int -> Branch name str -> ShowS
$cshowsPrec :: forall name str.
(Attribute name, Show name, Show str) =>
Int -> Branch name str -> ShowS
Show)

{-
It is disputable whether comments (and warnings)
shall have type String or 'str'.
Can a comment contain non-ASCII characters and XML entities?
This is important for finding the comment ending "-->" properly.
What about scripts enclosed in comment delimiters?
Mozilla and Firefox don't do any encoding in the SCRIPT tag at all.
This seems to be wrong, since scripts frequently contain strings
with tag descriptions, like '<BR>'.
-}
data Leaf name str =
     Text    Bool {- is whitespace significant -} str
   | Comment String  -- better 'str'?
   | CData   String
   | PI      (Tag.Name name) (PI.T name str)
   | Warning String  -- better 'str'?


{-# DEPRECATED AttributePlain "use Attribute type from xml-basic package instead" #-}
type AttributePlain = (String, String)


instance (Name.Attribute name, Show name, Show str) =>
      Show (Leaf name str) where
   showsPrec :: Int -> Leaf name str -> ShowS
showsPrec Int
prec Leaf name str
x =
      Bool -> ShowS -> ShowS
showParen (Int
precforall a. Ord a => a -> a -> Bool
>=Int
10) forall a b. (a -> b) -> a -> b
$
      case Leaf name str
x of
         Text   Bool
_ str
str -> String -> ShowS
showString String
"Text "    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 str
str
         Comment  String
str -> String -> ShowS
showString String
"Comment " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
str
         CData    String
str -> String -> ShowS
showString String
"CData "   forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
str
         PI Name name
target T name str
p  ->
--            showString "ProcessingInstruction " .
            String -> ShowS
showString String
"PI " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Name name
target forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
            forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 T name str
p
         {- Maybe it is better to attach warnings to malicious tags
            instead of throwing them into the tag soup.
            But how to tell the position of the error then? -}
         Warning  String
str -> String -> ShowS
showString String
"Warning " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
str



{- * generators -}

wrap :: Tree.T i (Branch name str) (Leaf name str) -> T i name str
wrap :: forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap = forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
Cons

wrap2 :: i -> Tree.Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 :: forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 = forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap

lift ::
   (Tree.T i (Branch name str0) (Leaf name str0) ->
    Tree.T j (Branch name str1) (Leaf name str1)) ->
   (T i name str0 -> T j name str1)
lift :: forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift T i (Branch name str0) (Leaf name str0)
-> T j (Branch name str1) (Leaf name str1)
f = forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. T i (Branch name str0) (Leaf name str0)
-> T j (Branch name str1) (Leaf name str1)
f 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)
unwrap

liftA :: Applicative m =>
   (Tree.T i (Branch name str0) (Leaf name str0) ->
    m (Tree.T i (Branch name str1) (Leaf name str1))) ->
   (T i name str0 -> m (T i name str1))
liftA :: forall (m :: * -> *) i name str0 str1.
Applicative m =>
(T i (Branch name str0) (Leaf name str0)
 -> m (T i (Branch name str1) (Leaf name str1)))
-> T i name str0 -> m (T i name str1)
liftA T i (Branch name str0) (Leaf name str0)
-> m (T i (Branch name str1) (Leaf name str1))
f = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. T i (Branch name str0) (Leaf name str0)
-> m (T i (Branch name str1) (Leaf name str1))
f 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)
unwrap


-- | Build some textual content.
literal :: str -> T i name str
literal :: forall str i name. str -> T i name str
literal = forall i str name. i -> str -> T i name str
literalIndex (forall a. HasCallStack => String -> a
error String
"literal: no index given")

literalIndex :: i -> str -> T i name str
literalIndex :: forall i str name. i -> str -> T i name str
literalIndex i
i =
   forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Bool -> str -> Leaf name str
Text Bool
False


comment :: String -> T i name str
comment :: forall i name str. String -> T i name str
comment = forall i name str. i -> String -> T i name str
commentIndex (forall a. HasCallStack => String -> a
error String
"comment: no index given")

commentIndex :: i -> String -> T i name str
commentIndex :: forall i name str. i -> String -> T i name str
commentIndex i
i =
   forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. String -> Leaf name str
Comment

warning :: String -> T i name str
warning :: forall i name str. String -> T i name str
warning = forall i name str. i -> String -> T i name str
warningIndex (forall a. HasCallStack => String -> a
error String
"warning: no index given")

warningIndex :: i -> String -> T i name str
warningIndex :: forall i name str. i -> String -> T i name str
warningIndex i
i =
   forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. String -> Leaf name str
Warning

cdata :: String -> T i name str
cdata :: forall i name str. String -> T i name str
cdata = forall i name str. i -> String -> T i name str
cdataIndex (forall a. HasCallStack => String -> a
error String
"cdata: no index given")

cdataIndex :: i -> String -> T i name str
cdataIndex :: forall i name str. i -> String -> T i name str
cdataIndex i
i =
   forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. String -> Leaf name str
CData

processing :: Tag.Name name -> PI.T name str -> T i name str
processing :: forall name str i. Name name -> T name str -> T i name str
processing = forall i name str. i -> Name name -> T name str -> T i name str
processingIndex (forall a. HasCallStack => String -> a
error String
"processing: no index given")

processingIndex :: i -> Tag.Name name -> PI.T name str -> T i name str
processingIndex :: forall i name str. i -> Name name -> T name str -> T i name str
processingIndex i
i Name name
target =
   forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Name name -> T name str -> Leaf name str
PI Name name
target

tag :: Tag.Name name -> [T i name str] -> T i name str
tag :: forall name i str. Name name -> [T i name str] -> T i name str
tag Name name
name = forall name str i.
Name name -> [T name str] -> [T i name str] -> T i name str
tagAttr Name name
name []

tagAttr :: Tag.Name name -> [Attr.T name str] -> [T i name str] -> T i name str
tagAttr :: forall name str i.
Name name -> [T name str] -> [T i name str] -> T i name str
tagAttr = forall i name str.
i -> Name name -> [T name str] -> [T i name str] -> T i name str
tagIndexAttr (forall a. HasCallStack => String -> a
error String
"tagAttr: no index given")

tagIndexAttr :: i -> Tag.Name name -> [Attr.T name str] -> [T i name str] -> T i name str
tagIndexAttr :: forall i name str.
i -> Name name -> [T name str] -> [T i name str] -> T i name str
tagIndexAttr i
index Name name
name [T name str]
attrs =
   forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 i
index forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall i branch leaf.
branch -> [T i branch leaf] -> Elem i branch leaf
Tree.Branch (forall name str. T name str -> Branch name str
Tag (forall name str. Name name -> [T name str] -> T name str
Elem.Cons Name name
name [T name str]
attrs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i name str -> T i (Branch name str) (Leaf name str)
unwrap


{- * Conversions -}

liftTrans :: (a -> b) -> (a -> [b])
liftTrans :: forall a b. (a -> b) -> a -> [b]
liftTrans a -> b
f = (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

liftText :: (String -> String) -> (Leaf name String -> Leaf name String)
liftText :: forall name. ShowS -> Leaf name String -> Leaf name String
liftText ShowS
f Leaf name String
leaf =
   case Leaf name String
leaf of
      Text Bool
b String
s -> forall name str. Bool -> str -> Leaf name str
Text Bool
b (ShowS
f String
s)
      CData String
s  -> forall name str. String -> Leaf name str
CData (ShowS
f String
s)
      Leaf name String
_ -> Leaf name String
leaf

liftTextA :: Applicative m => (String -> m String) -> (Leaf name String -> m (Leaf name String))
liftTextA :: forall (m :: * -> *) name.
Applicative m =>
(String -> m String) -> Leaf name String -> m (Leaf name String)
liftTextA String -> m String
f Leaf name String
leaf =
   case Leaf name String
leaf of
      Text Bool
b String
s -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA (forall name str. Bool -> str -> Leaf name str
Text Bool
b) (String -> m String
f String
s)
      CData String
s  -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA forall name str. String -> Leaf name str
CData forall a b. (a -> b) -> a -> b
$ String -> m String
f String
s
      Leaf name String
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
App.pure Leaf name String
leaf



instance Functor (Leaf name) where
   fmap :: forall a b. (a -> b) -> Leaf name a -> Leaf name b
fmap a -> b
f Leaf name a
leaf =
      case Leaf name a
leaf of
         Text Bool
b a
s  -> forall name str. Bool -> str -> Leaf name str
Text Bool
b (a -> b
f a
s)
         Comment String
s -> forall name str. String -> Leaf name str
Comment String
s
         Warning String
s -> forall name str. String -> Leaf name str
Warning String
s
         CData String
s   -> forall name str. String -> Leaf name str
CData String
s
         PI Name name
t T name a
p    -> forall name str. Name name -> T name str -> Leaf name str
PI Name name
t forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f T name a
p

{- this instance is quite useless but required by Traversable -}
instance Foldable (Leaf name) where
   foldMap :: forall m a. Monoid m => (a -> m) -> Leaf name a -> m
foldMap a -> m
f Leaf name a
leaf =
      case Leaf name a
leaf of
         Text Bool
_b a
s -> a -> m
f a
s
         PI Name name
_t T name a
p   -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f T name a
p
         Leaf name a
_ -> forall a. Monoid a => a
mempty

instance Traversable (Leaf name) where
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Leaf name a -> f (Leaf name b)
traverse a -> f b
f Leaf name a
leaf =
      case Leaf name a
leaf of
         Text Bool
b a
s  -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA (forall name str. Bool -> str -> Leaf name str
Text Bool
b) (a -> f b
f a
s)
         Comment String
s -> forall (f :: * -> *) a. Applicative f => a -> f a
App.pure forall a b. (a -> b) -> a -> b
$ forall name str. String -> Leaf name str
Comment String
s
         Warning String
s -> forall (f :: * -> *) a. Applicative f => a -> f a
App.pure forall a b. (a -> b) -> a -> b
$ forall name str. String -> Leaf name str
Warning String
s
         CData String
s   -> forall (f :: * -> *) a. Applicative f => a -> f a
App.pure forall a b. (a -> b) -> a -> b
$ forall name str. String -> Leaf name str
CData String
s
         PI Name name
t T name a
p    -> forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA (forall name str. Name name -> T name str -> Leaf name str
PI Name name
t) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f T name a
p



liftElement :: (Elem.T name str0 -> Elem.T name str1) -> (Branch name str0 -> Branch name str1)
liftElement :: forall name str0 str1.
(T name str0 -> T name str1)
-> Branch name str0 -> Branch name str1
liftElement T name str0 -> T name str1
f (Tag T name str0
elm) = forall name str. T name str -> Branch name str
Tag (T name str0 -> T name str1
f T name str0
elm)

liftElementA :: Applicative m =>
   (Elem.T name str0 -> m (Elem.T name str1)) -> (Branch name str0 -> m (Branch name str1))
liftElementA :: forall (m :: * -> *) name str0 str1.
Applicative m =>
(T name str0 -> m (T name str1))
-> Branch name str0 -> m (Branch name str1)
liftElementA T name str0 -> m (T name str1)
f (Tag T name str0
elm) = forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
App.liftA forall name str. T name str -> Branch name str
Tag (T name str0 -> m (T name str1)
f T name str0
elm)


{- * Tests -}

{- |
If the Tree is a Leaf, then return False.
Otherwise return the result of the predicate.
-}
checkTag :: (Elem.T name str -> Bool) -> (T i name str -> Bool)
checkTag :: forall name str i. (T name str -> Bool) -> T i name str -> Bool
checkTag T name str -> Bool
p =
   forall i a b branch leaf.
(i -> a -> b)
-> (branch -> [T i branch leaf] -> a)
-> (leaf -> a)
-> T i branch leaf
-> b
Tree.switch (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const) (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. T name str -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Branch name str -> T name str
getElement) (forall a b. a -> b -> a
const Bool
False)
    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)
unwrap

maybeTag :: T i name str -> Maybe (Elem.T name str, [T i name str])
maybeTag :: forall i name str.
T i name str -> Maybe (T name str, [T i name str])
maybeTag (Cons (i
_,Elem i (Branch name str) (Leaf name str)
t)) =
   case Elem i (Branch name str) (Leaf name str)
t of
      Tree.Branch (Tag T name str
elm) [(i, Elem i (Branch name str) (Leaf name str))]
subTrees ->
           forall a. a -> Maybe a
Just (T name str
elm, forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap [(i, Elem i (Branch name str) (Leaf name str))]
subTrees)
      Elem i (Branch name str) (Leaf name str)
_ -> forall a. Maybe a
Nothing

maybeText :: T i name str -> Maybe str
maybeText :: forall i name str. T i name str -> Maybe str
maybeText (Cons (i
_,Elem i (Branch name str) (Leaf name str)
t)) =
   case Elem i (Branch name str) (Leaf name str)
t of
      Tree.Leaf Leaf name str
l -> forall name str. Leaf name str -> Maybe str
maybeTextLeaf Leaf name str
l
      Elem i (Branch name str) (Leaf name str)
_           -> forall a. Maybe a
Nothing

maybeTextLeaf :: Leaf name str -> Maybe str
maybeTextLeaf :: forall name str. Leaf name str -> Maybe str
maybeTextLeaf Leaf name str
t =
   case Leaf name str
t of
      Text Bool
_ str
s -> forall a. a -> Maybe a
Just str
s
      Leaf name str
_        -> forall a. Maybe a
Nothing

maybeCommentLeaf :: Leaf name str -> Maybe String
maybeCommentLeaf :: forall name str. Leaf name str -> Maybe String
maybeCommentLeaf Leaf name str
t =
   case Leaf name str
t of
      Comment String
s -> forall a. a -> Maybe a
Just String
s
      Leaf name str
_         -> forall a. Maybe a
Nothing

maybeCDataLeaf :: Leaf name str -> Maybe String
maybeCDataLeaf :: forall name str. Leaf name str -> Maybe String
maybeCDataLeaf Leaf name str
t =
   case Leaf name str
t of
      CData String
s -> forall a. a -> Maybe a
Just String
s
      Leaf name str
_       -> forall a. Maybe a
Nothing

maybeProcessingLeaf :: Leaf name str -> Maybe (Tag.Name name, PI.T name str)
maybeProcessingLeaf :: forall name str. Leaf name str -> Maybe (Name name, T name str)
maybeProcessingLeaf Leaf name str
t =
   case Leaf name str
t of
      PI Name name
n T name str
instr -> forall a. a -> Maybe a
Just (Name name
n, T name str
instr)
      Leaf name str
_          -> forall a. Maybe a
Nothing

maybeWarningLeaf :: Leaf name str -> Maybe String
maybeWarningLeaf :: forall name str. Leaf name str -> Maybe String
maybeWarningLeaf Leaf name str
t =
   case Leaf name str
t of
      Warning String
s -> forall a. a -> Maybe a
Just String
s
      Leaf name str
_         -> forall a. Maybe a
Nothing


fold ::
   (i -> a -> b) ->
   (Elem.T name str -> [b] -> a) ->
   (Leaf name str -> a) ->
   (T i name str -> b)
fold :: forall i a b name str.
(i -> a -> b)
-> (T name str -> [b] -> a)
-> (Leaf name str -> a)
-> T i name str
-> b
fold i -> a -> b
iF T name str -> [b] -> a
branchF Leaf name str -> a
leafF =
   forall i a b branch leaf.
(i -> a -> b)
-> (branch -> [b] -> a) -> (leaf -> a) -> T i branch leaf -> b
Tree.fold i -> a -> b
iF (T name str -> [b] -> a
branchF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Branch name str -> T name str
getElement) Leaf name str -> a
leafF 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)
unwrap

switch ::
   (i -> a -> b) ->
   (Elem.T name str -> [T i name str] -> a) ->
   (Leaf name str -> a) ->
   (T i name str -> b)
switch :: forall i a b name str.
(i -> a -> b)
-> (T name str -> [T i name str] -> a)
-> (Leaf name str -> a)
-> T i name str
-> b
switch i -> a -> b
iF T name str -> [T i name str] -> a
branchF Leaf name str -> a
leafF =
   forall i a b branch leaf.
(i -> a -> b)
-> (branch -> [T i branch leaf] -> a)
-> (leaf -> a)
-> T i branch leaf
-> b
Tree.switch i -> a -> b
iF
      (\Branch name str
b [T i (Branch name str) (Leaf name str)]
subTrees -> T name str -> [T i name str] -> a
branchF (forall name str. Branch name str -> T name str
getElement Branch name str
b) (forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap [T i (Branch name str) (Leaf name str)]
subTrees))
      Leaf name str -> a
leafF
    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)
unwrap



{- * types of processors -}

type Filter i name str = T i name str -> T i name str

type FilterA m i name str = T i name str -> m (T i name str)


{- * tree processors -}


instance Functor (T i name) where
   fmap :: forall a b. (a -> b) -> T i name a -> T i name b
fmap a -> b
f =
      forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$
      forall branch0 branch1 leaf0 leaf1 i.
(branch0 -> branch1)
-> (leaf0 -> leaf1) -> T i branch0 leaf0 -> T i branch1 leaf1
Tree.map
         (forall name str0 str1.
(T name str0 -> T name str1)
-> Branch name str0 -> Branch name str1
liftElement forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
         (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)


mapText ::
   (String -> String) ->
   (T i name String -> T i name String)
mapText :: forall i name. ShowS -> T i name String -> T i name String
mapText ShowS
f =
   forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$
   forall branch0 branch1 leaf0 leaf1 i.
(branch0 -> branch1)
-> (leaf0 -> leaf1) -> T i branch0 leaf0 -> T i branch1 leaf1
Tree.map
      (forall name str0 str1.
(T name str0 -> T name str1)
-> Branch name str0 -> Branch name str1
liftElement forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ShowS
f)
      (forall name. ShowS -> Leaf name String -> Leaf name String
liftText ShowS
f)


mapIndex :: (i -> j) -> T i name str -> T j name str
mapIndex :: forall i j name str. (i -> j) -> T i name str -> T j name str
mapIndex i -> j
f =
   forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$ forall i j branch leaf.
(i -> j) -> T i branch leaf -> T j branch leaf
Tree.mapLabel i -> j
f


mapTag ::
   (Elem.Filter name str) ->
   (Filter i name str)
mapTag :: forall name str i. Filter name str -> Filter i name str
mapTag Filter name str
f =
   forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$
   forall branch0 branch1 leaf0 leaf1 i.
(branch0 -> branch1)
-> (leaf0 -> leaf1) -> T i branch0 leaf0 -> T i branch1 leaf1
Tree.map (forall name str0 str1.
(T name str0 -> T name str1)
-> Branch name str0 -> Branch name str1
liftElement Filter name str
f) forall a. a -> a
id

{- |
Convert all CData sections to plain text.
-}
textFromCData :: T i name String -> T i name String
textFromCData :: forall i name. T i name String -> T i name String
textFromCData =
   forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$
   forall branch0 branch1 leaf0 leaf1 i.
(branch0 -> branch1)
-> (leaf0 -> leaf1) -> T i branch0 leaf0 -> T i branch1 leaf1
Tree.map forall a. a -> a
id
      (\Leaf name String
leaf -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Leaf name String
leaf (forall name str. Bool -> str -> Leaf name str
Text Bool
False) forall a b. (a -> b) -> a -> b
$ forall name str. Leaf name str -> Maybe String
maybeCDataLeaf Leaf name String
leaf)


{- |
You can e.g. filter @text1 <b> text2 </b> text3@
to @text1  text2  text3@ by
@filterTag (checkTagName ("b"\/=))@.
-}
filterTag ::
   (Elem.T name str -> Bool) ->
   (T i name str -> [T i name str])
filterTag :: forall name str i.
(T name str -> Bool) -> T i name str -> [T i name str]
filterTag T name str -> Bool
p =
   forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall branch i leaf.
(branch -> Bool) -> T i branch leaf -> [T i branch leaf]
Tree.filterBranch (T name str -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Branch name str -> T name str
getElement) 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)
unwrap

mapCond ::
   (Elem.T name str -> Bool) ->
   (Elem.Filter name str) ->
   (Leaf name str -> Leaf name str) ->
   (Filter i name str)
mapCond :: forall name str i.
(T name str -> Bool)
-> Filter name str
-> (Leaf name str -> Leaf name str)
-> Filter i name str
mapCond T name str -> Bool
descend Filter name str
elemF Leaf name str -> Leaf name str
txtF =
   forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$
   forall branch leaf i.
(branch -> Bool)
-> (branch -> branch)
-> (leaf -> leaf)
-> T i branch leaf
-> T i branch leaf
Tree.mapCond (T name str -> Bool
descend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Branch name str -> T name str
getElement) (forall name str0 str1.
(T name str0 -> T name str1)
-> Branch name str0 -> Branch name str1
liftElement Filter name str
elemF) Leaf name str -> Leaf name str
txtF

{-
mapTextCond ::
   (Elem.T name String -> Bool) ->
   (Elem.T name String -> Elem.T name String) ->
   (String -> String) ->
   (Filter i name String)
mapTextCond descend elemF txtF =
   lift $
   Tree.mapCond (descend . getElement) (liftElement elemF) (liftText txtF)
-}


{- |
Find all branches where the predicate applies and
return a list of matching sub-trees in depth-first order.

Example: @filterTagsFlatten (checkTagName ("meta"==))@
-}
filterTagsFlatten ::
   (Elem.T name str -> Bool) ->
   T i name str ->
   [(Elem.T name str, [T i name str])]
filterTagsFlatten :: forall name str i.
(T name str -> Bool)
-> T i name str -> [(T name str, [T i name str])]
filterTagsFlatten T name str -> Bool
p =
   forall a. (a -> Bool) -> [a] -> [a]
filter (T name str -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall i name str.
T i name str -> Maybe (T name str, [T i name str])
maybeTag forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall i name str. T i name str -> [T i name str]
allSubTrees

filterElementsFlatten ::
   (Elem.T name str -> Bool) ->
   T i name str ->
   [Elem.T name str]
filterElementsFlatten :: forall name str i.
(T name str -> Bool) -> T i name str -> [T name str]
filterElementsFlatten T name str -> Bool
p =
   forall i a b branch leaf.
(i -> a -> b)
-> (branch -> [b] -> a) -> (leaf -> a) -> T i branch leaf -> b
Tree.fold
      (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const)
      (\Branch name str
branch [[T name str]]
xs -> forall a. (a -> Bool) -> [a] -> [a]
filter T name str -> Bool
p [forall name str. Branch name str -> T name str
getElement Branch name str
branch] forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[T name str]]
xs)
      (forall a b. a -> b -> a
const []) 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)
unwrap

allSubTrees :: T i name str -> [T i name str]
allSubTrees :: forall i name str. T i name str -> [T i name str]
allSubTrees =
   forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i branch leaf. T i branch leaf -> [T i branch leaf]
Tree.allSubTrees 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)
unwrap

{- | merge subsequent string leafs -}
mergeStrings :: (Monoid str) => Filter i name str
mergeStrings :: forall str i name. Monoid str => Filter i name str
mergeStrings =
   forall i name str.
([T i name str] -> [T i name str]) -> Filter i name str
processAllSubTrees forall str i name. Monoid str => [T i name str] -> [T i name str]
mergeTopStrings


mergeTopStrings :: (Monoid str) => [T i name str] -> [T i name str]
mergeTopStrings :: forall str i name. Monoid str => [T i name str] -> [T i name str]
mergeTopStrings =
   let prepend :: (a, Elem i branch (Leaf name str))
-> [(a, Elem i branch (Leaf name str))]
-> ((a, Elem i branch (Leaf name str)),
    [(a, Elem i branch (Leaf name str))])
prepend (a
i, Tree.Leaf (Text Bool
w0 str
t0)) [(a, Elem i branch (Leaf name str))]
rest =
          forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (\ ~(Bool
w1,str
t1) -> (a
i, forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf forall a b. (a -> b) -> a -> b
$ forall name str. Bool -> str -> Leaf name str
Text (Bool
w0Bool -> Bool -> Bool
||Bool
w1) (forall a. Monoid a => a -> a -> a
mappend str
t0 str
t1))) forall a b. (a -> b) -> a -> b
$
          case [(a, Elem i branch (Leaf name str))]
rest of
             (a
_, Tree.Leaf (Text Bool
w1 str
t1)) : [(a, Elem i branch (Leaf name str))]
ss -> ((Bool
w1,str
t1), [(a, Elem i branch (Leaf name str))]
ss)
             [(a, Elem i branch (Leaf name str))]
_ -> ((Bool
False,forall a. Monoid a => a
mempty), [(a, Elem i branch (Leaf name str))]
rest)
       prepend (a, Elem i branch (Leaf name str))
x [(a, Elem i branch (Leaf name str))]
rest = ((a, Elem i branch (Leaf name str))
x, [(a, Elem i branch (Leaf name str))]
rest)
   in  forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrapforall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\T i (Branch name str) (Leaf name str)
x -> forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {str} {a} {i} {branch} {name} {a} {i} {branch} {name}.
Monoid str =>
(a, Elem i branch (Leaf name str))
-> [(a, Elem i branch (Leaf name str))]
-> ((a, Elem i branch (Leaf name str)),
    [(a, Elem i branch (Leaf name str))])
prepend T i (Branch name str) (Leaf name str)
x) [] forall b c a. (b -> c) -> (a -> b) -> a -> c
.
       forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i name str -> T i (Branch name str) (Leaf name str)
unwrap


{- |
Process all sub-tree lists in bottom-up order.
-}
processAllSubTrees ::
   ([T i name str] -> [T i name str]) ->
   Filter i name str
processAllSubTrees :: forall i name str.
([T i name str] -> [T i name str]) -> Filter i name str
processAllSubTrees [T i name str] -> [T i name str]
f =
   forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$
   forall i a b branch leaf.
(i -> a -> b)
-> (branch -> [b] -> a) -> (leaf -> a) -> T i branch leaf -> b
Tree.fold
      (,)
      (\Branch name str
branch -> forall i branch leaf.
branch -> [T i branch leaf] -> Elem i branch leaf
Tree.Branch Branch name str
branch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i name str -> T i (Branch name str) (Leaf name str)
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. [T i name str] -> [T i name str]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap)
      forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf

processSubTrees ::
   (Tag.Name name -> Bool) ->
   ([T i name str] -> [T i name str]) ->
   Filter i name str
processSubTrees :: forall name i str.
(Name name -> Bool)
-> ([T i name str] -> [T i name str]) -> Filter i name str
processSubTrees Name name -> Bool
p [T i name str] -> [T i name str]
f =
   forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$
   forall branch i leaf.
(branch -> Bool)
-> ((branch, [T i branch leaf]) -> (branch, [T i branch leaf]))
-> T i branch leaf
-> T i branch leaf
Tree.mapSubTrees
      (\(Tag (Elem.Cons Name name
name [T name str]
_)) -> Name name -> Bool
p Name name
name)
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i name str -> T i (Branch name str) (Leaf name str)
unwrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. [T i name str] -> [T i name str]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap))

processSubTreesAttrs ::
   (Tag.Name name -> Bool) ->
   (([Attr.T name str], [T i name str]) ->
    ([Attr.T name str], [T i name str])) ->
   Filter i name str
processSubTreesAttrs :: forall name str i.
(Name name -> Bool)
-> (([T name str], [T i name str])
    -> ([T name str], [T i name str]))
-> Filter i name str
processSubTreesAttrs Name name -> Bool
p ([T name str], [T i name str]) -> ([T name str], [T i name str])
f =
   forall i name str0 j str1.
(T i (Branch name str0) (Leaf name str0)
 -> T j (Branch name str1) (Leaf name str1))
-> T i name str0 -> T j name str1
lift forall a b. (a -> b) -> a -> b
$
   forall branch i leaf.
(branch -> Bool)
-> ((branch, [T i branch leaf]) -> (branch, [T i branch leaf]))
-> T i branch leaf
-> T i branch leaf
Tree.mapSubTrees
      (\(Tag (Elem.Cons Name name
name [T name str]
_)) -> Name name -> Bool
p Name name
name)
      (\(Tag (Elem.Cons Name name
name [T name str]
attrs), [T i (Branch name str) (Leaf name str)]
subTrees) ->
          forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall name str. T name str -> Branch name str
Tag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Name name -> [T name str] -> T name str
Elem.Cons Name name
name, forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i name str -> T i (Branch name str) (Leaf name str)
unwrap) forall a b. (a -> b) -> a -> b
$
          ([T name str], [T i name str]) -> ([T name str], [T i name str])
f ([T name str]
attrs, forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i (Branch name str) (Leaf name str) -> T i name str
wrap [T i (Branch name str) (Leaf name str)]
subTrees))



{- * applicative functor tree processors -}

instance Foldable (T i name) where
   foldMap :: forall m a. Monoid m => (a -> m) -> T i name a -> m
foldMap a -> m
f =
      forall i a b branch leaf.
(i -> a -> b)
-> (branch -> [b] -> a) -> (leaf -> a) -> T i branch leaf -> b
Tree.fold
         (forall a b. a -> b -> a
const forall a. a -> a
id) (forall a b. a -> b -> a
const forall a. Monoid a => [a] -> a
mconcat) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty a -> m
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Leaf name str -> Maybe str
maybeTextLeaf) 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)
unwrap


instance Traversable (T i name) where
   traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> T i name a -> f (T i name b)
traverse a -> f b
f =
      forall (m :: * -> *) i name str0 str1.
Applicative m =>
(T i (Branch name str0) (Leaf name str0)
 -> m (T i (Branch name str1) (Leaf name str1)))
-> T i name str0 -> m (T i name str1)
liftA forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) branch0 branch1 leaf0 leaf1 i.
Applicative m =>
(branch0 -> m branch1)
-> (leaf0 -> m leaf1) -> T i branch0 leaf0 -> m (T i branch1 leaf1)
Tree.mapA
         (forall (m :: * -> *) name str0 str1.
Applicative m =>
(T name str0 -> m (T name str1))
-> Branch name str0 -> m (Branch name str1)
liftElementA forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse  a -> f b
f)
         (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f)


mapTextA :: Applicative m =>
   (String -> m String) ->
   (FilterA m i name String)
mapTextA :: forall (m :: * -> *) i name.
Applicative m =>
(String -> m String) -> FilterA m i name String
mapTextA String -> m String
f =
   forall (m :: * -> *) i name str0 str1.
Applicative m =>
(T i (Branch name str0) (Leaf name str0)
 -> m (T i (Branch name str1) (Leaf name str1)))
-> T i name str0 -> m (T i name str1)
liftA forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) branch0 branch1 leaf0 leaf1 i.
Applicative m =>
(branch0 -> m branch1)
-> (leaf0 -> m leaf1) -> T i branch0 leaf0 -> m (T i branch1 leaf1)
Tree.mapA
      (forall (m :: * -> *) name str0 str1.
Applicative m =>
(T name str0 -> m (T name str1))
-> Branch name str0 -> m (Branch name str1)
liftElementA forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse  String -> m String
f)
      (forall (m :: * -> *) name.
Applicative m =>
(String -> m String) -> Leaf name String -> m (Leaf name String)
liftTextA String -> m String
f)


mapCondA :: Applicative m =>
   (Elem.T name str -> Bool) ->
   (Elem.T name str -> m (Elem.T name str)) ->
   (Leaf name str -> m (Leaf name str)) ->
   (FilterA m i name str)
mapCondA :: forall (m :: * -> *) name str i.
Applicative m =>
(T name str -> Bool)
-> (T name str -> m (T name str))
-> (Leaf name str -> m (Leaf name str))
-> FilterA m i name str
mapCondA T name str -> Bool
descend T name str -> m (T name str)
elemF Leaf name str -> m (Leaf name str)
txtF =
   forall (m :: * -> *) i name str0 str1.
Applicative m =>
(T i (Branch name str0) (Leaf name str0)
 -> m (T i (Branch name str1) (Leaf name str1)))
-> T i name str0 -> m (T i name str1)
liftA forall a b. (a -> b) -> a -> b
$
   forall (m :: * -> *) branch leaf i.
Applicative m =>
(branch -> Bool)
-> (branch -> m branch)
-> (leaf -> m leaf)
-> T i branch leaf
-> m (T i branch leaf)
Tree.mapCondA (T name str -> Bool
descend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. Branch name str -> T name str
getElement) (forall (m :: * -> *) name str0 str1.
Applicative m =>
(T name str0 -> m (T name str1))
-> Branch name str0 -> m (Branch name str1)
liftElementA T name str -> m (T name str)
elemF) Leaf name str -> m (Leaf name str)
txtF

{-
mapTextCondA :: Applicative m =>
   (Elem.T name String -> Bool) ->
   (Elem.T name String -> m (Elem.T name String)) ->
   (String -> m String) ->
   (FilterA m i name String)
mapTextCondA descend elemF txtF =
   liftA $
   Tree.mapCondA (descend . getElement) (liftElementA elemF) (liftTextA txtF)
-}


{- * Character decoding -}

unescape :: T i name XmlString.T -> T i name String
unescape :: forall i name. T i name T -> T i name String
unescape = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T -> String
XmlString.toUnicodeString

{- |
Use ASCII characters, XML entity references and character references
for representing strings.
That's not human readable, but portable.
-}
escape :: T i name String -> T i name XmlString.T
escape :: forall i name. T i name String -> T i name T
escape = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> T
XmlString.fromUnicodeString


{-# DEPRECATED decodeSpecialChars, maybeDecodeSpecialChars, decodeSpecialCharsDecoder, decodeAttrs, decodeAttr, maybeDecodeUTF8Chars "XmlChar.Unicode constructors must contain unicode characters and not encoded ones. Decode characters before parsing!" #-}

{- |
Decode characters like those from UTF-8 scheme.
-}
decodeSpecialChars ::
   (Name.Tag name, Name.Attribute name) =>
   String -> T i name XmlString.T -> [T i name String]
decodeSpecialChars :: forall name i.
(Tag name, Attribute name) =>
String -> T i name T -> [T i name String]
decodeSpecialChars String
enc T i name T
tree =
   forall a. a -> Maybe a -> a
fromMaybe
      [forall i name. T i name T -> T i name String
unescape T i name T
tree]
      (forall name i.
(Tag name, Attribute name) =>
String -> T i name T -> Maybe [T i name String]
maybeDecodeSpecialChars String
enc T i name T
tree)

maybeDecodeSpecialChars ::
   (Name.Tag name, Name.Attribute name) =>
   String -> T i name XmlString.T -> Maybe [T i name String]
maybeDecodeSpecialChars :: forall name i.
(Tag name, Attribute name) =>
String -> T i name T -> Maybe [T i name String]
maybeDecodeSpecialChars String
enc T i name T
tree =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall name i.
(Tag name, Attribute name) =>
DecodingFctEmbedErrors -> T i name T -> [T i name String]
decodeSpecialCharsDecoder T i name T
tree) forall a b. (a -> b) -> a -> b
$
   String -> Maybe DecodingFctEmbedErrors
Unicode.getDecodingFctEmbedErrors String
enc

{- test:
-- decodeSpecialChars "utf-8" $ literalIndex 0 (XmlString.fromEntString "tr&am;e")

traverse (putStrLn . showHTML . escape) $ decodeSpecialChars "utf-8" $ mapText XmlString.fromEntString $ tagIndexAttr 0 "br" [("href","url"), ("target","_blank")] [literalIndex 0 "\195tr&am;e"]
-}

{- |
Conversion errors are appended as warnings to the tree.
-}
decodeSpecialCharsDecoder ::
   (Name.Tag name, Name.Attribute name) =>
   Unicode.DecodingFctEmbedErrors -> T i name XmlString.T -> [T i name String]
decodeSpecialCharsDecoder :: forall name i.
(Tag name, Attribute name) =>
DecodingFctEmbedErrors -> T i name T -> [T i name String]
decodeSpecialCharsDecoder DecodingFctEmbedErrors
decode =
   let xmlDecode :: T -> EmbeddedExceptions
xmlDecode =
          DecodingFctEmbedErrors -> T -> EmbeddedExceptions
HtmlString.toUnicodeStringDecodingEmbedError DecodingFctEmbedErrors
decode
       mergeDecode :: T -> [Exceptional String String]
mergeDecode =
          EmbeddedExceptions -> [Exceptional String String]
XmlString.uStringWithErrorsMergePlainChars forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> EmbeddedExceptions
xmlDecode
   in  forall i branch b leaf.
(i -> branch -> [b] -> b)
-> (i -> leaf -> b) -> T i branch leaf -> b
Tree.foldLabel
          (\i
i Branch name T
branch [[T i name String]]
subTrees ->
              case Branch name T
branch of
                 Tag (Elem.Cons Name name
name [T name T]
attrs) ->
                    let ([T name String]
newAttrs,[String]
warnings) =
                           forall w a. Writer w a -> (a, w)
runWriter forall a b. (a -> b) -> a -> b
$
                           forall name.
(Tag name, Attribute name) =>
(T -> EmbeddedExceptions)
-> [T name T] -> Writer [String] [T name String]
decodeAttrs T -> EmbeddedExceptions
xmlDecode [T name T]
attrs
                    in  [forall i name str.
i -> Name name -> [T name str] -> [T i name str] -> T i name str
tagIndexAttr i
i Name name
name [T name String]
newAttrs
                           (forall a b. (a -> b) -> [a] -> [b]
map (forall i name str. i -> String -> T i name str
warningIndex i
i) [String]
warnings forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[T i name String]]
subTrees)])
          (\i
i Leaf name T
leaf -> forall a b. (a -> b) -> [a] -> [b]
map (forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
wrap2 i
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf) forall a b. (a -> b) -> a -> b
$
              case Leaf name T
leaf of
                 Text  Bool
b T
str ->
                    forall a b. (a -> b) -> [a] -> [b]
map
                      (forall e b a. (e -> b) -> (a -> b) -> Exceptional e a -> b
Exc.switch forall name str. String -> Leaf name str
Warning (forall name str. Bool -> str -> Leaf name str
Text Bool
b))
                      (T -> [Exceptional String String]
mergeDecode T
str)
                 Comment   String
cmt   -> [forall name str. String -> Leaf name str
Comment String
cmt]
                 Warning   String
str   -> [forall name str. String -> Leaf name str
Warning String
str]
                 CData     String
str   -> [forall name str. String -> Leaf name str
CData String
str]
                 PI Name name
target T name T
instr0 ->
                    let (T name String
instr1,[String]
warnings) =
                           forall w a. Writer w a -> (a, w)
runWriter forall a b. (a -> b) -> a -> b
$
                           forall (f :: * -> *) name0 string0 name1 string1.
Applicative f =>
([T name0 string0] -> f [T name1 string1])
-> T name0 string0 -> f (T name1 string1)
PI.mapAttributesA (forall name.
(Tag name, Attribute name) =>
(T -> EmbeddedExceptions)
-> [T name T] -> Writer [String] [T name String]
decodeAttrs T -> EmbeddedExceptions
xmlDecode) T name T
instr0
                    in  forall name str. Name name -> T name str -> Leaf name str
PI Name name
target T name String
instr1 forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall name str. String -> Leaf name str
Warning [String]
warnings) 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)
unwrap

decodeAttrs ::
   (Name.Tag name, Name.Attribute name) =>
   (XmlString.T -> XmlString.EmbeddedExceptions) ->
   [Attr.T name XmlString.T] -> Writer [String] [Attr.T name String]
decodeAttrs :: forall name.
(Tag name, Attribute name) =>
(T -> EmbeddedExceptions)
-> [T name T] -> Writer [String] [T name String]
decodeAttrs T -> EmbeddedExceptions
xmlDecode =
   forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
      (\T name T
attr ->
         forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse  (forall name.
(Tag name, Attribute name) =>
(T -> EmbeddedExceptions)
-> Name name -> T -> Writer [String] String
decodeAttr T -> EmbeddedExceptions
xmlDecode (forall name string. T name string -> Name name
Attr.name_ T name T
attr)) T name T
attr)

decodeAttr ::
   (Name.Tag name, Name.Attribute name) =>
   (XmlString.T -> XmlString.EmbeddedExceptions) ->
   Attr.Name name -> XmlString.T -> Writer [String] String
decodeAttr :: forall name.
(Tag name, Attribute name) =>
(T -> EmbeddedExceptions)
-> Name name -> T -> Writer [String] String
decodeAttr T -> EmbeddedExceptions
decode Name name
name =
   forall (m :: * -> *) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
censor (forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
showString forall a b. (a -> b) -> a -> b
$ String
"in attribute \"" forall a. [a] -> [a] -> [a]
++ forall name. C name => name -> String
Name.toString Name name
name forall a. [a] -> [a] -> [a]
++ String
"\": ")) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
writer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [Either a b] -> ([a], [b])
unzipEithers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall e a. Exceptional e a -> Either e a
Exc.toEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> EmbeddedExceptions
decode


maybeDecodeUTF8Chars :: String -> T i name XmlString.T -> Maybe (T i name String)
maybeDecodeUTF8Chars :: forall i name. String -> T i name T -> Maybe (T i name String)
maybeDecodeUTF8Chars String
enc T i name T
tree =
   case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower String
enc of
      String
"utf-8" -> forall a. a -> Maybe a
Just (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap T -> String
XmlString.utf8ToUnicodeString T i name T
tree)
      String
_ -> forall a. Maybe a
Nothing


{- * Formatting -}

{-
show ::
   (Name.Tag name, Name.Attribute name) =>
   T i name XmlString.T -> String
show leaf = shows leaf ""
-}

formatMany ::
   (Name.Tag name, Name.Attribute name, Format.C string) =>
   [T i name string] -> ShowS
formatMany :: forall name string i.
(Tag name, Attribute name, C string) =>
[T i name string] -> ShowS
formatMany = forall a. (a -> ShowS) -> [a] -> ShowS
Format.many forall name string i.
(Tag name, Attribute name, C string) =>
T i name string -> ShowS
format

-- cf. src/Text/XML/HXT/DOM/XmlTreeFunctions.hs
format ::
   (Name.Tag name, Name.Attribute name, Format.C string) =>
   T i name string -> ShowS
format :: forall name string i.
(Tag name, Attribute name, C string) =>
T i name string -> ShowS
format =
   forall i a b branch leaf.
(i -> a -> b)
-> (branch -> [b] -> a) -> (leaf -> a) -> T i branch leaf -> b
Tree.fold (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const) forall name string.
(Tag name, Attribute name, C string) =>
Branch name string -> [ShowS] -> ShowS
formatBranch forall name string.
(Tag name, Attribute name, C string) =>
Leaf name string -> ShowS
formatLeaf 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)
unwrap

formatBranch ::
   (Name.Tag name, Name.Attribute name, Format.C string) =>
   Branch name string -> [ShowS] -> ShowS
formatBranch :: forall name string.
(Tag name, Attribute name, C string) =>
Branch name string -> [ShowS] -> ShowS
formatBranch Branch name string
branch [ShowS]
formatSubTrees =
   case Branch name string
branch of
      Tag T name string
elm ->
         forall name string.
(Tag name, Attribute name, C string) =>
(Name name -> Bool) -> ShowS -> T name string -> [ShowS] -> ShowS
Elem.format
            (\Name name
_tagName -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ShowS]
formatSubTrees)
            ShowS
Format.slash
            T name string
elm [ShowS]
formatSubTrees

formatLeaf ::
   (Name.Tag name, Name.Attribute name, Format.C string) =>
   Leaf name string -> ShowS
formatLeaf :: forall name string.
(Tag name, Attribute name, C string) =>
Leaf name string -> ShowS
formatLeaf Leaf name string
leaf =
   case Leaf name string
leaf of
      Text Bool
_ string
str -> forall object. C object => object -> ShowS
Format.run string
str
      Comment String
c ->
         String -> ShowS
showString String
"<!--" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"-->"
      Warning String
e ->
         String -> ShowS
showString String
"<!-- Warning: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" -->"
      CData String
str ->
         String -> ShowS
showString String
"<![CDATA[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"]]>"
      PI Name name
target T name string
p ->
         ShowS -> ShowS
Format.angle forall a b. (a -> b) -> a -> b
$
         ShowS
Format.quest forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall name. C name => name -> ShowS
Format.name Name name
target forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         forall object. C object => object -> ShowS
Format.run T name string
p forall b c a. (b -> c) -> (a -> b) -> a -> c
.
         ShowS
Format.quest

instance
   (Name.Tag name, Name.Attribute name, Format.C string) =>
      Format.C (T i name string) where
   run :: T i name string -> ShowS
run = forall name string i.
(Tag name, Attribute name, C string) =>
T i name string -> ShowS
format

instance
   (Name.Tag name, Name.Attribute name, Format.C string) =>
      Format.C (Leaf name string) where
   run :: Leaf name string -> ShowS
run = forall name string.
(Tag name, Attribute name, C string) =>
Leaf name string -> ShowS
formatLeaf