Xml.hs

module Parsers.Xml (xml, branchExpr, leafExpr, literal) where

import Parser (Parser)
import ParserCombinators (IsMatch(..), (<|>), (|*), (|+), maybeWithin)
import Parsers.Char (doubleQuote)
import Parsers.String (withinDoubleQuotes, withinAngleBrackets, spacing)
import SyntaxTrees.Xml ( XmlExpression(..), literalExpression )

import qualified Data.Map as Map
import Data.Map(Map)



xml :: Parser XmlExpression
xml = maybeWithin  ((header <|> comment) |+) $
        maybeWithin spacing $ branchExpr <|> leafExpr



field :: Parser (String, String)
field = do x <- text
           is '='
           y <- quotedText
           pure (x, y) where

  quotedText = withinDoubleQuotes (inverse doubleQuote |*)


fullTag :: Parser (String, Map String String)
fullTag = do tag  <- text
             flds <- Map.fromList <$> ((spacing *> field) |*)
             pure (tag, flds)


branchExpr :: Parser XmlExpression
branchExpr = do (tag, flds) <- withinAngleBrackets fullTag
                exprs       <- (xml |+) <|> literal
                maybeWithin spacing (is ("</" ++ tag ++ ">"))
                pure $ XmlExpression { tagName = tag, fields = flds, expressions = exprs }


literal :: Parser [XmlExpression]
literal = pure . literalExpression <$> maybeWithin spacing (isNot '<' |*)


leafExpr :: Parser XmlExpression
leafExpr = do (tag, flds) <- withinAngleBrackets (fullTag <* is '/')
              pure $ XmlExpression { tagName = tag, fields = flds, expressions = [] }


header :: Parser String
header = maybeWithin spacing $ is "<?" *> (isNot '?' |*) <* is "?>"


comment :: Parser String
comment = maybeWithin spacing $ is "<!--" *> (isNot '-' |*) <* is "-->"



text :: Parser String
text = (noneOf ['/', '>', ' ', '='] |+)