module Text.Hquery (
MakeTransformer(..),
Group(..),
nothing,
) where
import Data.List
import Data.Maybe
import qualified Data.Text as T
import Text.Parsec
import Text.XmlHtml
import Text.XmlHtml.Cursor
import Text.Hquery.Internal.Error
import Text.Hquery.Internal.Selector
import Text.Hquery.Internal.Transform
parseSel :: String ->
(Maybe AttrSel -> Cursor -> Maybe Cursor) ->
[Node] ->
[Node]
parseSel sel builder = case parse commandParser "" sel of
Left _ -> id
Right (css, attr) -> transform css (builder attr)
nothing :: [Node]
nothing = []
data Group = Group [Node]
class MakeTransformer a where
hq :: String -> a -> [Node] -> [Node]
instance MakeTransformer a => MakeTransformer (Maybe a) where
hq sel Nothing = hq sel ([] :: [Node])
hq sel (Just t) = hq sel t
instance MakeTransformer String where
hq sel target = parseSel sel nodeXform
where
nodeXform attr c = case (attr, current c) of
(Just CData, e @ Element {}) -> Just $ setNode (e { elementChildren = [TextNode (T.pack target)] }) c
(Just s, _) -> Just $ buildAttrMod s (T.pack target) c
(Nothing, _) -> Just $ (setNode (TextNode (T.pack target))) c
instance MakeTransformer [String] where
hq sel xs = hq sel $ map (TextNode . T.pack) xs
instance MakeTransformer Node where
hq sel target = hq sel [target]
instance MakeTransformer Group where
hq sel (Group ns) = parseSel sel groupXform
where
groupXform attr c = case (attr, current c) of
(Just CData, e @ Element {}) -> Just $ setNode (e { elementChildren = ns }) c
(Just _, _) -> Just c
(Nothing, _) -> replaceCurrent ns c
instance MakeTransformer ([Node] -> [Node]) where
hq sel f = hq sel [f]
instance MakeTransformer [[Node] -> [Node]] where
hq sel fs = parseSel sel (\_ -> replicateAndApply)
where
replicateAndApply c = let n = (current c)
ns = concat $ fmap ($[n]) fs
in replaceCurrent ns c
instance MakeTransformer [Node] where
hq sel ns = parseSel sel buildNodesXform
where
buildNodesXform (Just CData) = replicateNode
buildNodesXform (Just _) = Just
buildNodesXform Nothing = replaceCurrent ns
replicateNode :: Cursor -> Maybe Cursor
replicateNode c = let n = (current c) in
case n of
e @ Element {} ->
let replicated = map (\x -> e { elementChildren = [x] }) ns
in replaceCurrent replicated c
_ -> raise "bug: shouldn't be replicating on a non-Element node"
replaceCurrent :: [Node] -> Cursor -> Maybe Cursor
replaceCurrent ns c = fromMaybe dflt $ do
p <- parent c
case current p of
pn@Element { elementChildren = kids } -> do
ix <- elemIndex curN kids
let next = setNode (pn { elementChildren = concatMap replaceN kids }) p
let childIdx = (ix 1 + (length ns))
return $ Just $ fromMaybe next $ getChild childIdx next
_ -> raise "should be no non-Element parents!"
where
curN = current c
replaceN n2 = if n2 == curN then ns else [n2]
dflt = do
newCur <- (fromNodes ns)
return (fromMaybe newCur $ findRight isLast newCur)