{- This module was generated from data in the Kate syntax highlighting file d.xml, version 1.61,
   by  Diggory Hardy (diggory.hardy@gmail.com), Aziz Köksal (aziz.koeksal@gmail.com), Jari-Matti Mäkelä (jmjm@iki.fi), Simon J Mackenzie (project.katedxml@smackoz.fastmail.fm) -}

module Text.Highlighting.Kate.Syntax.D ( highlight, parseExpression, syntaxName, syntaxExtensions ) where
import Text.Highlighting.Kate.Definitions
import Text.Highlighting.Kate.Common
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
-- | Full name of language.
syntaxName :: String
syntaxName = "D"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.d;*.D;*.di;*.DI;"

-- | Highlight source code using this syntax definition.
highlight :: String -> Either String [SourceLine]
highlight input =
  case runParser parseSource startingState "source" input of
    Left err     -> Left $ show err
    Right result -> Right result

-- | Parse an expression using appropriate local context.
parseExpression :: GenParser Char SyntaxState LabeledSource
parseExpression = do
  st <- getState
  let oldLang = synStLanguage st
  setState $ st { synStLanguage = "D" }
  context <- currentContext <|> (pushContext "normal" >> 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 [("D",["normal"])], synStLanguage = "D", 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
    "normal" -> return () >> pHandleEndLine
    "StartingLetter" -> (popContext) >> pEndLine
    "Properties" -> return () >> pHandleEndLine
    "NumberLiteral" -> return () >> pHandleEndLine
    "LinePragma" -> (popContext) >> pEndLine
    "UnicodeShort" -> (popContext) >> pEndLine
    "UnicodeLong" -> (popContext) >> pEndLine
    "HTMLEntity" -> (popContext) >> pEndLine
    "ModuleName" -> return () >> pHandleEndLine
    "Linkage" -> return () >> pHandleEndLine
    "Linkage2" -> return () >> pHandleEndLine
    "Version" -> return () >> pHandleEndLine
    "Version2" -> return () >> pHandleEndLine
    "Scope" -> return () >> pHandleEndLine
    "Scope2" -> return () >> pHandleEndLine
    "Pragma" -> return () >> pHandleEndLine
    "Pragma2" -> return () >> pHandleEndLine
    "RawString" -> return () >> pHandleEndLine
    "BQString" -> return () >> pHandleEndLine
    "HexString" -> return () >> pHandleEndLine
    "CharLiteral" -> pushContext "CharLiteralClosing" >> pHandleEndLine
    "CharLiteralClosing" -> (popContext >> popContext) >> pEndLine
    "String" -> return () >> pHandleEndLine
    "CommentRules" -> (popContext) >> pEndLine
    "Region Marker" -> (popContext) >> pEndLine
    "CommentLine" -> (popContext) >> pEndLine
    "CommentBlock" -> return () >> pHandleEndLine
    "CommentNested" -> return () >> pHandleEndLine
    "DdocNormal" -> return () >> pHandleEndLine
    "DdocLine" -> (popContext) >> pEndLine
    "DdocBlock" -> return () >> pHandleEndLine
    "DdocNested" -> return () >> pHandleEndLine
    "DdocNested2" -> return () >> pHandleEndLine
    "DdocMacro" -> return () >> pHandleEndLine
    "DdocMacro2" -> return () >> pHandleEndLine
    "DdocMacro3" -> return () >> pHandleEndLine
    "MacroRules" -> return () >> pHandleEndLine
    "DdocBlockCode" -> return () >> pHandleEndLine
    "DdocNestedCode" -> return () >> pHandleEndLine
    _ -> 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 = [("Statement","kw"),("Expression","kw"),("Declarator","kw"),("Template","kw"),("Attribute","kw"),("Deprecated","kw"),("Property","dt"),("Type","dt"),("LibrarySymbols","dt"),("UserKeywords","dt"),("Module","kw"),("Pragma","kw"),("Version","kw"),("Linkage","kw"),("Tests","kw"),("Comment","co"),("Region Marker","re"),("Error","er"),("Integer","dv"),("Binary","bn"),("Octal","bn"),("Hex","bn"),("Float","fl"),("EscapeSequence","st"),("String","st"),("Char","ch"),("RawString","st"),("BQString","st"),("HexString","st"),("Macros","ot"),("Ddoc","co"),("DdocSection","kw")]

parseExpressionInternal = do
  context <- currentContext
  parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ lookup context defaultAttributes))

list_userkeywords = Set.fromList $ words $ ""
list_statements = Set.fromList $ words $ "asm body break case catch continue default do else finally for foreach foreach_reverse goto if mixin return switch throw try while with synchronized"
list_attributes = Set.fromList $ words $ "abstract align auto const export final inout invariant lazy nothrow override package private protected public pure ref static out scope"
list_expressions = Set.fromList $ words $ "false null super this true typeid assert cast is new delete in delegate function"
list_modules = Set.fromList $ words $ "module import"
list_declarators = Set.fromList $ words $ "alias enum typedef class interface struct union"
list_types = Set.fromList $ words $ "typeof void bool byte ubyte short ushort int uint long ulong cent ucent float double real ireal ifloat idouble creal cfloat cdouble char wchar dchar"
list_templates = Set.fromList $ words $ "macro template"
list_properties = Set.fromList $ words $ "init sizeof alignof mangleof stringof tupleof offsetof max min infinity nan dig epsilon mant_dig max_10_exp max_exp min_10_exp min_exp re im length ptr dup idup reverse sort keys values rehash"
list_libsymbols = Set.fromList $ words $ "size_t ptrdiff_t hash_t Error Exception Object TypeInfo ClassInfo ModuleInfo Interface OffsetTypeInfo TypeInfo_Typedef TypeInfo_Enum TypeInfo_Pointer TypeInfo_Array TypeInfo_StaticArray TypeInfo_AssociativeArray TypeInfo_Function TypeInfo_Delegate TypeInfo_Class TypeInfo_Interface TypeInfo_Struct TypeInfo_Tuple string wstring dstring bit TypeInfo_Const TypeInfo_Invariant"
list_linkage = Set.fromList $ words $ "extern"
list_ltypes = Set.fromList $ words $ "C D Windows Pascal System"
list_ptypes = Set.fromList $ words $ "msg lib"
list_scope'5fkeywords = Set.fromList $ words $ "exit success failure"
list_vtypes = Set.fromList $ words $ "DigitalMars X86 X86_64 Windows Win32 Win64 linux LittleEndian BigEndian D_Coverage D_InlineAsm_X86 unittest D_Version2 none all"
list_specialtokens = Set.fromList $ words $ "__FILE__ __LINE__ __DATE__ __TIME__ __TIMESTAMP__ __VENDOR__ __VERSION__ __EOF__"
list_tests = Set.fromList $ words $ "debug unittest"
list_pragma = Set.fromList $ words $ "pragma"
list_version = Set.fromList $ words $ "version"
list_deprecated = Set.fromList $ words $ "deprecated volatile"

regex_'5ba'2dzA'2dZ'5f'5d = compileRegex "[a-zA-Z_]"
regex_'5c'2e'5cd'5b'5cd'5f'5d'2a'28'5beE'5d'5b'2d'2b'5d'3f'5cd'5b'5cd'5f'5d'2a'29'3f'5bfFL'5d'3fi'3f = compileRegex "\\.\\d[\\d_]*([eE][-+]?\\d[\\d_]*)?[fFL]?i?"
regex_'5cd = compileRegex "\\d"
regex_'5b'5ea'2dzA'2dZ'5f'5d = compileRegex "[^a-zA-Z_]"
regex_in'5cs'2a'28'3f'3d'5c'7b'29 = compileRegex "in\\s*(?=\\{)"
regex_out'5cs'2a'28'3f'3d'28'5c'28'28'5ba'2dzA'2dZ'5f'5d'5b'5cw'5f'5d'2a'29'3f'5c'29'5cs'2a'29'3f'5c'7b'29 = compileRegex "out\\s*(?=(\\(([a-zA-Z_][\\w_]*)?\\)\\s*)?\\{)"
regex_scope'5cs'2a'28'3f'3d'5c'28'29 = compileRegex "scope\\s*(?=\\()"
regex_import'5cs'2a'28'3f'3d'5c'28'29 = compileRegex "import\\s*(?=\\()"
regex_function'5cs'2a'28'3f'3d'5c'28'29 = compileRegex "function\\s*(?=\\()"
regex_delegate'5cs'2a'28'3f'3d'5c'28'29 = compileRegex "delegate\\s*(?=\\()"
regex_0'5bxX'5d'5b'5cda'2dfA'2dF'5f'5d'2a'28'5c'2e'5b'5cda'2dfA'2dF'5f'5d'2a'29'3f'5bpP'5d'5b'2d'2b'5d'3f'5cd'5b'5cd'5f'5d'2a'5bfFL'5d'3fi'3f = compileRegex "0[xX][\\da-fA-F_]*(\\.[\\da-fA-F_]*)?[pP][-+]?\\d[\\d_]*[fFL]?i?"
regex_'5cd'5b'5f'5cd'5d'2a'28'5c'2e'28'3f'21'5c'2e'29'5b'5f'5cd'5d'2a'28'5beE'5d'5b'2d'2b'5d'3f'5cd'5b'5f'5cd'5d'2a'29'3f'5bfFL'5d'3fi'3f'7c'5beE'5d'5b'2d'2b'5d'3f'5cd'5b'5f'5cd'5d'2a'5bfFL'5d'3fi'3f'7c'5bfF'5di'3f'7c'5bfFL'5d'3fi'29 = compileRegex "\\d[_\\d]*(\\.(?!\\.)[_\\d]*([eE][-+]?\\d[_\\d]*)?[fFL]?i?|[eE][-+]?\\d[_\\d]*[fFL]?i?|[fF]i?|[fFL]?i)"
regex_0'5bbB'5d'5f'2a'5b01'5d'5b01'5f'5d'2a'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f = compileRegex "0[bB]_*[01][01_]*(L[uU]?|[uU]L?)?"
regex_0'5b0'2d7'5f'5d'2b'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f = compileRegex "0[0-7_]+(L[uU]?|[uU]L?)?"
regex_0'5bxX'5d'5f'2a'5b'5cda'2dfA'2dF'5d'5b'5cda'2dfA'2dF'5f'5d'2a'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f = compileRegex "0[xX]_*[\\da-fA-F][\\da-fA-F_]*(L[uU]?|[uU]L?)?"
regex_'5cd'2b'5b'5cd'5f'5d'2a'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f = compileRegex "\\d+[\\d_]*(L[uU]?|[uU]L?)?"
regex_'28'280'28'5b0'2d7'5f'5d'2b'7c'5bbB'5d'5f'2a'5b01'5d'5b01'5f'5d'2a'7c'5bxX'5d'5f'2a'5b'5cda'2dfA'2dF'5d'5b'5cda'2dfA'2dF'5f'5d'2a'29'29'7c'5cd'2b'5b'5cd'5f'5d'2a'29'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f = compileRegex "((0([0-7_]+|[bB]_*[01][01_]*|[xX]_*[\\da-fA-F][\\da-fA-F_]*))|\\d+[\\d_]*)(L[uU]?|[uU]L?)?"
regex_'22'5b'5e'22'5d'2a'22 = compileRegex "\"[^\"]*\""
regex_'2e'2b = compileRegex ".+"
regex_'5b'5cda'2dfA'2dF'5d'7b4'7d = compileRegex "[\\da-fA-F]{4}"
regex_'5b'5cda'2dfA'2dF'5d'7b8'7d = compileRegex "[\\da-fA-F]{8}"
regex_'5ba'2dzA'2dZ'5d'5cw'2b'3b = compileRegex "[a-zA-Z]\\w+;"
regex_'5b'5e'5cs'5cw'2e'3a'2c'3d'5d = compileRegex "[^\\s\\w.:,=]"
regex_'5b'5e'29'5cs'5cn'5d'2b = compileRegex "[^)\\s\\n]+"
regex_'5b'5e'5cs'5cn'5d'2b = compileRegex "[^\\s\\n]+"
regex_'5b'5e'5csa'2dfA'2dF'5cd'22'5d'2b = compileRegex "[^\\sa-fA-F\\d\"]+"
regex_'5c'5c'28u'5b'5cda'2dfA'2dF'5d'7b4'7d'7cU'5b'5cda'2dfA'2dF'5d'7b8'7d'7c'26'5ba'2dzA'2dZ'5d'5cw'2b'3b'29 = compileRegex "\\\\(u[\\da-fA-F]{4}|U[\\da-fA-F]{8}|&[a-zA-Z]\\w+;)"
regex_'5c'5c'2e = compileRegex "\\\\."
regex_'2e = compileRegex "."
regex_'2f'7b3'2c'7d = compileRegex "/{3,}"
regex_'2f'5c'2a'7b2'2c'7d'28'3f'21'2f'29 = compileRegex "/\\*{2,}(?!/)"
regex_'2f'5c'2b'7b2'2c'7d'28'3f'21'2f'29 = compileRegex "/\\+{2,}(?!/)"
regex_'5b'5cw'5f'5d'2b'3a'28'24'7c'5cs'29 = compileRegex "[\\w_]+:($|\\s)"
regex_'5c'2a'2b'2f = compileRegex "\\*+/"
regex_'5b'5e'2d'5d'2d'7b3'2c'7d = compileRegex "[^-]-{3,}"
regex_'2d'7b3'2c'7d'28'24'7c'5cs'29 = compileRegex "-{3,}($|\\s)"
regex_'5c'2b'2b'2f = compileRegex "\\++/"

defaultAttributes = [("normal","Normal Text"),("StartingLetter","Normal Text"),("Properties","Normal Text"),("NumberLiteral","Normal Text"),("LinePragma","Pragma"),("UnicodeShort","EscapeSequence"),("UnicodeLong","EscapeSequence"),("HTMLEntity","EscapeSequence"),("ModuleName","Module Name"),("Linkage","Normal Text"),("Linkage2","Normal Text"),("Version","Normal Text"),("Version2","Normal Text"),("Scope","Normal Text"),("Scope2","Normal Text"),("Pragma","Pragma"),("Pragma2","Pragma"),("RawString","RawString"),("BQString","BQString"),("HexString","HexString"),("CharLiteral","Char"),("CharLiteralClosing","Error"),("String","String"),("CommentRules","Normal Text"),("Region Marker","Region Marker"),("CommentLine","Comment"),("CommentBlock","Comment"),("CommentNested","Comment"),("DdocNormal","Normal Text"),("DdocLine","Ddoc"),("DdocBlock","Ddoc"),("DdocNested","Ddoc"),("DdocNested2","Ddoc"),("DdocMacro","Error"),("DdocMacro2","Macro Text"),("DdocMacro3","Macro Text"),("MacroRules","Macro Text"),("DdocBlockCode","DdocCode"),("DdocNestedCode","DdocCode")]

parseRules "normal" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((lookAhead (pRegExpr regex_'5ba'2dzA'2dZ'5f'5d) >> return ([],"") ) >>~ pushContext "StartingLetter")
                        <|>
                        ((pHlCStringChar >>= withAttribute "EscapeSequence"))
                        <|>
                        ((pDetect2Chars False '\\' 'u' >>= withAttribute "EscapeSequence") >>~ pushContext "UnicodeShort")
                        <|>
                        ((pDetect2Chars False '\\' 'U' >>= withAttribute "EscapeSequence") >>~ pushContext "UnicodeLong")
                        <|>
                        ((pDetect2Chars False '\\' '&' >>= withAttribute "EscapeSequence") >>~ pushContext "HTMLEntity")
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Char") >>~ pushContext "CharLiteral")
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "String")
                        <|>
                        ((pDetectChar False '`' >>= withAttribute "BQString") >>~ pushContext "BQString")
                        <|>
                        ((pFirstNonSpace >> pString False "//BEGIN" >>= withAttribute "Region Marker") >>~ pushContext "Region Marker")
                        <|>
                        ((pFirstNonSpace >> pString False "//END" >>= withAttribute "Region Marker") >>~ pushContext "Region Marker")
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((pString False "..." >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetect2Chars False '.' '.' >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'5c'2e'5cd'5b'5cd'5f'5d'2a'28'5beE'5d'5b'2d'2b'5d'3f'5cd'5b'5cd'5f'5d'2a'29'3f'5bfFL'5d'3fi'3f >>= withAttribute "Float"))
                        <|>
                        ((pDetectChar False '.' >>= withAttribute "Normal Text") >>~ pushContext "Properties")
                        <|>
                        ((lookAhead (pRegExpr regex_'5cd) >> return ([],"") ) >>~ pushContext "NumberLiteral")
                        <|>
                        ((pString False "#line" >>= withAttribute "Pragma") >>~ pushContext "LinePragma")
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Symbol"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Symbol"))
                        <|>
                        ((pAnyChar ":!%&()+,-/.*<=>?[]|~^;" >>= withAttribute "Symbol")))
     return (attr, result)

parseRules "StartingLetter" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((lookAhead (pRegExpr regex_'5b'5ea'2dzA'2dZ'5f'5d) >> return ([],"") ) >>~ (popContext))
                        <|>
                        ((pRegExpr regex_in'5cs'2a'28'3f'3d'5c'7b'29 >>= withAttribute "Statement"))
                        <|>
                        ((pRegExpr regex_out'5cs'2a'28'3f'3d'28'5c'28'28'5ba'2dzA'2dZ'5f'5d'5b'5cw'5f'5d'2a'29'3f'5c'29'5cs'2a'29'3f'5c'7b'29 >>= withAttribute "Statement"))
                        <|>
                        ((pRegExpr regex_scope'5cs'2a'28'3f'3d'5c'28'29 >>= withAttribute "Statement") >>~ pushContext "Scope")
                        <|>
                        ((pRegExpr regex_import'5cs'2a'28'3f'3d'5c'28'29 >>= withAttribute "Expression"))
                        <|>
                        ((pRegExpr regex_function'5cs'2a'28'3f'3d'5c'28'29 >>= withAttribute "Declarator"))
                        <|>
                        ((pRegExpr regex_delegate'5cs'2a'28'3f'3d'5c'28'29 >>= withAttribute "Declarator"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_statements >>= withAttribute "Statement"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_attributes >>= withAttribute "Attribute"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_expressions >>= withAttribute "Expression"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_declarators >>= withAttribute "Declarator"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_templates >>= withAttribute "Template"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_modules >>= withAttribute "Module") >>~ pushContext "ModuleName")
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_types >>= withAttribute "Type"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_libsymbols >>= withAttribute "LibrarySymbols"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_linkage >>= withAttribute "Linkage") >>~ pushContext "Linkage")
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_specialtokens >>= withAttribute "SpecialTokens"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_tests >>= withAttribute "Tests"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_pragma >>= withAttribute "Pragma") >>~ pushContext "Pragma")
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_version >>= withAttribute "Version") >>~ pushContext "Version")
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_deprecated >>= withAttribute "Deprecated"))
                        <|>
                        ((pDetect2Chars False 'r' '"' >>= withAttribute "RawString") >>~ pushContext "RawString")
                        <|>
                        ((pDetect2Chars False 'x' '"' >>= withAttribute "HexString") >>~ pushContext "HexString")
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_userkeywords >>= withAttribute "UserKeywords"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text")))
     return (attr, result)

parseRules "Properties" = 
  do (attr, result) <- (((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_properties >>= withAttribute "Property") >>~ (popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "NumberLiteral" = 
  do (attr, result) <- (((pRegExpr regex_0'5bxX'5d'5b'5cda'2dfA'2dF'5f'5d'2a'28'5c'2e'5b'5cda'2dfA'2dF'5f'5d'2a'29'3f'5bpP'5d'5b'2d'2b'5d'3f'5cd'5b'5cd'5f'5d'2a'5bfFL'5d'3fi'3f >>= withAttribute "Float") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5cd'5b'5f'5cd'5d'2a'28'5c'2e'28'3f'21'5c'2e'29'5b'5f'5cd'5d'2a'28'5beE'5d'5b'2d'2b'5d'3f'5cd'5b'5f'5cd'5d'2a'29'3f'5bfFL'5d'3fi'3f'7c'5beE'5d'5b'2d'2b'5d'3f'5cd'5b'5f'5cd'5d'2a'5bfFL'5d'3fi'3f'7c'5bfF'5di'3f'7c'5bfFL'5d'3fi'29 >>= withAttribute "Float") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_0'5bbB'5d'5f'2a'5b01'5d'5b01'5f'5d'2a'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f >>= withAttribute "Binary") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_0'5b0'2d7'5f'5d'2b'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f >>= withAttribute "Octal") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_0'5bxX'5d'5f'2a'5b'5cda'2dfA'2dF'5d'5b'5cda'2dfA'2dF'5f'5d'2a'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f >>= withAttribute "Hex") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5cd'2b'5b'5cd'5f'5d'2a'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f >>= withAttribute "Integer") >>~ (popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "LinePragma" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Pragma"))
                        <|>
                        ((pRegExpr regex_'28'280'28'5b0'2d7'5f'5d'2b'7c'5bbB'5d'5f'2a'5b01'5d'5b01'5f'5d'2a'7c'5bxX'5d'5f'2a'5b'5cda'2dfA'2dF'5d'5b'5cda'2dfA'2dF'5f'5d'2a'29'29'7c'5cd'2b'5b'5cd'5f'5d'2a'29'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f >>= withAttribute "Integer"))
                        <|>
                        ((pRegExpr regex_'22'5b'5e'22'5d'2a'22 >>= withAttribute "String"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_specialtokens >>= withAttribute "SpecialTokens"))
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((pRegExpr regex_'2e'2b >>= withAttribute "Error") >>~ (popContext)))
     return (attr, result)

parseRules "UnicodeShort" = 
  do (attr, result) <- ((pRegExpr regex_'5b'5cda'2dfA'2dF'5d'7b4'7d >>= withAttribute "EscapeSequence") >>~ (popContext))
     return (attr, result)

parseRules "UnicodeLong" = 
  do (attr, result) <- ((pRegExpr regex_'5b'5cda'2dfA'2dF'5d'7b8'7d >>= withAttribute "EscapeSequence") >>~ (popContext))
     return (attr, result)

parseRules "HTMLEntity" = 
  do (attr, result) <- (((pRegExpr regex_'5ba'2dzA'2dZ'5d'5cw'2b'3b >>= withAttribute "EscapeSequence") >>~ (popContext))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "ModuleName" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Module Name"))
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((lookAhead (pRegExpr regex_'5b'5e'5cs'5cw'2e'3a'2c'3d'5d) >> return ([],"") ) >>~ (popContext)))
     return (attr, result)

parseRules "Linkage" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Normal Text") >>~ pushContext "Linkage2")
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "Linkage2" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pString False "C++" >>= withAttribute "Linkage Type") >>~ (popContext >> popContext))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_ltypes >>= withAttribute "Linkage Type") >>~ (popContext >> popContext))
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Normal Text") >>~ (popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5b'5e'29'5cs'5cn'5d'2b >>= withAttribute "Error") >>~ (popContext >> popContext)))
     return (attr, result)

parseRules "Version" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '=' >>= withAttribute "Normal Text") >>~ pushContext "Version2")
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Normal Text") >>~ pushContext "Version2")
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((pRegExpr regex_'5b'5e'5cs'5cn'5d'2b >>= withAttribute "Error") >>~ (popContext)))
     return (attr, result)

parseRules "Version2" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_vtypes >>= withAttribute "Version Type") >>~ (popContext >> popContext))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text") >>~ (popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5cd'2b'5b'5cd'5f'5d'2a'28L'5buU'5d'3f'7c'5buU'5dL'3f'29'3f >>= withAttribute "Integer") >>~ (popContext >> popContext))
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Normal Text") >>~ (popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5b'5e'29'5cs'5cn'5d'2b >>= withAttribute "Error") >>~ (popContext >> popContext)))
     return (attr, result)

parseRules "Scope" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Normal Text") >>~ pushContext "Scope2")
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "Scope2" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_scope'5fkeywords >>= withAttribute "Expression") >>~ (popContext >> popContext))
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Normal Text") >>~ (popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5b'5e'29'5cs'5cn'5d'2b >>= withAttribute "Error") >>~ (popContext >> popContext)))
     return (attr, result)

parseRules "Pragma" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Pragma"))
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Normal Text") >>~ pushContext "Pragma2")
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((pRegExpr regex_'5b'5e'5cs'5cn'5d'2b >>= withAttribute "Error") >>~ (popContext)))
     return (attr, result)

parseRules "Pragma2" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Pragma"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_ptypes >>= withAttribute "Version Type") >>~ (popContext >> popContext))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text") >>~ (popContext >> popContext))
                        <|>
                        ((parseRules "CommentRules"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Normal Text") >>~ (popContext >> popContext))
                        <|>
                        ((pRegExpr regex_'5b'5e'29'5cs'5cn'5d'2b >>= withAttribute "Error") >>~ (popContext >> popContext)))
     return (attr, result)

parseRules "RawString" = 
  do (attr, result) <- ((pDetectChar False '"' >>= withAttribute "RawString") >>~ (popContext))
     return (attr, result)

parseRules "BQString" = 
  do (attr, result) <- ((pDetectChar False '`' >>= withAttribute "BQString") >>~ (popContext))
     return (attr, result)

parseRules "HexString" = 
  do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "HexString") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5b'5e'5csa'2dfA'2dF'5cd'22'5d'2b >>= withAttribute "Error")))
     return (attr, result)

parseRules "CharLiteral" = 
  do (attr, result) <- (((pDetectChar False '\'' >>= withAttribute "Char") >>~ (popContext))
                        <|>
                        ((pHlCStringChar >>= withAttribute "EscapeSequence") >>~ pushContext "CharLiteralClosing")
                        <|>
                        ((pRegExpr regex_'5c'5c'28u'5b'5cda'2dfA'2dF'5d'7b4'7d'7cU'5b'5cda'2dfA'2dF'5d'7b8'7d'7c'26'5ba'2dzA'2dZ'5d'5cw'2b'3b'29 >>= withAttribute "EscapeSequence") >>~ pushContext "CharLiteralClosing")
                        <|>
                        ((pRegExpr regex_'5c'5c'2e >>= withAttribute "Error") >>~ pushContext "CharLiteralClosing")
                        <|>
                        ((pRegExpr regex_'2e >>= withAttribute "Char") >>~ pushContext "CharLiteralClosing")
                        <|>
                        ((popContext) >> return ([], "")))
     return (attr, result)

parseRules "CharLiteralClosing" = 
  do (attr, result) <- (((pDetectChar False '\'' >>= withAttribute "Char") >>~ (popContext >> popContext))
                        <|>
                        ((popContext >> popContext) >> return ([], "")))
     return (attr, result)

parseRules "String" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "EscapeSequence"))
                        <|>
                        ((pDetect2Chars False '"' 'c' >>= withAttribute "String") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '"' 'w' >>= withAttribute "String") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '"' 'd' >>= withAttribute "String") >>~ (popContext))
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "String") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '\\' 'u' >>= withAttribute "EscapeSequence") >>~ pushContext "UnicodeShort")
                        <|>
                        ((pDetect2Chars False '\\' 'U' >>= withAttribute "EscapeSequence") >>~ pushContext "UnicodeLong")
                        <|>
                        ((pDetect2Chars False '\\' '&' >>= withAttribute "EscapeSequence") >>~ pushContext "HTMLEntity"))
     return (attr, result)

parseRules "CommentRules" = 
  do (attr, result) <- (((parseRules "DdocNormal"))
                        <|>
                        ((pDetect2Chars False '/' '/' >>= withAttribute "Comment") >>~ pushContext "CommentLine")
                        <|>
                        ((pDetect2Chars False '/' '*' >>= withAttribute "Comment") >>~ pushContext "CommentBlock")
                        <|>
                        ((pDetect2Chars False '/' '+' >>= withAttribute "Comment") >>~ pushContext "CommentNested"))
     return (attr, result)

parseRules "Region Marker" = 
  pzero

parseRules "CommentLine" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Comment"))
                        <|>
                        ((Text.Highlighting.Kate.Syntax.Alert.parseExpression)))
     return (attr, result)

parseRules "CommentBlock" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Comment"))
                        <|>
                        ((pDetect2Chars False '*' '/' >>= withAttribute "Comment") >>~ (popContext))
                        <|>
                        ((Text.Highlighting.Kate.Syntax.Alert.parseExpression)))
     return (attr, result)

parseRules "CommentNested" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Comment"))
                        <|>
                        ((pDetect2Chars False '/' '+' >>= withAttribute "Comment") >>~ pushContext "CommentNested")
                        <|>
                        ((pDetect2Chars False '+' '/' >>= withAttribute "Comment") >>~ (popContext))
                        <|>
                        ((Text.Highlighting.Kate.Syntax.Alert.parseExpression)))
     return (attr, result)

parseRules "DdocNormal" = 
  do (attr, result) <- (((pRegExpr regex_'2f'7b3'2c'7d >>= withAttribute "Comment") >>~ pushContext "DdocLine")
                        <|>
                        ((pRegExpr regex_'2f'5c'2a'7b2'2c'7d'28'3f'21'2f'29 >>= withAttribute "Comment") >>~ pushContext "DdocBlock")
                        <|>
                        ((pRegExpr regex_'2f'5c'2b'7b2'2c'7d'28'3f'21'2f'29 >>= withAttribute "Comment") >>~ pushContext "DdocNested"))
     return (attr, result)

parseRules "DdocLine" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Ddoc"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Ddoc"))
                        <|>
                        ((pDetect2Chars False '$' '(' >>= withAttribute "Macros") >>~ pushContext "DdocMacro")
                        <|>
                        ((pRegExpr regex_'5b'5cw'5f'5d'2b'3a'28'24'7c'5cs'29 >>= withAttribute "DdocSection"))
                        <|>
                        ((Text.Highlighting.Kate.Syntax.Alert.parseExpression)))
     return (attr, result)

parseRules "DdocBlock" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Ddoc"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Ddoc"))
                        <|>
                        ((pRegExpr regex_'5c'2a'2b'2f >>= withAttribute "Comment") >>~ (popContext))
                        <|>
                        ((pFirstNonSpace >> pDetectChar False '*' >>= withAttribute "Comment"))
                        <|>
                        ((pDetect2Chars False '$' '(' >>= withAttribute "Macros") >>~ pushContext "DdocMacro")
                        <|>
                        ((pRegExpr regex_'5b'5cw'5f'5d'2b'3a'28'24'7c'5cs'29 >>= withAttribute "DdocSection"))
                        <|>
                        ((Text.Highlighting.Kate.Syntax.Alert.parseExpression))
                        <|>
                        ((pRegExpr regex_'5b'5e'2d'5d'2d'7b3'2c'7d >>= withAttribute "Ddoc"))
                        <|>
                        ((pRegExpr regex_'2d'7b3'2c'7d'28'24'7c'5cs'29 >>= withAttribute "Comment") >>~ pushContext "DdocBlockCode"))
     return (attr, result)

parseRules "DdocNested" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Ddoc"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Ddoc"))
                        <|>
                        ((pDetect2Chars False '/' '+' >>= withAttribute "Ddoc") >>~ pushContext "DdocNested2")
                        <|>
                        ((pRegExpr regex_'5c'2b'2b'2f >>= withAttribute "Comment") >>~ (popContext))
                        <|>
                        ((pFirstNonSpace >> pDetectChar False '+' >>= withAttribute "Comment"))
                        <|>
                        ((pDetect2Chars False '$' '(' >>= withAttribute "Macros") >>~ pushContext "DdocMacro")
                        <|>
                        ((pRegExpr regex_'5b'5cw'5f'5d'2b'3a'28'24'7c'5cs'29 >>= withAttribute "DdocSection"))
                        <|>
                        ((Text.Highlighting.Kate.Syntax.Alert.parseExpression))
                        <|>
                        ((pRegExpr regex_'5b'5e'2d'5d'2d'7b3'2c'7d >>= withAttribute "Ddoc"))
                        <|>
                        ((pRegExpr regex_'2d'7b3'2c'7d'28'24'7c'5cs'29 >>= withAttribute "Comment") >>~ pushContext "DdocNestedCode"))
     return (attr, result)

parseRules "DdocNested2" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Ddoc"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Ddoc"))
                        <|>
                        ((pRegExpr regex_'5c'2b'2b'2f >>= withAttribute "Ddoc") >>~ (popContext))
                        <|>
                        ((parseRules "DdocNested")))
     return (attr, result)

parseRules "DdocMacro" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Macro Text"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Macros") >>~ (popContext))
                        <|>
                        ((parseRules "MacroRules"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Macros") >>~ pushContext "DdocMacro2"))
     return (attr, result)

parseRules "DdocMacro2" = 
  do (attr, result) <- (((pDetectChar False ')' >>= withAttribute "Macros") >>~ (popContext >> popContext))
                        <|>
                        ((parseRules "MacroRules")))
     return (attr, result)

parseRules "DdocMacro3" = 
  do (attr, result) <- (((pDetectChar False ')' >>= withAttribute "Macro Text") >>~ (popContext))
                        <|>
                        ((parseRules "MacroRules")))
     return (attr, result)

parseRules "MacroRules" = 
  do (attr, result) <- (((pDetect2Chars False '$' '(' >>= withAttribute "Macros") >>~ pushContext "DdocMacro")
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Macro Text") >>~ pushContext "DdocMacro3")
                        <|>
                        ((pFirstNonSpace >> pDetectChar False '*' >>= withAttribute "Comment")))
     return (attr, result)

parseRules "DdocBlockCode" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "DdocCode"))
                        <|>
                        ((pRegExpr regex_'5c'2a'2b'2f >>= withAttribute "Comment") >>~ (popContext >> popContext))
                        <|>
                        ((pFirstNonSpace >> pDetectChar False '*' >>= withAttribute "Comment"))
                        <|>
                        ((pRegExpr regex_'5b'5e'2d'5d'2d'7b3'2c'7d >>= withAttribute "DdocCode"))
                        <|>
                        ((pRegExpr regex_'2d'7b3'2c'7d'28'24'7c'5cs'29 >>= withAttribute "Comment") >>~ (popContext))
                        <|>
                        ((Text.Highlighting.Kate.Syntax.D.parseExpression)))
     return (attr, result)

parseRules "DdocNestedCode" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "DdocCode"))
                        <|>
                        ((pRegExpr regex_'5c'2b'2b'2f >>= withAttribute "Comment") >>~ (popContext >> popContext))
                        <|>
                        ((pFirstNonSpace >> pDetectChar False '+' >>= withAttribute "Comment"))
                        <|>
                        ((pRegExpr regex_'5b'5e'2d'5d'2d'7b3'2c'7d >>= withAttribute "DdocCode"))
                        <|>
                        ((pRegExpr regex_'2d'7b3'2c'7d'28'24'7c'5cs'29 >>= withAttribute "Comment") >>~ (popContext))
                        <|>
                        ((Text.Highlighting.Kate.Syntax.D.parseExpression)))
     return (attr, result)

parseRules x = fail $ "Unknown context" ++ x