content: {-| The Parser for the reflex-jsx language
  
      Given a "String", @parseJsx@ outputs the AST for the language. Note that at
      this point, we capture spliced expressions from the meta-language as
      Strings, and parse them during the quasiquoting phase in @ReflexJsx.QQ@
  -}
  module ReflexJsx.Parser
         ( parseJsx
         , Node(..)
         , Attrs(..)
         , AttrValue(..)
         ) where
  
  import Text.Parsec (runParser, Parsec, try, eof, many, many1, between)
  import Text.Parsec.Char (char, letter, noneOf, string, alphaNum, spaces)
  
  import Control.Applicative ((<|>))
  
  
  data AttrValue = TextVal String
                 | ExprVal String
  
  
  data Attrs = SplicedAttrs String
             | StaticAttrs [(String, AttrValue)]
  
  
  data Node = Node String Attrs [Node]
            | Text String
            | SplicedNode String
  
  
  parseJsx :: Monad m => String -> m Node
  parseJsx s =
    case runParser p () "" s of
      Left err -> fail $ show err
      Right e -> return e
    where p = do
            spaces
            node <- jsxElement
            spaces
            eof
            return node
  
  
  jsxElement :: Parsec String u Node
  jsxElement = do
    try jsxSelfClosingElement <|> jsxNormalElement
  
  
  jsxSelfClosingElement :: Parsec String u Node
  jsxSelfClosingElement = do
    _ <- char '<'
    name <- jsxElementName
    attrs <- jsxNodeAttrs
    _ <- string "/>"
    return (Node name attrs [])
  
  
  jsxNormalElement :: Parsec String u Node
  jsxNormalElement = do
    (name, attrs) <- jsxOpeningElement
    children <- many jsxChild
    jsxClosingElement name
    return (Node name attrs children)
  
  
  jsxOpeningElement :: Parsec String u (String, Attrs)
  jsxOpeningElement = do
    _ <- char '<'
    name <- jsxElementName
    attrs <- jsxNodeAttrs
    _ <- char '>'
    return (name, attrs)
  
  
  jsxNodeAttrs :: Parsec String u Attrs
  jsxNodeAttrs = do
    try jsxSplicedAttrMap <|> (StaticAttrs <$> many jsxNodeAttr)
  
  
  jsxSplicedAttrMap :: Parsec String u Attrs
  jsxSplicedAttrMap = do
    name <- between (string "{...") (string "}") $ many (noneOf "}")
    return $ SplicedAttrs name
  
  
  jsxNodeAttr :: Parsec String u (String, AttrValue)
  jsxNodeAttr = do
    key <- jsxAttributeName
    spaces
    _ <- char '='
    spaces
    value <- jsxQuotedValue <|> jsxSplicedValue
    spaces
    return (key, value)
  
  
  jsxAttributeName :: Parsec String u String
  jsxAttributeName = do
    many $ letter <|> char '-'
  
  
  jsxQuotedValue :: Parsec String u AttrValue
  jsxQuotedValue = do
    contents <- between (char '"') (char '"') $ many (noneOf "\"")
    return $ TextVal contents
  
  
  jsxSplicedValue :: Parsec String u AttrValue
  jsxSplicedValue = do
    name <- between (char '{') (char '}') $ many (noneOf "}")
    return $ ExprVal name
  
  
  jsxClosingElement :: String -> Parsec String u ()
  jsxClosingElement ele = do
    _ <- string "</" *> string ele *> char '>'
    return ()
  
  
  jsxChild :: Parsec String u Node
  jsxChild = do
    try jsxText <|> try jsxSplicedNode <|> try jsxElement
  
  
  jsxText :: Parsec String u Node
  jsxText = do
    contents <- many1 $ noneOf "{<>}"
    return $ Text contents
  
  
  jsxSplicedNode :: Parsec String u Node
  jsxSplicedNode = do
    exprString <- between (char '{') (char '}') $ many (noneOf "}")
    return $ SplicedNode exprString
  
  
  jsxElementName :: Parsec String u String
  jsxElementName = jsxIdentifier
  
  
  jsxIdentifier :: Parsec String u String
  jsxIdentifier = do
    name <- many1 alphaNum
    spaces
    return name
  