{- This module was generated from data in the Kate syntax highlighting file mediawiki.xml, version 1.11, by -} module Text.Highlighting.Kate.Syntax.Mediawiki (highlight, parseExpression, syntaxName, syntaxExtensions) where import Text.Highlighting.Kate.Types import Text.Highlighting.Kate.Common import qualified Text.Highlighting.Kate.Syntax.Javascript import Text.ParserCombinators.Parsec hiding (State) import Control.Monad.State import Data.Char (isSpace) -- | Full name of language. syntaxName :: String syntaxName = "MediaWiki" -- | Filename extensions for this language. syntaxExtensions :: String syntaxExtensions = "*.mediawiki" -- | Highlight source code using this syntax definition. highlight :: String -> [SourceLine] highlight input = evalState (mapM parseSourceLine $ lines input) startingState parseSourceLine :: String -> State SyntaxState SourceLine parseSourceLine = mkParseSourceLine (parseExpression Nothing) -- | Parse an expression using appropriate local context. parseExpression :: Maybe (String,String) -> KateParser Token parseExpression mbcontext = do (lang,cont) <- maybe currentContext return mbcontext result <- parseRules (lang,cont) optional $ do eof updateState $ \st -> st{ synStPrevChar = '\n' } pEndLine return result startingState = SyntaxState {synStContexts = [("MediaWiki","normal")], synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStContinuation = False, synStCaseSensitive = True, synStKeywordCaseSensitive = False, synStCaptures = []} pEndLine = do updateState $ \st -> st{ synStPrevNonspace = False } context <- currentContext contexts <- synStContexts `fmap` getState st <- getState if length contexts >= 2 then case context of _ | synStContinuation st -> updateState $ \st -> st{ synStContinuation = False } ("MediaWiki","normal") -> return () ("MediaWiki","TableHeader") -> pushContext ("MediaWiki","TableContent") >> return () ("MediaWiki","TableContent") -> return () ("MediaWiki","Section5") -> (popContext) >> pEndLine ("MediaWiki","Section4") -> (popContext) >> pEndLine ("MediaWiki","Section3") -> (popContext) >> pEndLine ("MediaWiki","Section2") -> (popContext) >> pEndLine ("MediaWiki","comment") -> return () ("MediaWiki","DelimitedURL") -> return () ("MediaWiki","DelimitedUrlLink") -> return () ("MediaWiki","LooseURL") -> (popContext) >> pEndLine ("MediaWiki","LooseURLWithinTemplate") -> (popContext) >> pEndLine ("MediaWiki","URLTag") -> return () ("MediaWiki","WikiLinkWithoutDescriptionRules") -> return () ("MediaWiki","WikiLinkWithDescriptionRules") -> return () ("MediaWiki","WikiLink") -> return () ("MediaWiki","WikiLinkBoldWithDescription") -> return () ("MediaWiki","WikiLinkBoldWithoutDescription") -> return () ("MediaWiki","WikiLinkItalicWithDescription") -> return () ("MediaWiki","WikiLinkItalicWithoutDescription") -> return () ("MediaWiki","WikiLinkUnderlinedWithDescription") -> return () ("MediaWiki","WikiLinkUnderlinedWithoutDescription") -> return () ("MediaWiki","WikiLinkBoldItalicWithDescription") -> return () ("MediaWiki","WikiLinkBoldItalicWithoutDescription") -> return () ("MediaWiki","WikiLinkBoldUnderlinedWithDescription") -> return () ("MediaWiki","WikiLinkBoldUnderlinedWithoutDescription") -> return () ("MediaWiki","WikiLinkItalicUnderlinedWithDescription") -> return () ("MediaWiki","WikiLinkItalicUnderlinedWithoutDescription") -> return () ("MediaWiki","WikiLinkBoldItalicUnderlinedWithDescription") -> return () ("MediaWiki","WikiLinkBoldItalicUnderlinedWithoutDescription") -> return () ("MediaWiki","WikiLinkDescriptionRules") -> return () ("MediaWiki","WikiLinkDescription") -> return () ("MediaWiki","WikiLinkDescriptionBold") -> return () ("MediaWiki","WikiLinkDescriptionItalic") -> return () ("MediaWiki","WikiLinkDescriptionUnderlined") -> return () ("MediaWiki","WikiLinkDescriptionBoldItalic") -> return () ("MediaWiki","WikiLinkDescriptionBoldUnderlined") -> return () ("MediaWiki","WikiLinkDescriptionItalicUnderlined") -> return () ("MediaWiki","WikiLinkDescriptionBoldItalicUnderlined") -> return () ("MediaWiki","Template") -> return () ("MediaWiki","TemplateParameterSlot") -> return () ("MediaWiki","TemplateParameterSlotEqual") -> return () ("MediaWiki","TemplateParameterSlotValue") -> return () ("MediaWiki","TemplateParameter") -> return () ("MediaWiki","NoWiki") -> return () ("MediaWiki","Unformatted") -> (popContext) >> pEndLine ("MediaWiki","Pre") -> return () ("MediaWiki","SourceStartTag") -> return () ("MediaWiki","SyntaxHighlightStartTag") -> return () ("MediaWiki","UnsupportedLanguageSourceStartTag") -> return () ("MediaWiki","UnsupportedLanguageSyntaxHighlightStartTag") -> return () ("MediaWiki","JavaScriptSourceStartTag") -> return () ("MediaWiki","JavaScriptSyntaxHighlightStartTag") -> return () ("MediaWiki","UnsupportedLanguageSourceContent") -> return () ("MediaWiki","UnsupportedLanguageSyntaxHighlightContent") -> return () ("MediaWiki","JavaScriptSourceContent") -> return () ("MediaWiki","JavaScriptSyntaxHighlightContent") -> return () ("MediaWiki","SourceEnd") -> return () ("MediaWiki","SyntaxHighlightEnd") -> return () ("MediaWiki","HtmlAttribute") -> return () ("MediaWiki","HtmlValue") -> return () ("MediaWiki","ValueWithDoubleQuotes") -> return () ("MediaWiki","ValueWithSingleQuotes") -> return () ("MediaWiki","DefinitionListHeader") -> (popContext) >> pEndLine ("MediaWiki","Bold") -> (popContext) >> pEndLine ("MediaWiki","Italic") -> (popContext) >> pEndLine ("MediaWiki","Underlined") -> return () ("MediaWiki","BoldItalic") -> (popContext) >> pEndLine ("MediaWiki","ItalicBold") -> (popContext) >> pEndLine ("MediaWiki","BoldUnderlined") -> (popContext) >> pEndLine ("MediaWiki","UnderlinedBold") -> (popContext) >> pEndLine ("MediaWiki","ItalicUnderlined") -> (popContext) >> pEndLine ("MediaWiki","UnderlinedItalic") -> (popContext) >> pEndLine ("MediaWiki","BoldItalicUnderlined") -> (popContext) >> pEndLine ("MediaWiki","BoldUnderlinedItalic") -> (popContext) >> pEndLine ("MediaWiki","ItalicUnderlinedBold") -> (popContext) >> pEndLine ("MediaWiki","FindHtmlEntities") -> return () ("MediaWiki","FindHtmlStartTagAttributes") -> return () ("MediaWiki","FindListItem") -> return () ("MediaWiki","FindSyntaxHighlightingHtmlElement") -> return () ("MediaWiki","FindTable") -> return () ("MediaWiki","FindTemplate") -> return () ("MediaWiki","FindTextDecorations") -> return () ("MediaWiki","FindTextDecorationsInHeader") -> return () ("MediaWiki","FindUrl") -> return () ("MediaWiki","FindUrlWithinTemplate") -> return () ("MediaWiki","FindWikiLink") -> return () ("MediaWiki","FindWikiLinkBeingBold") -> return () ("MediaWiki","FindWikiLinkBeingItalic") -> return () ("MediaWiki","FindWikiLinkBeingUnderlined") -> return () ("MediaWiki","FindWikiLinkBeingBoldItalic") -> return () ("MediaWiki","FindWikiLinkBeingBoldUnderlined") -> return () ("MediaWiki","FindWikiLinkBeingItalicUnderlined") -> return () ("MediaWiki","FindWikiLinkBeingBoldItalicUnderlined") -> return () _ -> return () else return () withAttribute attr txt = do when (null txt) $ fail "Parser matched no text" updateState $ \st -> st { synStPrevChar = last txt , synStPrevNonspace = synStPrevNonspace st || not (all isSpace txt) } return (attr, txt) regex_'5b'3d'5d'7b5'2c5'7d'28'3f'21'3d'29 = compileRegex True "[=]{5,5}(?!=)" regex_'5b'3d'5d'7b4'2c4'7d'28'3f'21'3d'29 = compileRegex True "[=]{4,4}(?!=)" regex_'5b'3d'5d'7b3'2c3'7d'28'3f'21'3d'29 = compileRegex True "[=]{3,3}(?!=)" regex_'5b'3d'5d'7b2'2c2'7d'28'3f'21'3d'29 = compileRegex True "[=]{2,2}(?!=)" regex_'5b'7e'5d'7b3'2c4'7d = compileRegex True "[~]{3,4}" regex_'5b'3c'5d'5b'5e'3e'5d'2b'5b'3e'5d = compileRegex True "[<][^>]+[>]" regex_'5b'5cs'5d = compileRegex True "[\\s]" regex_'5b'2d'5d'7b4'2c'7d = compileRegex True "[-]{4,}" regex_'3d'7b6'2c'7d_'2a'24 = compileRegex True "={6,} *$" regex_'3d'7b5'2c5'7d_'2a'24 = compileRegex True "={5,5} *$" regex_'3d'7b1'2c4'7d_'2a'24 = compileRegex True "={1,4} *$" regex_'3d'2a'5b'5e'3d'5d'2b'24 = compileRegex True "=*[^=]+$" regex_'3d'7b5'2c'7d_'2a'24 = compileRegex True "={5,} *$" regex_'3d'7b4'2c4'7d_'2a'24 = compileRegex True "={4,4} *$" regex_'3d'7b1'2c3'7d_'2a'24 = compileRegex True "={1,3} *$" regex_'3d'7b4'2c'7d_'2a'24 = compileRegex True "={4,} *$" regex_'3d'7b3'2c3'7d_'2a'24 = compileRegex True "={3,3} *$" regex_'3d'7b1'2c2'7d_'2a'24 = compileRegex True "={1,2} *$" regex_'3d'7b3'2c'7d_'2a'24 = compileRegex True "={3,} *$" regex_'3d'7b2'2c2'7d_'2a'24 = compileRegex True "={2,2} *$" regex_'3d'7b1'2c1'7d_'2a'24 = compileRegex True "={1,1} *$" regex_'28http'3a'7chttps'3a'7cftp'3a'7cmailto'3a'29'5b'5e'5d'7c_'5d'2a'28'3f'3d'24'7c'5b'5d'7c'5cs'5d'29 = compileRegex True "(http:|https:|ftp:|mailto:)[^]| ]*(?=$|[]|\\s])" regex_'3cu_'2a'3e = compileRegex True "" regex_'5b'5e'7b'7d'7c'3d'5d'2b'28'3f'3d'5b'3d'5d'29 = compileRegex True "[^{}|=]+(?=[=])" regex_'3c'21'2d'2d'5b'5e'2d'5d'2a'2d'2d'3e = compileRegex True "" regex_'28'5e'7c'5cs'2b'29lang'5c'3d'28'22javascript'22'7c'27javascript'27'29 = compileRegex True "(^|\\s+)lang\\=(\"javascript\"|'javascript')" regex_'5cS = compileRegex True "\\S" regex_'3c'2fu_'2a'3e = compileRegex True "" regex_'26'28'23'5b0'2d9'5d'2b'7c'23'5bxX'5d'5b0'2d9A'2dFa'2df'5d'2b'7c'28'3f'21'5b0'2d9'5d'29'5b'5cw'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a'29'3b = compileRegex True "&(#[0-9]+|#[xX][0-9A-Fa-f]+|(?![0-9])[\\w_:][\\w.:_-]*);" regex_'28'3f'21'5b0'2d9'5d'29'5b'5cw'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a = compileRegex True "(?![0-9])[\\w_:][\\w.:_-]*" regex_'5cs'2b'28'3f'21'5b0'2d9'5d'29'5b'5cw'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a = compileRegex True "\\s+(?![0-9])[\\w_:][\\w.:_-]*" regex_'5b'2a'23'3b'3a'5cs'5d'2a'5b'2a'23'3a'5d'2b = compileRegex True "[*#;:\\s]*[*#:]+" regex_'3csource'28'3f'3d'5cs'29 = compileRegex True ">= withAttribute CommentTok) >>~ pushContext ("MediaWiki","comment")) <|> ((pColumn 0 >> pRegExpr regex_'5b'3d'5d'7b5'2c5'7d'28'3f'21'3d'29 >>= withAttribute KeywordTok) >>~ pushContext ("MediaWiki","Section5")) <|> ((pColumn 0 >> pRegExpr regex_'5b'3d'5d'7b4'2c4'7d'28'3f'21'3d'29 >>= withAttribute KeywordTok) >>~ pushContext ("MediaWiki","Section4")) <|> ((pColumn 0 >> pRegExpr regex_'5b'3d'5d'7b3'2c3'7d'28'3f'21'3d'29 >>= withAttribute KeywordTok) >>~ pushContext ("MediaWiki","Section3")) <|> ((pColumn 0 >> pRegExpr regex_'5b'3d'5d'7b2'2c2'7d'28'3f'21'3d'29 >>= withAttribute KeywordTok) >>~ pushContext ("MediaWiki","Section2")) <|> ((pRegExpr regex_'5b'7e'5d'7b3'2c4'7d >>= withAttribute DecValTok)) <|> ((pColumn 0 >> pDetectChar False ';' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","DefinitionListHeader")) <|> ((parseRules ("MediaWiki","FindListItem"))) <|> ((parseRules ("MediaWiki","FindUrl"))) <|> ((parseRules ("MediaWiki","FindTextDecorations"))) <|> ((parseRules ("MediaWiki","FindTable"))) <|> ((pString False "{{{" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","TemplateParameter")) <|> ((parseRules ("MediaWiki","FindTemplate"))) <|> ((parseRules ("MediaWiki","FindWikiLink"))) <|> ((parseRules ("MediaWiki","FindHtmlEntities"))) <|> ((pString False "" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","NoWiki")) <|> ((pString False "
" >>= withAttribute KeywordTok) >>~ pushContext ("MediaWiki","Pre"))
   <|>
   ((parseRules ("MediaWiki","FindSyntaxHighlightingHtmlElement")))
   <|>
   ((pRegExpr regex_'5b'3c'5d'5b'5e'3e'5d'2b'5b'3e'5d >>= withAttribute KeywordTok))
   <|>
   ((pColumn 0 >> pRegExpr regex_'5b'5cs'5d >>= withAttribute NormalTok) >>~ pushContext ("MediaWiki","Unformatted"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","normal")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","TableHeader") =
  (((pDetect2Chars False '{' '|' >>= withAttribute DecValTok))
   <|>
   ((parseRules ("MediaWiki","FindHtmlStartTagAttributes")))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","TableHeader")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","TableContent") =
  (((pString False "" >>= withAttribute CommentTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","comment")) >> pDefault >>= withAttribute CommentTok))

parseRules ("MediaWiki","DelimitedURL") =
  (((pDetectChar False ']' >>= withAttribute DecValTok) >>~ (popContext))
   <|>
   ((pDetectChar False '[' >>= withAttribute DecValTok))
   <|>
   ((lookAhead (pRegExpr regex_'28http'3a'7chttps'3a'7cftp'3a'7cmailto'3a'29'5b'5e'5d'7c_'5d'2a'28'3f'3d'24'7c'5b'5d'7c'5cs'5d'29) >> pushContext ("MediaWiki","DelimitedUrlLink") >> currentContext >>= parseRules))
   <|>
   ((pDetectChar False ' ' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","URLTag"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","DelimitedURL")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","DelimitedUrlLink") =
  (((parseRules ("MediaWiki","FindTemplate")))
   <|>
   ((lookAhead (pDetectChar False ' ') >> (popContext) >> currentContext >>= parseRules))
   <|>
   ((lookAhead (pDetectChar False ']') >> (popContext) >> currentContext >>= parseRules))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","DelimitedUrlLink")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","LooseURL") =
  (((parseRules ("MediaWiki","FindTemplate")))
   <|>
   ((pDetectChar False ' ' >>= withAttribute DecValTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","LooseURL")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","LooseURLWithinTemplate") =
  (((parseRules ("MediaWiki","FindTemplate")))
   <|>
   ((lookAhead (pDetect2Chars False '}' '}') >> (popContext) >> currentContext >>= parseRules))
   <|>
   ((pDetectChar False ' ' >>= withAttribute DecValTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","LooseURLWithinTemplate")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","URLTag") =
  (((parseRules ("MediaWiki","FindTextDecorations")))
   <|>
   ((parseRules ("MediaWiki","FindTemplate")))
   <|>
   ((lookAhead (pDetectChar False ']') >> (popContext) >> currentContext >>= parseRules))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","URLTag")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules") =
  (((parseRules ("MediaWiki","FindTemplate")))
   <|>
   ((parseRules ("MediaWiki","FindHtmlEntities")))
   <|>
   ((pDetect2Chars False '[' '[' >>= withAttribute DecValTok))
   <|>
   ((pDetect2Chars False ']' ']' >>= withAttribute DecValTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkWithoutDescriptionRules")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkWithDescriptionRules") =
  (((parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules")))
   <|>
   ((pDetectChar False '#' >>= withAttribute DecValTok))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkWithDescriptionRules")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLink") =
  (((parseRules ("MediaWiki","WikiLinkWithDescriptionRules")))
   <|>
   ((pDetectChar False '|' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","WikiLinkDescription"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLink")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkBoldWithDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithDescriptionRules")))
   <|>
   ((pDetectChar False '|' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","WikiLinkDescriptionBold"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkBoldWithDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkBoldWithoutDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules")))
   <|>
   ((pDetectChar False '#' >>= withAttribute DecValTok))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkBoldWithoutDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkItalicWithDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithDescriptionRules")))
   <|>
   ((pDetectChar False '|' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","WikiLinkDescriptionItalic"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkItalicWithDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkItalicWithoutDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules")))
   <|>
   ((pDetectChar False '#' >>= withAttribute DecValTok))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkItalicWithoutDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkUnderlinedWithDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithDescriptionRules")))
   <|>
   ((pDetectChar False '|' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","WikiLinkDescriptionUnderlined"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkUnderlinedWithDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkUnderlinedWithoutDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules")))
   <|>
   ((pDetectChar False '#' >>= withAttribute DecValTok))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkUnderlinedWithoutDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkBoldItalicWithDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithDescriptionRules")))
   <|>
   ((pDetectChar False '|' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","WikiLinkDescriptionBoldItalic"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkBoldItalicWithDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkBoldItalicWithoutDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules")))
   <|>
   ((pDetectChar False '#' >>= withAttribute DecValTok))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkBoldItalicWithoutDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkBoldUnderlinedWithDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithDescriptionRules")))
   <|>
   ((pDetectChar False '|' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","WikiLinkDescriptionBoldUnderlined"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkBoldUnderlinedWithDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkBoldUnderlinedWithoutDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules")))
   <|>
   ((pDetectChar False '#' >>= withAttribute DecValTok))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkBoldUnderlinedWithoutDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkItalicUnderlinedWithDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithDescriptionRules")))
   <|>
   ((pDetectChar False '|' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","WikiLinkDescriptionItalicUnderlined"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkItalicUnderlinedWithDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkItalicUnderlinedWithoutDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules")))
   <|>
   ((pDetectChar False '#' >>= withAttribute DecValTok))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkItalicUnderlinedWithoutDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkBoldItalicUnderlinedWithDescription") =
  (((parseRules ("MediaWiki","WikiLinkWithDescriptionRules")))
   <|>
   ((pDetectChar False '|' >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","WikiLinkDescriptionBoldItalicUnderlined"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkBoldItalicUnderlinedWithDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkBoldItalicUnderlinedWithoutDescription") =
  (((pDetectChar False '#' >>= withAttribute DecValTok))
   <|>
   ((parseRules ("MediaWiki","WikiLinkWithoutDescriptionRules")))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkBoldItalicUnderlinedWithoutDescription")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","WikiLinkDescriptionRules") =
  (((parseRules ("MediaWiki","FindTemplate")))
   <|>
   ((parseRules ("MediaWiki","FindHtmlEntities")))
   <|>
   ((lookAhead (pDetect2Chars False ']' ']') >> (popContext) >> currentContext >>= parseRules))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescriptionRules")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkDescription") =
  (((parseRules ("MediaWiki","WikiLinkDescriptionRules")))
   <|>
   ((parseRules ("MediaWiki","FindTextDecorations")))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescription")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkDescriptionBold") =
  (((parseRules ("MediaWiki","WikiLinkDescriptionRules")))
   <|>
   ((pString False "''" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","BoldItalic"))
   <|>
   ((pRegExpr regex_'3cu_'2a'3e >>= withAttribute KeywordTok) >>~ pushContext ("MediaWiki","BoldUnderlined"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescriptionBold")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkDescriptionItalic") =
  (((parseRules ("MediaWiki","WikiLinkDescriptionRules")))
   <|>
   ((pString False "'''" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","ItalicBold"))
   <|>
   ((pRegExpr regex_'3cu_'2a'3e >>= withAttribute KeywordTok) >>~ pushContext ("MediaWiki","ItalicUnderlined"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescriptionItalic")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkDescriptionUnderlined") =
  (((parseRules ("MediaWiki","WikiLinkDescriptionRules")))
   <|>
   ((pString False "'''" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","UnderlinedBold"))
   <|>
   ((pString False "''" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","UnderlinedItalic"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescriptionUnderlined")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkDescriptionBoldItalic") =
  (((parseRules ("MediaWiki","WikiLinkDescriptionRules")))
   <|>
   ((pRegExpr regex_'3cu_'2a'3e >>= withAttribute KeywordTok) >>~ pushContext ("MediaWiki","BoldItalicUnderlined"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescriptionBoldItalic")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkDescriptionBoldUnderlined") =
  (((parseRules ("MediaWiki","WikiLinkDescriptionRules")))
   <|>
   ((pString False "''" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","BoldUnderlinedItalic"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescriptionBoldUnderlined")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkDescriptionItalicUnderlined") =
  (((parseRules ("MediaWiki","WikiLinkDescriptionRules")))
   <|>
   ((pString False "'''" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","ItalicUnderlinedBold"))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescriptionItalicUnderlined")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","WikiLinkDescriptionBoldItalicUnderlined") =
  (((parseRules ("MediaWiki","WikiLinkDescriptionRules")))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","WikiLinkDescriptionBoldItalicUnderlined")) >> pDefault >>= withAttribute NormalTok))

parseRules ("MediaWiki","Template") =
  (((pString False "|" >>= withAttribute DecValTok) >>~ pushContext ("MediaWiki","TemplateParameterSlot"))
   <|>
   ((pDetect2Chars False '}' '}' >>= withAttribute DecValTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("MediaWiki","Template")) >> pDefault >>= withAttribute OtherTok))

parseRules ("MediaWiki","TemplateParameterSlot") =
  (((lookAhead (pDetect2Chars False '}' '}') >> (popContext) >> currentContext >>= parseRules))
   <|>
   ((pString False "