{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, PatternGuards #-}
module Text.HTML.TagSoup(
Tag(..), Row, Column, Attribute,
module Text.HTML.TagSoup.Parser,
module Text.HTML.TagSoup.Render,
canonicalizeTags,
isTagOpen, isTagClose, isTagText, isTagWarning, isTagPosition,
isTagOpenName, isTagCloseName, isTagComment,
fromTagText, fromAttrib,
maybeTagText, maybeTagWarning,
innerText,
sections, partitions,
TagRep(..), (~==),(~/=)
) where
import Text.HTML.TagSoup.Type
import Text.HTML.TagSoup.Parser
import Text.HTML.TagSoup.Render
import Data.Char
import Data.List (groupBy, tails)
import Text.StringLike
canonicalizeTags :: StringLike str => [Tag str] -> [Tag str]
canonicalizeTags :: forall str. StringLike str => [Tag str] -> [Tag str]
canonicalizeTags = forall a b. (a -> b) -> [a] -> [b]
map Tag str -> Tag str
f
where
f :: Tag str -> Tag str
f (TagOpen str
tag [Attribute str]
attrs) | Just (Char
'!',str
name) <- forall a. StringLike a => a -> Maybe (Char, a)
uncons str
tag = forall str. str -> [Attribute str] -> Tag str
TagOpen (Char
'!' forall a. StringLike a => Char -> a -> a
`cons` str -> str
ucase str
name) [Attribute str]
attrs
f (TagOpen str
name [Attribute str]
attrs) = forall str. str -> [Attribute str] -> Tag str
TagOpen (str -> str
lcase str
name) [(str -> str
lcase str
k, str
v) | (str
k,str
v) <- [Attribute str]
attrs]
f (TagClose str
name) = forall str. str -> Tag str
TagClose (str -> str
lcase str
name)
f Tag str
a = Tag str
a
ucase :: str -> str
ucase = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StringLike a => a -> String
toString
lcase :: str -> str
lcase = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StringLike a => a -> String
toString
class TagRep a where
toTagRep :: StringLike str => a -> Tag str
instance StringLike str => TagRep (Tag str) where toTagRep :: forall str. StringLike str => Tag str -> Tag str
toTagRep = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (StringLike a, StringLike b) => a -> b
castString
instance TagRep String where
toTagRep :: forall str. StringLike str => String -> Tag str
toTagRep String
x = case forall str. StringLike str => str -> [Tag str]
parseTags String
x of
[Tag String
a] -> forall a str. (TagRep a, StringLike str) => a -> Tag str
toTagRep Tag String
a
[Tag String]
_ -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"When using a TagRep it must be exactly one tag, you gave: " forall a. [a] -> [a] -> [a]
++ String
x
(~==) :: (StringLike str, TagRep t) => Tag str -> t -> Bool
~== :: forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
(~==) Tag str
a t
b = forall {a}. StringLike a => Tag a -> Tag a -> Bool
f Tag str
a (forall a str. (TagRep a, StringLike str) => a -> Tag str
toTagRep t
b)
where
f :: Tag a -> Tag a -> Bool
f (TagText a
y) (TagText a
x) = forall a. StringLike a => a -> Bool
strNull a
x Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== a
y
f (TagClose a
y) (TagClose a
x) = forall a. StringLike a => a -> Bool
strNull a
x Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== a
y
f (TagOpen a
y [Attribute a]
ys) (TagOpen a
x [Attribute a]
xs) = (forall a. StringLike a => a -> Bool
strNull a
x Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== a
y) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Attribute a -> Bool
g [Attribute a]
xs
where
g :: Attribute a -> Bool
g (a
name,a
val) | forall a. StringLike a => a -> Bool
strNull a
name = a
val forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [Attribute a]
ys
| forall a. StringLike a => a -> Bool
strNull a
val = a
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [Attribute a]
ys
g Attribute a
nameval = Attribute a
nameval forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Attribute a]
ys
f (TagComment a
x) (TagComment a
y) = forall a. StringLike a => a -> Bool
strNull a
x Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== a
y
f (TagWarning a
x) (TagWarning a
y) = forall a. StringLike a => a -> Bool
strNull a
x Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== a
y
f (TagPosition Row
x1 Row
x2) (TagPosition Row
y1 Row
y2) = Row
x1 forall a. Eq a => a -> a -> Bool
== Row
y1 Bool -> Bool -> Bool
&& Row
x2 forall a. Eq a => a -> a -> Bool
== Row
y2
f Tag a
_ Tag a
_ = Bool
False
(~/=) :: (StringLike str, TagRep t) => Tag str -> t -> Bool
~/= :: forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
(~/=) Tag str
a t
b = Bool -> Bool
not (Tag str
a forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== t
b)
sections :: (a -> Bool) -> [a] -> [[a]]
sections :: forall a. (a -> Bool) -> [a] -> [[a]]
sections a -> Bool
p = forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails
partitions :: (a -> Bool) -> [a] -> [[a]]
partitions :: forall a. (a -> Bool) -> [a] -> [[a]]
partitions a -> Bool
p =
let notp :: a -> Bool
notp = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p
in forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a b. a -> b -> a
const a -> Bool
notp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
notp