module Text.Highlighting.Kate.Syntax.Wml ( highlight, parseExpression, syntaxName, syntaxExtensions ) where
import Text.Highlighting.Kate.Definitions
import Text.Highlighting.Kate.Common
import qualified Text.Highlighting.Kate.Syntax.Pango
import qualified Text.Highlighting.Kate.Syntax.Lua
import qualified Text.Highlighting.Kate.Syntax.Alert
import Text.ParserCombinators.Parsec
import Control.Monad (when)
import Data.Map (fromList)
import Data.Maybe (fromMaybe, maybeToList)
import qualified Data.Set as Set
syntaxName :: String
syntaxName = "Wesnoth Markup Language"
syntaxExtensions :: String
syntaxExtensions = "*.cfg;*.pbl;*.CFG;*.PBL"
highlight :: String -> Either String [SourceLine]
highlight input =
case runParser parseSource startingState "source" input of
Left err -> Left $ show err
Right result -> Right result
parseExpression :: GenParser Char SyntaxState LabeledSource
parseExpression = do
st <- getState
let oldLang = synStLanguage st
setState $ st { synStLanguage = "Wesnoth Markup Language" }
context <- currentContext <|> (pushContext "text" >> currentContext)
result <- parseRules context
updateState $ \st -> st { synStLanguage = oldLang }
return result
parseSource = do
lineContents <- lookAhead wholeLine
updateState $ \st -> st { synStCurrentLine = lineContents }
result <- manyTill parseSourceLine eof
return $ map normalizeHighlighting result
startingState = SyntaxState {synStContexts = fromList [("Wesnoth Markup Language",["text"])], synStLanguage = "Wesnoth Markup Language", synStCurrentLine = "", synStCharsParsedInLine = 0, synStPrevChar = '\n', synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}
parseSourceLine = manyTill parseExpressionInternal pEndLine
pEndLine = do
lookAhead $ newline <|> (eof >> return '\n')
context <- currentContext
case context of
"text" -> return () >> pHandleEndLine
"string" -> return () >> pHandleEndLine
"luastring" -> return () >> pHandleEndLine
"luamacrostring" -> return () >> pHandleEndLine
"comment" -> (popContext) >> pEndLine
"macro" -> return () >> pHandleEndLine
"macroString" -> return () >> pHandleEndLine
"macroString2" -> return () >> pHandleEndLine
"section" -> pushContext "error" >> pHandleEndLine
"value" -> (popContext) >> pEndLine
"preprocessor" -> (popContext) >> pEndLine
"error" -> (popContext) >> pEndLine
"variableSubstitution" -> (popContext) >> pEndLine
"variableSubscript" -> pushContext "error" >> pHandleEndLine
"variableSubstitutionRule" -> (popContext) >> pEndLine
_ -> pHandleEndLine
withAttribute attr txt = do
when (null txt) $ fail "Parser matched no text"
let labs = attr : maybeToList (lookup attr styles)
st <- getState
let oldCharsParsed = synStCharsParsedInLine st
let prevchar = if null txt then '\n' else last txt
updateState $ \st -> st { synStCharsParsedInLine = oldCharsParsed + length txt, synStPrevChar = prevchar }
return (labs, txt)
styles = [("Normal Text","st"),("Maintenance script statement","al"),("String","st"),("Comment","co"),("Macro/Include","fu"),("WML Node","kw"),("WML Attribute","dt"),("Preprocessor","ot"),("Error","er"),("Macro String","ch"),("Variable Substitution","dv"),("Variable Subscript","bn")]
parseExpressionInternal = do
context <- currentContext
parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ lookup context defaultAttributes))
list_alerts'5fwml'5futils = Set.fromList $ words $ "wmllint wmlindent wmlscope"
list_preprocessor'5fdirective'5fstatements = Set.fromList $ words $ "#textdomain #else #undef"
list_preprocessor'5fblock'5fbegin'5fstatements = Set.fromList $ words $ "#define #ifdef #ifndef"
list_preprocessor'5fblock'5fend'5fstatements = Set.fromList $ words $ "#enddef #endif"
regex_'28'5f_'2a'29'3f'22 = compileRegex "(_ *)?\""
regex__'2a'3c'3c = compileRegex " *<<"
regex_'5c'5b'28'3f'21'2f'29 = compileRegex "\\[(?!/)"
regex_'5c'5b'2f = compileRegex "\\[/"
regex_'28'5cw'7c'2c'7c_'29'2b'3d = compileRegex "(\\w|,| )+="
regex_'3e'3e = compileRegex ">>"
regex_'5b'5eA'2dZa'2dz0'2d9'5f'5c'2e'5d = compileRegex "[^A-Za-z0-9_\\.]"
defaultAttributes = [("text","Normal WML Text"),("string","String"),("luastring","String"),("luamacrostring","Macro String"),("comment","Comment"),("macro","Macro/Include"),("macroString","Macro String"),("macroString2","Macro String"),("section","WML Node"),("value","WML Attribute"),("preprocessor","Preprocessor"),("error","Error"),("variableSubstitution","Variable Substitution"),("variableSubscript","Variable Subscript"),("variableSubstitutionRule","Variable Substitution")]
parseRules "text" =
do (attr, result) <- (((pRegExpr regex_'28'5f_'2a'29'3f'22 >>= withAttribute "String") >>~ pushContext "string")
<|>
((pRegExpr regex__'2a'3c'3c >>= withAttribute "String") >>~ pushContext "luastring")
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_preprocessor'5fdirective'5fstatements >>= withAttribute "Preprocessor") >>~ pushContext "preprocessor")
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_preprocessor'5fblock'5fbegin'5fstatements >>= withAttribute "Preprocessor") >>~ pushContext "preprocessor")
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_preprocessor'5fblock'5fend'5fstatements >>= withAttribute "Preprocessor") >>~ pushContext "preprocessor")
<|>
((pDetectChar False '#' >>= withAttribute "Comment") >>~ pushContext "comment")
<|>
((pDetectChar False '{' >>= withAttribute "Macro/Include") >>~ pushContext "macro")
<|>
((pRegExpr regex_'5c'5b'28'3f'21'2f'29 >>= withAttribute "WML Node") >>~ pushContext "section")
<|>
((pRegExpr regex_'5c'5b'2f >>= withAttribute "WML Node") >>~ pushContext "section")
<|>
((lookAhead (pRegExpr regex_'28'5cw'7c'2c'7c_'29'2b'3d) >> return ([],"") ) >>~ pushContext "value")
<|>
((parseRules "variableSubstitutionRule")))
return (attr, result)
parseRules "string" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "String") >>~ (popContext))
<|>
((pDetectChar False '{' >>= withAttribute "Macro/Include") >>~ pushContext "macro")
<|>
((parseRules "variableSubstitutionRule"))
<|>
((Text.Highlighting.Kate.Syntax.Pango.parseExpression)))
return (attr, result)
parseRules "luastring" =
do (attr, result) <- (((pRegExpr regex_'3e'3e >>= withAttribute "String") >>~ (popContext))
<|>
((Text.Highlighting.Kate.Syntax.Lua.parseExpression)))
return (attr, result)
parseRules "luamacrostring" =
do (attr, result) <- (((pRegExpr regex_'3e'3e >>= withAttribute "Macro String") >>~ (popContext))
<|>
((Text.Highlighting.Kate.Syntax.Lua.parseExpression)))
return (attr, result)
parseRules "comment" =
do (attr, result) <- (((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_alerts'5fwml'5futils >>= withAttribute "Maintenance script statement"))
<|>
((Text.Highlighting.Kate.Syntax.Alert.parseExpression)))
return (attr, result)
parseRules "macro" =
do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "Macro/Include") >>~ pushContext "macro")
<|>
((pRegExpr regex_'28'5f_'2a'29'3f'22 >>= withAttribute "Macro String") >>~ pushContext "macroString")
<|>
((pRegExpr regex__'2a'3c'3c >>= withAttribute "Macro String") >>~ pushContext "luamacrostring")
<|>
((pDetectChar False '(' >>= withAttribute "Macro String") >>~ pushContext "macroString2")
<|>
((pDetectChar False '}' >>= withAttribute "Macro/Include") >>~ (popContext))
<|>
((parseRules "variableSubstitutionRule")))
return (attr, result)
parseRules "macroString" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "Macro String") >>~ (popContext))
<|>
((pDetectChar False '{' >>= withAttribute "Macro/Include") >>~ pushContext "macro")
<|>
((parseRules "variableSubstitutionRule"))
<|>
((Text.Highlighting.Kate.Syntax.Pango.parseExpression)))
return (attr, result)
parseRules "macroString2" =
do (attr, result) <- (((pDetectChar False ')' >>= withAttribute "Macro String") >>~ (popContext))
<|>
((pDetectChar False '{' >>= withAttribute "Macro/Include") >>~ pushContext "macro")
<|>
((parseRules "text")))
return (attr, result)
parseRules "section" =
do (attr, result) <- ((pDetectChar False ']' >>= withAttribute "WML Node") >>~ (popContext))
return (attr, result)
parseRules "value" =
do (attr, result) <- ((pDetectChar False '=' >>= withAttribute "Normal WML Text") >>~ (popContext))
return (attr, result)
parseRules "preprocessor" =
pzero
parseRules "error" =
pzero
parseRules "variableSubstitution" =
do (attr, result) <- (((pDetectChar False '|' >>= withAttribute "Variable Substitution") >>~ (popContext))
<|>
((pDetectChar False '$' >>= withAttribute "Variable Substitution") >>~ pushContext "variableSubstitution")
<|>
((pDetectChar False '[' >>= withAttribute "Variable Subscript") >>~ pushContext "variableSubscript")
<|>
((lookAhead (pRegExpr regex_'5b'5eA'2dZa'2dz0'2d9'5f'5c'2e'5d) >> return ([],"") ) >>~ (popContext)))
return (attr, result)
parseRules "variableSubscript" =
do (attr, result) <- ((pDetectChar False ']' >>= withAttribute "Variable Subscript") >>~ (popContext))
return (attr, result)
parseRules "variableSubstitutionRule" =
do (attr, result) <- ((pDetectChar False '$' >>= withAttribute "Variable Substitution") >>~ pushContext "variableSubstitution")
return (attr, result)
parseRules "" = parseRules "text"
parseRules x = fail $ "Unknown context" ++ x