module XmlParser where

import FailParser


data XML = Tag String [XML] | Text String
 deriving Show


pXMLs = (:) <$> pXML <*> pXMLs `opt` []

pXML = flip Tag [] <$> pOCTag
  <|!> do tag <- pOTag
          xmls <- pXMLs
          pCTag tag
          return (Tag tag xmls)
  <!|> Text <$> pText

pText = do
  c <- pPred ('<'/=)
  cs <- pText
  return (c:cs)
 <|!> do
  c <- pPred ('<'/=)
  return [c]

pOTag = pSym '<' *> pIdent <* pSym '>'

pOCTag = pSym '<' *> pIdent <* pSym '/' <* pSym '>'

pCTag tag = do
  pSym '<'
  pSym '/'
  tag' <- pIdent
  pSym '>'
  if tag /= tag' 
   then fail $ "closing tag </" ++ tag' ++ 
               "> does not match opening tag <" ++ tag ++ ">"
   else return ()

pIdent = do
  c <- pPred (not.(`elem`"/>"))
  cs <- pIdent
  return (c:cs)
 <|!> pSucceed ""