module NestingXML where

import Data.Conduit
import Data.XML.Types
import Control.Monad.Reader
-- import qualified Text.XML.Stream.Parse as Parse (content)

type NestingXML o m a = ReaderT Int (ConduitM Event o m) a

runNestingXML :: NestingXML o m a -> Int -> ConduitM Event o m a
runNestingXML = runReaderT

doNestingXML :: NestingXML o m a -> ConduitM Event o m a
doNestingXML = flip runNestingXML 0

nesting :: Monad m => NestingXML o m Int
nesting = ask

awaitXML :: Monad m => NestingXML o m (Maybe Event)
awaitXML = do
    xml <- lift await
    let f = case xml of
              Just (EventBeginElement _ _) -> (+1)
              Just (EventEndElement _)     -> (subtract 1)
              _                            -> id 
    local f (return xml)

withXML
  :: Monad m => (Event -> NestingXML o m ()) -> NestingXML o m ()
withXML f = do
    xml <- awaitXML
    maybe (return ()) f xml

maybeXML
  :: Monad m => NestingXML o m a -> (Event -> NestingXML o m a) -> NestingXML o m a
maybeXML whenNothing withJust = do
    xml <- awaitXML
    maybe whenNothing withJust xml

awaitCloser :: MonadIO m => Int -> NestingXML o m ()
awaitCloser lvl = do
    fix $ \loop -> do
        lvl' <- nesting
        when (lvl' >= lvl) $ do
        withXML $ \xml -> do
            liftIO $ putStrLn $ "awaitCloser: "++show (lvl',lvl,xml)
            loop

nextElement :: MonadIO m => NestingXML o m (Maybe Event)
nextElement = do
    lvl <- nesting
    fix $ \loop  -> do
        xml <- awaitXML
        liftIO $ putStrLn $ "nextElement: "++show xml
        case xml of
            Nothing                      -> return Nothing
            Just (EventBeginElement _ _) -> return xml
            Just _ -> do
                lvl' <- nesting
                if (lvl'>=lvl) then loop 
                               else return Nothing