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

import Bookhound.Parser            (Parser, withError)
import Bookhound.ParserCombinators (IsMatch (..), maybeWithin, (<|>), (|*),
                                    (|+))
import Bookhound.Parsers.Char      (doubleQuote)
import Bookhound.Parsers.String    (spacing, withinAngleBrackets,
                                    withinDoubleQuotes)

import Bookhound.Format.SyntaxTrees.Xml (XmlExpression (..), literalExpression)

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


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



field :: Parser (String, String)
field :: Parser (String, String)
field = forall a. String -> Parser a -> Parser a
withError String
"Xml Field" forall a b. (a -> b) -> a -> b
$
  (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
text forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. IsMatch a => a -> Parser a
is Char
'=' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String
quotedText
  where
    quotedText :: Parser String
quotedText = forall b. Parser b -> Parser b
withinDoubleQuotes (forall a. IsMatch a => Parser a -> Parser a
inverse Parser Char
doubleQuote |*)


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


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


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


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


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


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


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