module Text.HTML.Tagchup.Process where
import qualified Text.HTML.Tagchup.Tag as Tag
import qualified Text.HTML.Tagchup.Tag.Match as Match
import qualified Text.XML.Basic.Attribute as Attr
import qualified Text.XML.Basic.Name as Name
import qualified Data.Char as Char
import Data.List.HT (viewL, takeWhileRev, )
import Data.Tuple.HT (mapFst, )
import Data.Maybe (fromMaybe, mapMaybe, )
import Control.Monad (guard, liftM2, )
findMetaEncoding ::
(Name.Tag name, Name.Attribute name) =>
[Tag.T name String] -> Maybe String
findMetaEncoding =
fmap (map Char.toLower . takeWhileRev ('='/=)) .
lookup "content-type" .
map (mapFst (map Char.toLower)) .
getMetaHTTPHeaders
getMetaHTTPHeaders ::
(Name.Tag name, Name.Attribute name) =>
[Tag.T name string] -> [(string, string)]
getMetaHTTPHeaders =
mapMaybe
(\tag ->
do (name, attrs) <- Tag.maybeOpen tag
guard (Name.match "meta" name)
liftM2 (,)
(Attr.lookupLit "http-equiv" attrs)
(Attr.lookupLit "content" attrs)) .
getHeadTags
getHeadTags ::
(Name.Tag name, Name.Attribute name) =>
[Tag.T name string] -> [Tag.T name string]
getHeadTags =
takeWhile (not . Match.closeLit "head") .
drop 1 .
dropWhile (not . Match.openLit "head" (const True)) .
takeWhile (not . Match.openLit "body" (const True))
partAttrs ::
(Name.Tag name) =>
(Tag.Name name -> Bool) ->
(([Attr.T name string], [Tag.T name string]) ->
([Attr.T name string], [Tag.T name string])) ->
[Tag.T name string] -> [Tag.T name string]
partAttrs p f =
concatMap
(either
(\((name,attrs),part) ->
let (newAttrs, newPart) = f (attrs, part)
in Tag.Open name newAttrs : newPart ++ [Tag.Close name])
id) .
parts p
parts ::
(Name.Tag name) =>
(Tag.Name name -> Bool) ->
[Tag.T name string] ->
[Either
((Tag.Name name, [Attr.T name string]), [Tag.T name string])
[Tag.T name string]]
parts p =
let recourse ts =
let (prefix0,suffix0) = break (Match.open p (const True)) ts
in Right prefix0 :
fromMaybe []
(do (t, suffix1) <- viewL suffix0
(name, attrs) <- Tag.maybeOpen t
let (part,suffix2) = break (Match.close (name==)) suffix1
return $ Left ((name, attrs), part) : recourse (drop 1 suffix2))
in recourse