module Text.XML.DOM.Parser.Combinators
(
traverseElems
, inFilteredTrav
, inElemTrav
, inElem
, inElemAll
, inElemMay
, inElemNe
, divePath
, diveElem
, ignoreElem
, ignoreEmpty
, ignoreBlank
) where
import Control.Lens
import Control.Monad.Reader
import Data.Foldable as F
import Data.List as L
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid
import Data.Text as T
import Data.Traversable
import Text.XML
import Text.XML.DOM.Parser.Buildable
import Text.XML.DOM.Parser.Types
import Text.XML.Lens
traverseElems
:: (Monad m, Foldable g, Traversable f)
=> ([Element] -> DomParserT g m (f (DomPath, Element)))
-> DomParserT Identity m a
-> DomParserT g m (f a)
traverseElems trav parser = do
pd <- ask
inner <- trav $ pd ^.. pdElements . folded
for inner $ \(subpath, e) -> do
let
newpd = ParserData
{ _pdElements = Identity e
, _pdPath = pd ^. pdPath <> subpath }
lift $ runReaderT parser newpd
inFilteredTrav
:: (Monad m, Foldable g, Buildable f)
=> ([Element] -> (DomPath, [Element]))
-> DomParserT Identity m a
-> DomParserT g m (f a)
inFilteredTrav deeper = traverseElems trav
where
trav e = do
let (path, elems) = deeper e
case build elems of
Nothing -> throwParserError $ PENotFound . (<> path)
Just tr -> return $ fmap (path,) tr
inElemTrav
:: (Monad m, Foldable g, Buildable f)
=> ElemMatcher
-> DomParserT Identity m a
-> DomParserT g m (f a)
inElemTrav n = inFilteredTrav deeper
where
elemsFold = folded . nodes . folded . _Element . elMatch n
deeper = (DomPath [_emShow n],) . toListOf elemsFold
inElem
:: (Monad m, Foldable g)
=> ElemMatcher
-> DomParserT Identity m a
-> DomParserT g m a
inElem n = fmap runIdentity . inElemTrav n
inElemAll
:: (Monad m, Foldable g)
=> ElemMatcher
-> DomParserT Identity m a
-> DomParserT g m [a]
inElemAll = inElemTrav
inElemMay
:: (Monad m, Foldable g)
=> ElemMatcher
-> DomParserT Identity m a
-> DomParserT g m (Maybe a)
inElemMay = inElemTrav
inElemNe
:: (Monad m, Foldable g)
=> ElemMatcher
-> DomParserT Identity m a
-> DomParserT g m (NonEmpty a)
inElemNe = inElemTrav
divePath
:: forall m g a
. (Monad m, Foldable g)
=> [ElemMatcher]
-> DomParserT [] m a
-> DomParserT g m a
divePath path = magnify $ to modElems
where
modElems
= over pdElements (toListOf $ folded . diver)
. over pdPath (<> DomPath (L.map _emShow path))
diver :: Fold Element Element
diver = F.foldr (.) id $ L.map toDive path
toDive n = nodes . folded . _Element . elMatch n
diveElem
:: (Monad m, Foldable g)
=> ElemMatcher
-> DomParserT [] m a
-> DomParserT g m a
diveElem p = divePath [p]
ignoreElem
:: (Monad m)
=> (Element -> Bool)
-> DomParserT Identity m a
-> DomParserT Identity m (Maybe a)
ignoreElem test parser = do
ign <- view $ pdElements . to (test . runIdentity)
if ign then pure Nothing else Just <$> parser
ignoreEmpty
:: (Monad m)
=> DomParserT Identity m a
-> DomParserT Identity m (Maybe a)
ignoreEmpty = ignoreElem test
where
test e = L.null $ e ^. nodes
ignoreBlank
:: (Monad m)
=> DomParserT Identity m a
-> DomParserT Identity m (Maybe a)
ignoreBlank = ignoreElem test
where
test e =
let
elems = e ^.. nodes . folded . _Element
cont = mconcat $ e ^.. nodes . folded . _Content
in if | not $ L.null elems -> False
| T.null $ T.strip cont -> True
| otherwise -> False