module Text.XML.Enumerator.Combinators.Tags
(
tags
, tagsPermute
, Repetition(..)
, repeatNever
, repeatOnce
, repeatOptional
, repeatMany
, repeatSome
, tagsPermuteRepetition
)
where
import Control.Applicative ((<$>))
import Control.Arrow (second)
import Control.Monad (guard, join)
import Data.XML.Types
import Data.Enumerator (Iteratee)
import qualified Data.Map as Map
import qualified Text.XML.Enumerator.Parse as P
tags :: (Monad m)
=> (a -> Name -> Maybe (P.AttrParser b, b -> Iteratee Event m (Maybe (a, Maybe c))))
-> (a -> Iteratee Event m (Maybe (a, Maybe c)))
-> a
-> Iteratee Event m (a, [c])
tags f fb s' = go s'
where go s = do
t <- fmap join (P.tag (f s) (\(attr, sub) -> sub <$> attr) id) `P.orE` fb s
case t of
Nothing -> return (s, [])
Just (s2, Nothing) -> go s2
Just (s2, Just a) -> second (a:) `fmap` go s2
tagsPermute :: (Monad m, Ord k)
=> (Name -> k)
-> Map.Map k (P.AttrParser a, a -> Iteratee Event m (Maybe b))
-> Iteratee Event m (Maybe (Maybe b))
-> Iteratee Event m (Maybe [b])
tagsPermute f m fb = do
(rest, result) <- tags go (\s -> fmap (\a -> (s, a)) <$> fb) m
return (guard (Map.null rest) >> Just result)
where go s name = case Map.lookup k s of
Nothing -> Nothing
Just (attr, sub) -> Just (attr, fmap adaptSub . sub)
where k = f name
adaptSub Nothing = Nothing
adaptSub a = Just (Map.delete k s, a)
data Repetition
= Repeat {
repetitionNeedsMore :: Bool
, repetitionAllowsMore :: Bool
, repetitionConsume :: Repetition
}
repeatNever :: Repetition
repeatNever = Repeat False False repeatNever
repeatOnce :: Repetition
repeatOnce = Repeat True True repeatNever
repeatOptional :: Repetition
repeatOptional = Repeat False True repeatNever
repeatMany :: Repetition
repeatMany = Repeat False True repeatMany
repeatSome :: Repetition
repeatSome = Repeat True True repeatMany
tagsPermuteRepetition :: (Monad m, Ord k)
=> (Name -> k)
-> Map.Map k (Repetition, P.AttrParser b, b -> Iteratee Event m (Maybe t))
-> Iteratee Event m (Maybe (Maybe (k, t)))
-> Iteratee Event m (Maybe [(k, t)])
tagsPermuteRepetition f m' fb = do
let m = Map.filter (\(r, _, _) -> repetitionAllowsMore r) m'
(rest, result) <- tags go (\s -> fmap (\a -> (s, a)) <$> fb) m
return (guard (finished rest) >> Just result)
where
finished = Map.null . Map.filter (\(r, _, _) -> repetitionNeedsMore r)
go s name = do
let k = f name
(rep, attr, sub) <- Map.lookup k s
let adaptSub Nothing = Nothing
adaptSub (Just v) = let s' = case repetitionConsume rep of
rep' | repetitionAllowsMore rep' -> Map.insert k (rep', attr, sub) s
| otherwise -> Map.delete k s
in Just (s', Just (k, v))
Just (attr, fmap adaptSub . sub)