module NestingXML where

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

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

runNestingXML :: NestingXML o m a -> Int -> ConduitM Event o m (a,Int)
runNestingXML = runStateT

doNestingXML :: Monad m => NestingXML o m a -> ConduitM Event o m a
doNestingXML = fmap fst . flip runNestingXML 0

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

awaitXML :: Monad m => NestingXML o m (Maybe Event)
awaitXML = do
    lvl <- get
    xml <- lift await
    put $case xml of
              Just (EventBeginElement _ _) -> lvl+1
              Just (EventEndElement _)     -> lvl-1
              _                            -> lvl
    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 :: Monad m => Int -> NestingXML o m ()
awaitCloser lvl = do
    fix $ \loop -> do
        lvl' <- nesting
        when (lvl' >= lvl) $ do
        withXML $ \xml -> do
            loop

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