-- |
-- the Xslt Parser for Patterns (match-attributes of template-elements)
--

module XsltParser
where

import XPathParser
import XPathDataTypes

import Text.ParserCombinators.Parsec

import XmlParser
    ( systemLiteral
    -- , separator
    , skipS0
    , qName
    )

import XsltKeywords
import XsltDataTypes
--import XmlTreeFunctions
-- -----------------------------------------------------------------------------

lpar, rpar, slash, dslash, pipe	:: Parser ()
lpar        = tokenParser (symbol "(")
rpar        = tokenParser (symbol ")")
slash       = tokenParser (symbol "/")
dslash      = tokenParser (symbol "//")
pipe        = tokenParser (symbol "|")
-- ------------------------------------------------------------
xsltParser :: Parser [XsltStepList]
xsltParser
    = do
        skipS0
        n <- sepBy stepList pipe
        skipS0
        eof
        return n
      <?> "XsltPattern"

stepList :: Parser XsltStepList
stepList
    = do
        sp1 <- stepPart
        sp2 <- many stepPart'
        return (StepList (reverse (sp1 : sp2)))
      <?> "XsltPattern"

stepPart :: Parser XsltStep
stepPart
    = do
        dslash
        tn <- tagName
        return tn
      <|>
      do
        slash
        return XsltRoot
      <|>
      do
        tokenParser (symbol "id")
        lit <- between lpar rpar (systemLiteral)
        return (XsltIdPattern lit)
      <|>
      do
        tokenParser (symbol "key")
        lit <- between lpar rpar (twoLiteral)
        return (XsltKeyPattern lit)
      <|>
      do
        tn <- tagName
        return tn
      <?> "XsltStep"

stepPart' :: Parser XsltStep
stepPart'
    = do
        dslash
        return XsltAncestor
      <|>
      do
        slash
        return XsltParent
      <|>
      do
        tn <- tagName
        return tn
      <?> "XsltStep'"

wildcard :: Parser XsltStep
wildcard
    = do
        as <- try childOrAttribAxis'
        tokenParser (symbol "*")
        wc <- do (option (XsltWildcard as [])(
                  do
                    pe <- many predicate
                    return (XsltWildcard as pe)
                    )
                  )
        return wc
      <|>
      do
        tokenParser (symbol "*")
        wc <- do (option (XsltWildcard Child [])(
                  do
                    pe <- many predicate
                    return (XsltWildcard Child pe)
                    )
                  )
        return wc
      <?> "XsltStep(wildcard)"

tagName :: Parser XsltStep
tagName
    = do
        wc <- try wildcard
        return wc
      <|>
      do
        as <- try childOrAttribAxis'
        nt <- nodeTest
        sp <- do (option (XsltTagName as nt [])(
                  do
                    pe <- many predicate
                    return (XsltTagName as nt pe)
                    )
                  )
        return sp
      <|>
      do
        nt <- nodeTest
        sp <- do (option (XsltTagName Child nt [])(
                  do
                    pe <- many predicate
                    return (XsltTagName Child nt pe)
                    )
                  )
        return sp
      <?> "XsltStep(tagName)"

childOrAttribAxis' :: Parser AxisSpec
childOrAttribAxis' 
    = do
        tokenParser (symbol "@")
        return Attribute
      <|>
      do
        ca <- childOrAttribAxis
        tokenParser (symbol "::")
        return ca
      <?> "ChildOrAttributeAxisSpecifier'"

childOrAttribAxis :: Parser AxisSpec
childOrAttribAxis
    = choice [ symbolParser (a_child, Child)
             , symbolParser (a_attribute, Attribute)
             ]
      <?> "ChildOrAttributeAxisSpecifier"

twoLiteral ::  Parser (Literal,Literal)
twoLiteral
    = do
        l1 <- systemLiteral
        tokenParser (symbol ",")
        l2 <- systemLiteral
        return (l1,l2)
      <?> "(Literal,Literal)"
-- -----------------------------------------------------------------------------
-- |
-- parsing a number
--
--    - returns : the parsed number as float
parseFloat :: String -> Float
parseFloat s
    = case (parse parseFloat' "" s) of
        Left _ -> 0.0
        Right x  -> (read x :: Float)

parseFloat' :: Parser String
parseFloat'
    = do
      skipS0
      m <- option "" (string "-")
      n <- number
      skipS0
      eof
      return (m ++ n)
    <?> "Float-Number"
      
      

-- -----------------------------------------------------------------------------
-- |
-- parsing qnames (whitespace-separated list of names)
--
parseQNames :: String -> [(String, String)]
parseQNames s
    = case (parse parseQNames' "" s) of
        Left _ -> []
        Right x  -> x

parseQNames' :: Parser [(String, String)]
parseQNames'
    = do
      skipS0
      qn1 <- qName
      qn2 <- many qName
      skipS0
      eof
      return (qn1 : qn2)
     <?> "QNames"

-- -----------------------------------------------------------------------------
-- |
-- parsing qName
--
parseQName :: String -> (String, String)
parseQName s
    = case (parse parseQName' "" s) of
        Left _ -> ("","")
        Right x  -> x

parseQName' :: Parser (String, String)
parseQName'
    = do
      skipS0
      qn <- qName
      skipS0
      eof
      return qn
     <?> "QNames"


-- -----------------------------------------------------------------------------
-- |
-- parsing tokens (whitespace-separated list of nametests)
--
parseNameTests :: String -> [XsltStepList]
parseNameTests s
    = case (parse parseNameTests' "" s) of
        Left _ -> []
        Right x  -> [x]

parseNameTests' :: Parser XsltStepList
parseNameTests'
    = do
      skipS0
      nt1 <- xsltToken
      nt2 <- many xsltToken
      skipS0
      eof
      return (StepList (nt1 : nt2))
     <?> "NameTests"

xsltToken :: Parser XsltStep
xsltToken
    = do
      skipS0
      qn <- nameTest
      skipS0
      return (XsltToken qn)
     <?> "xsltToken"