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 :: Parser XmlExpression
xml = Parser [String] -> Parser XmlExpression -> Parser XmlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin  ((Parser String
header Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|> Parser String
comment) Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
|+) (Parser XmlExpression -> Parser XmlExpression)
-> Parser XmlExpression -> Parser XmlExpression
forall a b. (a -> b) -> a -> b
$
        Parser String -> Parser XmlExpression -> Parser XmlExpression
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacing (Parser XmlExpression -> Parser XmlExpression)
-> Parser XmlExpression -> Parser XmlExpression
forall a b. (a -> b) -> a -> b
$ Parser XmlExpression
branchExpr Parser XmlExpression
-> Parser XmlExpression -> Parser XmlExpression
forall a. Parser a -> Parser a -> Parser a
<|> Parser XmlExpression
leafExpr



field :: Parser (String, String)
field :: Parser (String, String)
field = do String
x <- Parser String
text
           Char -> Parser Char
forall a. IsMatch a => a -> Parser a
is Char
'='
           String
y <- Parser String
quotedText
           pure (String
x, String
y) where

  quotedText :: Parser String
quotedText = Parser String -> Parser String
forall b. Parser b -> Parser b
withinDoubleQuotes (Parser Char -> Parser Char
forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
doubleQuote Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*)


fullTag :: Parser (String, Map String String)
fullTag :: Parser (String, Map String String)
fullTag = do String
tag  <- Parser String
text
             Map String String
flds <- [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(String, String)] -> Map String String)
-> Parser [(String, String)] -> Parser (Map String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Parser String
spacing Parser String -> Parser (String, String) -> Parser (String, String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (String, String)
field) Parser (String, String) -> Parser [(String, String)]
forall a. Parser a -> Parser [a]
|*)
             pure (String
tag, Map String String
flds)


branchExpr :: Parser XmlExpression
branchExpr :: Parser XmlExpression
branchExpr = do (String
tag, Map String String
flds) <- Parser (String, Map String String)
-> Parser (String, Map String String)
forall b. Parser b -> Parser b
withinAngleBrackets Parser (String, Map String String)
fullTag
                [XmlExpression]
exprs       <- (Parser XmlExpression
xml Parser XmlExpression -> Parser [XmlExpression]
forall a. Parser a -> Parser [a]
|+) Parser [XmlExpression]
-> Parser [XmlExpression] -> Parser [XmlExpression]
forall a. Parser a -> Parser a -> Parser a
<|> Parser [XmlExpression]
literal
                Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacing (String -> Parser String
forall a. IsMatch a => a -> Parser a
is (String
"</" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"))
                pure $ XmlExpression :: String -> Map String String -> [XmlExpression] -> XmlExpression
XmlExpression { tagName :: String
tagName = String
tag, fields :: Map String String
fields = Map String String
flds, expressions :: [XmlExpression]
expressions = [XmlExpression]
exprs }


literal :: Parser [XmlExpression]
literal :: Parser [XmlExpression]
literal = XmlExpression -> [XmlExpression]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XmlExpression -> [XmlExpression])
-> (String -> XmlExpression) -> String -> [XmlExpression]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> XmlExpression
literalExpression (String -> [XmlExpression])
-> Parser String -> Parser [XmlExpression]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacing (Char -> Parser Char
forall a. IsMatch a => a -> Parser a
isNot Char
'<' Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*)


leafExpr :: Parser XmlExpression
leafExpr :: Parser XmlExpression
leafExpr = do (String
tag, Map String String
flds) <- Parser (String, Map String String)
-> Parser (String, Map String String)
forall b. Parser b -> Parser b
withinAngleBrackets (Parser (String, Map String String)
fullTag Parser (String, Map String String)
-> Parser Char -> Parser (String, Map String String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
forall a. IsMatch a => a -> Parser a
is Char
'/')
              XmlExpression -> Parser XmlExpression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XmlExpression -> Parser XmlExpression)
-> XmlExpression -> Parser XmlExpression
forall a b. (a -> b) -> a -> b
$ XmlExpression :: String -> Map String String -> [XmlExpression] -> XmlExpression
XmlExpression { tagName :: String
tagName = String
tag, fields :: Map String String
fields = Map String String
flds, expressions :: [XmlExpression]
expressions = [] }


header :: Parser String
header :: Parser String
header = Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacing (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Parser String
forall a. IsMatch a => a -> Parser a
is String
"<?" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Parser Char
forall a. IsMatch a => a -> Parser a
isNot Char
'?' Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*) Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
forall a. IsMatch a => a -> Parser a
is String
"?>"


comment :: Parser String
comment :: Parser String
comment = Parser String -> Parser String -> Parser String
forall a b. Parser a -> Parser b -> Parser b
maybeWithin Parser String
spacing (Parser String -> Parser String) -> Parser String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Parser String
forall a. IsMatch a => a -> Parser a
is String
"<!--" Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Parser Char
forall a. IsMatch a => a -> Parser a
isNot Char
'-' Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*) Parser String -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String
forall a. IsMatch a => a -> Parser a
is String
"-->"



text :: Parser String
text :: Parser String
text = (String -> Parser Char
forall a. IsMatch a => [a] -> Parser a
noneOf [Char
'/', Char
'>', Char
' ', Char
'='] Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|+)