module Text.HTML.WraXML.Tree where
import qualified Data.Tree.BranchLeafLabel as Tree
import qualified Text.XML.WraXML.Tree as XmlTree
import qualified Text.XML.WraXML.String as XmlString
import qualified Data.Char as Char
import qualified Text.XML.Basic.Tag as TagX
import qualified Text.HTML.Basic.Tag as Tag
import qualified Text.HTML.Basic.Character as HtmlChar
import qualified Text.HTML.Basic.String as HtmlStringB
import qualified Text.HTML.WraXML.Element as Elem
import qualified Text.XML.Basic.Attribute as Attr
import qualified Text.XML.Basic.Name as Name
import Text.XML.WraXML.Tree (formatLeaf, )
import qualified Text.XML.Basic.Format as Format
import Control.Monad.Trans.State (State, put, get, )
import Control.Applicative (liftA, liftA2, )
import qualified Data.List.Reverse.StrictElement as Rev
import Data.Tuple.HT (mapFst, )
import Control.Monad (liftM2, )
import Data.Maybe (mapMaybe, fromMaybe, )
findMetaEncoding ::
(Name.Tag name, Name.Attribute name) =>
XmlTree.T i name String -> Maybe String
findMetaEncoding :: forall name i.
(Tag name, Attribute name) =>
T i name String -> Maybe String
findMetaEncoding =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
Rev.takeWhile (Char
'='forall a. Eq a => a -> a -> Bool
/=)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"content-type" forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
Char.toLower)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall name i.
(Tag name, Attribute name) =>
T i name String -> [(String, String)]
getMetaHTTPHeaders
getMetaHTTPHeaders ::
(Name.Tag name, Name.Attribute name) =>
XmlTree.T i name String -> [(String, String)]
=
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\[T name String]
attrs ->
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
(forall name string.
Attribute name =>
String -> [T name string] -> Maybe string
Attr.lookupLit String
"http-equiv" [T name String]
attrs)
(forall name string.
Attribute name =>
String -> [T name string] -> Maybe string
Attr.lookupLit String
"content" [T name String]
attrs)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map forall name str. T name str -> [T name str]
Elem.attributes_ forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. (a -> Bool) -> [a] -> [a]
filter (forall name str. (Name name -> Bool) -> T name str -> Bool
Elem.checkName (forall name. C name => String -> name -> Bool
Name.match String
"meta")) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map 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])
XmlTree.maybeTag forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall name str i.
(T name str -> Bool)
-> T i name str -> [(T name str, [T i name str])]
XmlTree.filterTagsFlatten (forall name str. (Name name -> Bool) -> T name str -> Bool
Elem.checkName (forall name. C name => String -> name -> Bool
Name.match String
"head"))
decodeAdaptive ::
(Name.Attribute name, Name.Tag name) =>
(XmlString.Encoding -> XmlString.Encoded -> String) ->
XmlTree.T i name [HtmlChar.T] ->
State (XmlString.Encoded -> String) (XmlTree.T i name String)
decodeAdaptive :: forall name i.
(Attribute name, Tag name) =>
(String -> String -> String)
-> T i name [T] -> State (String -> String) (T i name String)
decodeAdaptive String -> String -> String
getDecoder =
forall i a b name str.
(i -> a -> b)
-> (T name str -> [b] -> a)
-> (Leaf name str -> a)
-> T i name str
-> b
XmlTree.fold
(forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i name str.
i -> Elem i (Branch name str) (Leaf name str) -> T i name str
XmlTree.wrap2)
(\T name [T]
elm [State (String -> String) (T i name String)]
subTrees ->
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall i branch leaf.
branch -> [T i branch leaf] -> Elem i branch leaf
Tree.Branch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name str. T name str -> Branch name str
XmlTree.Tag)
(forall name.
(Attribute name, Tag name) =>
(String -> String -> String)
-> T name [T] -> State (String -> String) (T name String)
Elem.decodeAdaptive String -> String -> String
getDecoder T name [T]
elm)
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall i name str.
T i name str -> T i (Branch name str) (Leaf name str)
XmlTree.unwrap) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [State (String -> String) (T i name String)]
subTrees))
(forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA forall i branch leaf. leaf -> Elem i branch leaf
Tree.Leaf forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall name.
(Attribute name, Tag name) =>
(String -> String -> String)
-> Leaf name [T] -> State (String -> String) (Leaf name String)
decodeLeafAdaptive String -> String -> String
getDecoder)
decodeLeafAdaptive ::
(Name.Attribute name, Name.Tag name) =>
(XmlString.Encoding -> XmlString.Encoded -> String) ->
XmlTree.Leaf name [HtmlChar.T] ->
State (XmlString.Encoded -> String) (XmlTree.Leaf name String)
decodeLeafAdaptive :: forall name.
(Attribute name, Tag name) =>
(String -> String -> String)
-> Leaf name [T] -> State (String -> String) (Leaf name String)
decodeLeafAdaptive String -> String -> String
getDecoder Leaf name [T]
leaf0 =
do String -> String
decoder <- forall (m :: * -> *) s. Monad m => StateT s m s
get
let leaf1 :: Leaf name String
leaf1 =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> String) -> [T] -> String
HtmlStringB.decode String -> String
decoder) Leaf name [T]
leaf0)
(forall name str. String -> Leaf name str
XmlTree.CData forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
decoder)
(forall name str. Leaf name str -> Maybe String
XmlTree.maybeCDataLeaf Leaf name [T]
leaf0)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall (m :: * -> *) a. Monad m => a -> m a
return ())
(forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
getDecoder) forall a b. (a -> b) -> a -> b
$
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall name string.
(Tag name, Attribute name) =>
Name name -> T name string -> Maybe string
TagX.maybeXMLEncoding forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
forall name str. Leaf name str -> Maybe (Name name, T name str)
XmlTree.maybeProcessingLeaf Leaf name String
leaf1
forall (m :: * -> *) a. Monad m => a -> m a
return Leaf name String
leaf1
{-# DEPRECATED decodeSpecialCharsMetaEncoding "This calls findMetaEncoding which is a potential space leak. Better use decodeAdaptive." #-}
decodeSpecialCharsMetaEncoding ::
(Name.Tag name, Name.Attribute name) =>
XmlTree.T i name XmlString.T -> [XmlTree.T i name String]
decodeSpecialCharsMetaEncoding :: forall name i.
(Tag name, Attribute name) =>
T i name [T] -> [T i name String]
decodeSpecialCharsMetaEncoding T i name [T]
tree =
let unicodeTree :: T i name String
unicodeTree = forall i name. T i name [T] -> T i name String
XmlTree.unescape T i name [T]
tree
in forall a. a -> Maybe a -> a
fromMaybe
[T i name String
unicodeTree]
(forall a b c. (a -> b -> c) -> b -> a -> c
flip forall name i.
(Tag name, Attribute name) =>
String -> T i name [T] -> Maybe [T i name String]
XmlTree.maybeDecodeSpecialChars T i name [T]
tree
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall name i.
(Tag name, Attribute name) =>
T i name String -> Maybe String
findMetaEncoding T i name String
unicodeTree)
formatMany ::
(Name.Tag name, Name.Attribute name, Format.C string) =>
[XmlTree.T i name string] -> ShowS
formatMany :: forall name string i.
(Tag name, Attribute name, C string) =>
[T i name string] -> String -> String
formatMany = forall a. (a -> String -> String) -> [a] -> String -> String
Format.many forall name string i.
(Tag name, Attribute name, C string) =>
T i name string -> String -> String
format
format ::
(Name.Tag name, Name.Attribute name, Format.C string) =>
XmlTree.T i name string -> ShowS
format :: forall name string i.
(Tag name, Attribute name, C string) =>
T i name string -> String -> String
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 -> [String -> String] -> String -> String
formatBranch forall name string.
(Tag name, Attribute name, C string) =>
Leaf name string -> String -> String
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)
XmlTree.unwrap
formatBranch ::
(Name.Tag name, Name.Attribute name, Format.C string) =>
XmlTree.Branch name string -> [ShowS] -> ShowS
formatBranch :: forall name string.
(Tag name, Attribute name, C string) =>
Branch name string -> [String -> String] -> String -> String
formatBranch = forall name string.
(Tag name, Attribute name, C string) =>
Bool
-> Branch name string -> [String -> String] -> String -> String
formatBranchGen Bool
False
formatManyXHTML ::
(Name.Tag name, Name.Attribute name, Format.C string) =>
[XmlTree.T i name string] -> ShowS
formatManyXHTML :: forall name string i.
(Tag name, Attribute name, C string) =>
[T i name string] -> String -> String
formatManyXHTML = forall a. (a -> String -> String) -> [a] -> String -> String
Format.many forall name string i.
(Tag name, Attribute name, C string) =>
T i name string -> String -> String
formatXHTML
formatXHTML ::
(Name.Tag name, Name.Attribute name, Format.C string) =>
XmlTree.T i name string -> ShowS
formatXHTML :: forall name string i.
(Tag name, Attribute name, C string) =>
T i name string -> String -> String
formatXHTML =
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 -> [String -> String] -> String -> String
formatBranchXHTML forall name string.
(Tag name, Attribute name, C string) =>
Leaf name string -> String -> String
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)
XmlTree.unwrap
formatBranchXHTML ::
(Name.Tag name, Name.Attribute name, Format.C string) =>
XmlTree.Branch name string -> [ShowS] -> ShowS
formatBranchXHTML :: forall name string.
(Tag name, Attribute name, C string) =>
Branch name string -> [String -> String] -> String -> String
formatBranchXHTML = forall name string.
(Tag name, Attribute name, C string) =>
Bool
-> Branch name string -> [String -> String] -> String -> String
formatBranchGen Bool
True
formatBranchGen ::
(Name.Tag name, Name.Attribute name, Format.C string) =>
Bool -> XmlTree.Branch name string -> [ShowS] -> ShowS
formatBranchGen :: forall name string.
(Tag name, Attribute name, C string) =>
Bool
-> Branch name string -> [String -> String] -> String -> String
formatBranchGen Bool
xhtml Branch name string
branch [String -> String]
formatSubTrees =
case Branch name string
branch of
XmlTree.Tag T name string
elm ->
forall name string.
(Tag name, Attribute name, C string) =>
(Name name -> Bool)
-> (String -> String)
-> T name string
-> [String -> String]
-> String
-> String
Elem.format
(\Name name
tagName -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String -> String]
formatSubTrees Bool -> Bool -> Bool
&& forall name. Tag name => Name name -> Bool
Tag.isEmpty Name name
tagName)
(if Bool
xhtml then String -> String
Format.slash else forall a. a -> a
id)
T name string
elm [String -> String]
formatSubTrees