diff options
Diffstat (limited to 'Presence')
-rw-r--r-- | Presence/NestingXML.hs | 43 |
1 files changed, 43 insertions, 0 deletions
diff --git a/Presence/NestingXML.hs b/Presence/NestingXML.hs new file mode 100644 index 00000000..220e82a0 --- /dev/null +++ b/Presence/NestingXML.hs | |||
@@ -0,0 +1,43 @@ | |||
1 | module NestingXML where | ||
2 | |||
3 | import Data.Conduit | ||
4 | import Data.XML.Types | ||
5 | import Control.Monad.Reader | ||
6 | |||
7 | type NestingXML o m a = ReaderT Int (ConduitM Event o m) a | ||
8 | |||
9 | runNestingXML :: NestingXML o m a -> Int -> ConduitM Event o m a | ||
10 | runNestingXML = runReaderT | ||
11 | |||
12 | nesting :: Monad m => NestingXML o m Int | ||
13 | nesting = ask | ||
14 | |||
15 | awaitXML :: Monad m => NestingXML o m (Maybe Event) | ||
16 | awaitXML = do | ||
17 | xml <- lift await | ||
18 | let f = case xml of | ||
19 | Just (EventBeginElement _ _) -> (+1) | ||
20 | Just (EventEndElement _) -> (subtract 1) | ||
21 | _ -> id | ||
22 | local f (return xml) | ||
23 | |||
24 | |||
25 | awaitCloser :: Monad m => Int -> NestingXML o m () | ||
26 | awaitCloser lvl = do | ||
27 | fix $ \loop -> do | ||
28 | awaitXML | ||
29 | lvl' <- nesting | ||
30 | when (lvl' >= lvl) loop | ||
31 | |||
32 | nextElement :: Monad m => NestingXML o m (Maybe Event) | ||
33 | nextElement = do | ||
34 | lvl <- nesting | ||
35 | fix $ \loop -> do | ||
36 | xml <- awaitXML | ||
37 | case xml of | ||
38 | Nothing -> return Nothing | ||
39 | Just (EventBeginElement _ _) -> return xml | ||
40 | Just _ -> do | ||
41 | lvl' <- nesting | ||
42 | if (lvl'>=lvl) then loop | ||
43 | else return Nothing | ||