{- This module was generated from data in the Kate syntax highlighting file ruby.xml, version 2, by Stefan Lang (langstefan@gmx.at), Sebastian Vuorinen (sebastian.vuorinen@helsinki.fi), Robin Pedersen (robinpeder@gmail.com), Miquel Sabaté (mikisabate@gmail.com) -} module Text.Highlighting.Kate.Syntax.Ruby (highlight, parseExpression, syntaxName, syntaxExtensions) where import Text.Highlighting.Kate.Types import Text.Highlighting.Kate.Common import qualified Text.Highlighting.Kate.Syntax.Alert import Text.ParserCombinators.Parsec hiding (State) import Control.Monad.State import Data.Char (isSpace) import qualified Data.Set as Set -- | Full name of language. syntaxName :: String syntaxName = "Ruby" -- | Filename extensions for this language. syntaxExtensions :: String syntaxExtensions = "*.rb;*.rjs;*.rxml;*.xml.erb;*.js.erb;*.rake;Rakefile;Gemfile;*.gemspec;Vagrantfile" -- | 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 = [("Ruby","Normal")], synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStContinuation = False, synStCaseSensitive = True, synStKeywordCaseSensitive = True, 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 } ("Ruby","Normal") -> return () ("Ruby","check_div_1") -> (popContext) >> pEndLine ("Ruby","check_div_1_pop") -> (popContext >> popContext) >> pEndLine ("Ruby","check_div_2") -> (popContext) >> pEndLine ("Ruby","check_div_2_internal") -> (popContext >> popContext) >> pEndLine ("Ruby","check_div_2_pop") -> (popContext >> popContext) >> pEndLine ("Ruby","check_div_2_pop_internal") -> (popContext >> popContext >> popContext) >> pEndLine ("Ruby","Line Continue") -> (popContext) >> pEndLine ("Ruby","Find closing block brace") -> return () ("Ruby","Quoted String") -> return () ("Ruby","Apostrophed String") -> return () ("Ruby","Command String") -> return () ("Ruby","Embedded documentation") -> return () ("Ruby","RegEx 1") -> return () ("Ruby","Subst") -> return () ("Ruby","Short Subst") -> (popContext) >> pEndLine ("Ruby","Member Access") -> (popContext) >> pEndLine ("Ruby","Comment Line") -> (popContext) >> pEndLine ("Ruby","General Comment") -> (popContext) >> pEndLine ("Ruby","RDoc Label") -> (popContext) >> pEndLine ("Ruby","find_heredoc") -> (popContext) >> pEndLine ("Ruby","find_indented_heredoc") -> (popContext) >> pEndLine ("Ruby","indented_heredoc") -> return () ("Ruby","apostrophed_indented_heredoc") -> return () ("Ruby","normal_heredoc") -> return () ("Ruby","apostrophed_normal_heredoc") -> return () ("Ruby","heredoc_rules") -> return () ("Ruby","find_gdl_input") -> (popContext) >> pEndLine ("Ruby","gdl_dq_string_1") -> return () ("Ruby","gdl_dq_string_1_nested") -> return () ("Ruby","gdl_dq_string_2") -> return () ("Ruby","gdl_dq_string_2_nested") -> return () ("Ruby","gdl_dq_string_3") -> return () ("Ruby","gdl_dq_string_3_nested") -> return () ("Ruby","gdl_dq_string_4") -> return () ("Ruby","gdl_dq_string_4_nested") -> return () ("Ruby","gdl_dq_string_5") -> return () ("Ruby","dq_string_rules") -> return () ("Ruby","gdl_token_array_1") -> return () ("Ruby","gdl_token_array_1_nested") -> return () ("Ruby","gdl_token_array_2") -> return () ("Ruby","gdl_token_array_2_nested") -> return () ("Ruby","gdl_token_array_3") -> return () ("Ruby","gdl_token_array_3_nested") -> return () ("Ruby","gdl_token_array_4") -> return () ("Ruby","gdl_token_array_4_nested") -> return () ("Ruby","gdl_token_array_5") -> return () ("Ruby","token_array_rules") -> return () ("Ruby","gdl_apostrophed_1") -> return () ("Ruby","gdl_apostrophed_1_nested") -> return () ("Ruby","gdl_apostrophed_2") -> return () ("Ruby","gdl_apostrophed_2_nested") -> return () ("Ruby","gdl_apostrophed_3") -> return () ("Ruby","gdl_apostrophed_3_nested") -> return () ("Ruby","gdl_apostrophed_4") -> return () ("Ruby","gdl_apostrophed_4_nested") -> return () ("Ruby","gdl_apostrophed_5") -> return () ("Ruby","apostrophed_rules") -> return () ("Ruby","gdl_shell_command_1") -> return () ("Ruby","gdl_shell_command_1_nested") -> return () ("Ruby","gdl_shell_command_2") -> return () ("Ruby","gdl_shell_command_2_nested") -> return () ("Ruby","gdl_shell_command_3") -> return () ("Ruby","gdl_shell_command_3_nested") -> return () ("Ruby","gdl_shell_command_4") -> return () ("Ruby","gdl_shell_command_4_nested") -> return () ("Ruby","gdl_shell_command_5") -> return () ("Ruby","shell_command_rules") -> return () ("Ruby","gdl_regexpr_1") -> return () ("Ruby","gdl_regexpr_1_nested") -> return () ("Ruby","gdl_regexpr_2") -> return () ("Ruby","gdl_regexpr_2_nested") -> return () ("Ruby","gdl_regexpr_3") -> return () ("Ruby","gdl_regexpr_3_nested") -> return () ("Ruby","gdl_regexpr_4") -> return () ("Ruby","gdl_regexpr_4_nested") -> return () ("Ruby","gdl_regexpr_5") -> return () ("Ruby","regexpr_rules") -> return () ("Ruby","DATA") -> 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) list_keywords = Set.fromList $ words $ "BEGIN END and begin break case defined? do else elsif end ensure for if in next not or redo rescue retry return then unless until when yield" list_access'2dcontrol = Set.fromList $ words $ "private_class_method private protected public_class_method public" list_attribute'2ddefinitions = Set.fromList $ words $ "attr_reader attr_writer attr_accessor" list_definitions = Set.fromList $ words $ "alias module class def undef" list_pseudo'2dvariables = Set.fromList $ words $ "self super nil false true caller __FILE__ __LINE__" list_default'2dglobals = Set.fromList $ words $ "$stdout $defout $stderr $deferr $stdin" list_kernel'2dmethods = Set.fromList $ words $ "abort at_exit autoload autoload? binding block_given? callcc caller catch chomp chomp! chop chop! eval exec exit exit! fail fork format getc gets global_variables gsub gsub! iterator? lambda load local_variables loop method_missing open p print printf proc putc puts raise rand readline readlines require require_relative scan select set_trace_func sleep split sprintf srand sub sub! syscall system test throw trace_var trap untrace_var warn" list_mixin'2dmethods = Set.fromList $ words $ "extend include prepend" regex_'5f'5fEND'5f'5f'24 = compileRegex True "__END__$" regex_'23'21'5c'2f'2e'2a = compileRegex True "#!\\/.*" regex_'28'5c'3d'7c'5c'28'7c'5c'5b'7c'5c'7b'29'5cs'2a'28if'7cunless'7cwhile'7cuntil'29'5cb = compileRegex True "(\\=|\\(|\\[|\\{)\\s*(if|unless|while|until)\\b" regex_'28while'7cuntil'29'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 = compileRegex True "(while|until)\\b(?!.*\\bdo\\b)" regex_'5c'3b'5cs'2a'28while'7cuntil'29'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 = compileRegex True "\\;\\s*(while|until)\\b(?!.*\\bdo\\b)" regex_'28if'7cunless'29'5cb = compileRegex True "(if|unless)\\b" regex_'5c'3b'5cs'2a'28if'7cunless'29'5cb = compileRegex True "\\;\\s*(if|unless)\\b" regex_'5cbclass'5cb = compileRegex True "\\bclass\\b" regex_'5cbmodule'5cb = compileRegex True "\\bmodule\\b" regex_'5cbbegin'5cb = compileRegex True "\\bbegin\\b" regex_'5cbfor'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 = compileRegex True "\\bfor\\b(?!.*\\bdo\\b)" regex_'5cbcase'5cb = compileRegex True "\\bcase\\b" regex_'5cbdo'5cb = compileRegex True "\\bdo\\b" regex_'5cbdef'5cb = compileRegex True "\\bdef\\b" regex_'5cbend'5cb = compileRegex True "\\bend\\b" regex_'5cb'28else'7celsif'7crescue'7censure'29'5cb = compileRegex True "\\b(else|elsif|rescue|ensure)\\b" regex_'5c'2e'5b'5fa'2dz'5d'5b'5fa'2dzA'2dZ0'2d9'5d'2a'28'5c'3f'7c'5c'21'7c'5cb'29 = compileRegex True "\\.[_a-z][_a-zA-Z0-9]*(\\?|\\!|\\b)" regex_'5cs'5c'3f'28'5c'5cM'5c'2d'29'3f'28'5c'5cC'5c'2d'29'3f'5c'5c'3f'5cS = compileRegex True "\\s\\?(\\\\M\\-)?(\\\\C\\-)?\\\\?\\S" regex_'5c'24'5ba'2dzA'2dZ'5f0'2d9'5d'2b = compileRegex True "\\$[a-zA-Z_0-9]+" regex_'5c'24'5c'2d'5ba'2dzA'2dz'5f'5d'5cb = compileRegex True "\\$\\-[a-zA-z_]\\b" regex_'5c'24'5b'5cd'5f'2a'60'2b'40'3b'2c'2e'7e'3d'5c'21'5c'24'3a'3f'27'2f'5c'5c'5c'2d'5c'26'22'3e'3c'5d = compileRegex True "\\$[\\d_*`+@;,.~=\\!\\$:?'/\\\\\\-\\&\"><]" regex_'5cb'5b'5fA'2dZ'5d'2b'5bA'2dZ'5f0'2d9'5d'2b'5cb = compileRegex True "\\b[_A-Z]+[A-Z_0-9]+\\b" regex_'5cb'5bA'2dZ'5d'2b'5f'2a'28'5b0'2d9'5d'7c'5ba'2dz'5d'29'5b'5fa'2dzA'2dZ0'2d9'5d'2a'5cb = compileRegex True "\\b[A-Z]+_*([0-9]|[a-z])[_a-zA-Z0-9]*\\b" regex_'5cb'5c'2d'3f0'5bxX'5d'28'5b0'2d9a'2dfA'2dF'5d'7c'5f'5b0'2d9a'2dfA'2dF'5d'29'2b = compileRegex True "\\b\\-?0[xX]([0-9a-fA-F]|_[0-9a-fA-F])+" regex_'5cb'5c'2d'3f0'5bbB'5d'28'5b01'5d'7c'5f'5b01'5d'29'2b = compileRegex True "\\b\\-?0[bB]([01]|_[01])+" regex_'5cb'5c'2d'3f0'5b1'2d7'5d'28'5b0'2d7'5d'7c'5f'5b0'2d7'5d'29'2a = compileRegex True "\\b\\-?0[1-7]([0-7]|_[0-7])*" regex_'5cb'5c'2d'3f'5b0'2d9'5d'28'5b0'2d9'5d'7c'5f'5b0'2d9'5d'29'2a'5c'2e'5b0'2d9'5d'28'5b0'2d9'5d'7c'5f'5b0'2d9'5d'29'2a'28'5beE'5d'5c'2d'3f'5b1'2d9'5d'28'5b0'2d9'5d'7c'5f'5b0'2d9'5d'29'2a'28'5c'2e'5b0'2d9'5d'2a'29'3f'29'3f = compileRegex True "\\b\\-?[0-9]([0-9]|_[0-9])*\\.[0-9]([0-9]|_[0-9])*([eE]\\-?[1-9]([0-9]|_[0-9])*(\\.[0-9]*)?)?" regex_'5cb'5c'2d'3f'5b1'2d9'5d'28'5b0'2d9'5d'7c'5f'5b0'2d9'5d'29'2a'5cb = compileRegex True "\\b\\-?[1-9]([0-9]|_[0-9])*\\b" regex_'3dbegin'28'3f'3a'5cs'7c'24'29 = compileRegex True "=begin(?:\\s|$)" regex_'5cs'2a'3c'3c'2d'28'3f'3d'5cw'2b'7c'5b'22'27'5d'29 = compileRegex True "\\s*<<-(?=\\w+|[\"'])" regex_'5cs'2a'3c'3c'28'3f'3d'5cw'2b'7c'5b'22'27'5d'29 = compileRegex True "\\s*<<(?=\\w+|[\"'])" regex_'5cs'5b'5c'3f'5c'3a'5c'25'5d'5cs = compileRegex True "\\s[\\?\\:\\%]\\s" regex_'5b'7c'26'3c'3e'5c'5e'5c'2b'2a'7e'5c'2d'3d'5d'2b = compileRegex True "[|&<>\\^\\+*~\\-=]+" regex_'5cs'21 = compileRegex True "\\s!" regex_'2f'3d'5cs = compileRegex True "/=\\s" regex_'3a'28'40'7b1'2c2'7d'7c'5c'24'29'3f'5ba'2dzA'2dZ'5f'5d'5ba'2dzA'2dZ0'2d9'5f'5d'2a'5b'3d'3f'21'5d'3f = compileRegex True ":(@{1,2}|\\$)?[a-zA-Z_][a-zA-Z0-9_]*[=?!]?" regex_'3a'5c'5b'5c'5d'3d'3f = compileRegex True ":\\[\\]=?" regex_'28'40'7b1'2c2'7d'7c'5c'24'29'3f'5ba'2dzA'2dZ'5f'5d'5ba'2dzA'2dZ0'2d9'5f'5d'2a'5b'3d'3f'21'5d'3f'3a_ = compileRegex True "(@{1,2}|\\$)?[a-zA-Z_][a-zA-Z0-9_]*[=?!]?: " regex_'5c'5b'5c'5d'3d'3f'3a_ = compileRegex True "\\[\\]=?: " regex_'23'5cs'2aBEGIN'2e'2a'24 = compileRegex True "#\\s*BEGIN.*$" regex_'23'5cs'2aEND'2e'2a'24 = compileRegex True "#\\s*END.*$" regex_'40'5ba'2dzA'2dZ'5f0'2d9'5d'2b = compileRegex True "@[a-zA-Z_0-9]+" regex_'40'40'5ba'2dzA'2dZ'5f0'2d9'5d'2b = compileRegex True "@@[a-zA-Z_0-9]+" regex_'5cs'2a'5b'25'5d'28'3f'3d'5bQqxwW'5d'3f'5b'5e'5cs'5d'29 = compileRegex True "\\s*[%](?=[QqxwW]?[^\\s])" regex_'5cs'2a = compileRegex True "\\s*" regex_'5cs'2b = compileRegex True "\\s+" regex_'5b'2f'25'5d'28'3f'3d'5cs'29 = compileRegex True "[/%](?=\\s)" regex_'2f'28'3f'3d'5cs'29 = compileRegex True "/(?=\\s)" regex_'5c'5c'5c'22 = compileRegex True "\\\\\\\"" regex_'23'40'7b1'2c2'7d = compileRegex True "#@{1,2}" regex_'5c'5c'5c'27 = compileRegex True "\\\\\\'" regex_'5c'5c'5c'60 = compileRegex True "\\\\\\`" regex_'3dend'28'3f'3a'5cs'2e'2a'7c'24'29 = compileRegex True "=end(?:\\s.*|$)" regex_'5c'5c'5c'2f = compileRegex True "\\\\\\/" regex_'2f'5buiomxn'5d'2a = compileRegex True "/[uiomxn]*" regex_'5cw'28'3f'21'5cw'29 = compileRegex True "\\w(?!\\w)" regex_'5c'2e'3f'5b'5fa'2dz'5d'5cw'2a'28'5c'3f'7c'5c'21'29'3f'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 = compileRegex True "\\.?[_a-z]\\w*(\\?|\\!)?(?=[^\\w\\d\\.\\:])" regex_'5c'2e'3f'5b'5fa'2dz'5d'5cw'2a'28'5c'3f'7c'5c'21'29'3f = compileRegex True "\\.?[_a-z]\\w*(\\?|\\!)?" regex_'5bA'2dZ'5d'2b'5f'2a'28'5cd'7c'5ba'2dz'5d'29'5cw'2a'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 = compileRegex True "[A-Z]+_*(\\d|[a-z])\\w*(?=[^\\w\\d\\.\\:])" regex_'5bA'2dZ'5d'2b'5f'2a'28'5b0'2d9'5d'7c'5ba'2dz'5d'29'5cw'2a = compileRegex True "[A-Z]+_*([0-9]|[a-z])\\w*" regex_'5b'5fA'2dZ'5d'5b'5fA'2dZ0'2d9'5d'2a'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 = compileRegex True "[_A-Z][_A-Z0-9]*(?=[^\\w\\d\\.\\:])" regex_'5b'5fA'2dZ'5d'5b'5fA'2dZ0'2d9'5d'2a = compileRegex True "[_A-Z][_A-Z0-9]*" regex_'5cW = compileRegex True "\\W" regex_'5cw'5c'3a'5c'3a'5cs = compileRegex True "\\w\\:\\:\\s" regex_'27'28'5cw'2b'29'27 = compileRegex True "'(\\w+)'" regex_'22'3f'28'5cw'2b'29'22'3f = compileRegex True "\"?(\\w+)\"?" regex_w'5c'28 = compileRegex True "w\\(" regex_w'5c'7b = compileRegex True "w\\{" regex_w'5c'5b = compileRegex True "w\\[" regex_w'3c = compileRegex True "w<" regex_w'28'5b'5e'5cs'5cw'5d'29 = compileRegex True "w([^\\s\\w])" regex_W'5c'28 = compileRegex True "W\\(" regex_W'5c'7b = compileRegex True "W\\{" regex_W'5c'5b = compileRegex True "W\\[" regex_W'3c = compileRegex True "W<" regex_W'28'5b'5e'5cs'5cw'5d'29 = compileRegex True "W([^\\s\\w])" regex_q'5c'28 = compileRegex True "q\\(" regex_q'5c'7b = compileRegex True "q\\{" regex_q'5c'5b = compileRegex True "q\\[" regex_q'3c = compileRegex True "q<" regex_q'28'5b'5e'5cs'5cw'5d'29 = compileRegex True "q([^\\s\\w])" regex_x'5c'28 = compileRegex True "x\\(" regex_x'5c'7b = compileRegex True "x\\{" regex_x'5c'5b = compileRegex True "x\\[" regex_x'3c = compileRegex True "x<" regex_x'28'5b'5e'5cs'5cw'5d'29 = compileRegex True "x([^\\s\\w])" regex_r'5c'28 = compileRegex True "r\\(" regex_r'5c'7b = compileRegex True "r\\{" regex_r'5c'5b = compileRegex True "r\\[" regex_r'3c = compileRegex True "r<" regex_r'28'5b'5e'5cs'5cw'5d'29 = compileRegex True "r([^\\s\\w])" regex_Q'3f'5c'28 = compileRegex True "Q?\\(" regex_Q'3f'5c'7b = compileRegex True "Q?\\{" regex_Q'3f'5c'5b = compileRegex True "Q?\\[" regex_Q'3f'3c = compileRegex True "Q?<" regex_Q'3f'28'5b'5e'5cs'5cw'5d'29 = compileRegex True "Q?([^\\s\\w])" regex_'5c'29'5buiomxn'5d'2a = compileRegex True "\\)[uiomxn]*" regex_'5c'7d'5buiomxn'5d'2a = compileRegex True "\\}[uiomxn]*" regex_'5c'5d'5buiomxn'5d'2a = compileRegex True "\\][uiomxn]*" regex_'3e'5buiomxn'5d'2a = compileRegex True ">[uiomxn]*" parseRules ("Ruby","Normal") = (((pLineContinue >>= withAttribute NormalTok) >>~ pushContext ("Ruby","Line Continue")) <|> ((pColumn 0 >> pRegExpr regex_'5f'5fEND'5f'5f'24 >>= withAttribute KeywordTok) >>~ pushContext ("Ruby","DATA")) <|> ((pColumn 0 >> pRegExpr regex_'23'21'5c'2f'2e'2a >>= withAttribute KeywordTok)) <|> ((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext ("Ruby","Find closing block brace")) <|> ((pRegExpr regex_'28'5c'3d'7c'5c'28'7c'5c'5b'7c'5c'7b'29'5cs'2a'28if'7cunless'7cwhile'7cuntil'29'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'28while'7cuntil'29'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5c'3b'5cs'2a'28while'7cuntil'29'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 >>= withAttribute KeywordTok)) <|> ((pFirstNonSpace >> pRegExpr regex_'28if'7cunless'29'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5c'3b'5cs'2a'28if'7cunless'29'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cbclass'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cbmodule'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cbbegin'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cbfor'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cbcase'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cbdo'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cbdef'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cbend'5cb >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'5cb'28else'7celsif'7crescue'7censure'29'5cb >>= withAttribute KeywordTok)) <|> ((pString False "..." >>= withAttribute NormalTok)) <|> ((pDetect2Chars False '.' '.' >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5c'2e'5b'5fa'2dz'5d'5b'5fa'2dzA'2dZ0'2d9'5d'2a'28'5c'3f'7c'5c'21'7c'5cb'29 >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_2")) <|> ((pRegExpr regex_'5cs'5c'3f'28'5c'5cM'5c'2d'29'3f'28'5c'5cC'5c'2d'29'3f'5c'5c'3f'5cS >>= withAttribute DecValTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pKeyword " \n\t.():+,-<=>%&*/;[]^{|}~\\" list_keywords >>= withAttribute KeywordTok)) <|> ((pKeyword " \n\t.():+,-<=>%&*/;[]^{|}~\\" list_attribute'2ddefinitions >>= withAttribute OtherTok) >>~ pushContext ("Ruby","check_div_2")) <|> ((pKeyword " \n\t.():+,-<=>%&*/;[]^{|}~\\" list_access'2dcontrol >>= withAttribute KeywordTok) >>~ pushContext ("Ruby","check_div_2")) <|> ((pKeyword " \n\t.():+,-<=>%&*/;[]^{|}~\\" list_definitions >>= withAttribute KeywordTok)) <|> ((pKeyword " \n\t.():+,-<=>%&*/;[]^{|}~\\" list_pseudo'2dvariables >>= withAttribute DecValTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pKeyword " \n\t.():+,-<=>%&*/;[]^{|}~\\" list_default'2dglobals >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby","check_div_2")) <|> ((pKeyword " \n\t.():+,-<=>%&*/;[]^{|}~\\" list_kernel'2dmethods >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_2")) <|> ((pKeyword " \n\t.():+,-<=>%&*/;[]^{|}~\\" list_mixin'2dmethods >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_2")) <|> ((pRegExpr regex_'5c'24'5ba'2dzA'2dZ'5f0'2d9'5d'2b >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'5c'24'5c'2d'5ba'2dzA'2dz'5f'5d'5cb >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'5c'24'5b'5cd'5f'2a'60'2b'40'3b'2c'2e'7e'3d'5c'21'5c'24'3a'3f'27'2f'5c'5c'5c'2d'5c'26'22'3e'3c'5d >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'5cb'5b'5fA'2dZ'5d'2b'5bA'2dZ'5f0'2d9'5d'2b'5cb >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby","check_div_2")) <|> ((pRegExpr regex_'5cb'5bA'2dZ'5d'2b'5f'2a'28'5b0'2d9'5d'7c'5ba'2dz'5d'29'5b'5fa'2dzA'2dZ0'2d9'5d'2a'5cb >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby","check_div_2")) <|> ((pRegExpr regex_'5cb'5c'2d'3f0'5bxX'5d'28'5b0'2d9a'2dfA'2dF'5d'7c'5f'5b0'2d9a'2dfA'2dF'5d'29'2b >>= withAttribute BaseNTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'5cb'5c'2d'3f0'5bbB'5d'28'5b01'5d'7c'5f'5b01'5d'29'2b >>= withAttribute BaseNTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'5cb'5c'2d'3f0'5b1'2d7'5d'28'5b0'2d7'5d'7c'5f'5b0'2d7'5d'29'2a >>= withAttribute BaseNTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'5cb'5c'2d'3f'5b0'2d9'5d'28'5b0'2d9'5d'7c'5f'5b0'2d9'5d'29'2a'5c'2e'5b0'2d9'5d'28'5b0'2d9'5d'7c'5f'5b0'2d9'5d'29'2a'28'5beE'5d'5c'2d'3f'5b1'2d9'5d'28'5b0'2d9'5d'7c'5f'5b0'2d9'5d'29'2a'28'5c'2e'5b0'2d9'5d'2a'29'3f'29'3f >>= withAttribute FloatTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'5cb'5c'2d'3f'5b1'2d9'5d'28'5b0'2d9'5d'7c'5f'5b0'2d9'5d'29'2a'5cb >>= withAttribute DecValTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pInt >>= withAttribute DecValTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pHlCChar >>= withAttribute CharTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pColumn 0 >> pRegExpr regex_'3dbegin'28'3f'3a'5cs'7c'24'29 >>= withAttribute CommentTok) >>~ pushContext ("Ruby","Embedded documentation")) <|> ((pRegExpr regex_'5cs'2a'3c'3c'2d'28'3f'3d'5cw'2b'7c'5b'22'27'5d'29 >>= withAttribute NormalTok) >>~ pushContext ("Ruby","find_indented_heredoc")) <|> ((pRegExpr regex_'5cs'2a'3c'3c'28'3f'3d'5cw'2b'7c'5b'22'27'5d'29 >>= withAttribute NormalTok) >>~ pushContext ("Ruby","find_heredoc")) <|> ((pDetectChar False '.' >>= withAttribute NormalTok)) <|> ((pDetect2Chars False '&' '&' >>= withAttribute NormalTok)) <|> ((pDetect2Chars False '|' '|' >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5cs'5b'5c'3f'5c'3a'5c'25'5d'5cs >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5b'7c'26'3c'3e'5c'5e'5c'2b'2a'7e'5c'2d'3d'5d'2b >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5cs'21 >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'2f'3d'5cs >>= withAttribute NormalTok)) <|> ((pString False "%=" >>= withAttribute NormalTok)) <|> ((pDetect2Chars False ':' ':' >>= withAttribute NormalTok) >>~ pushContext ("Ruby","Member Access")) <|> ((pRegExpr regex_'3a'28'40'7b1'2c2'7d'7c'5c'24'29'3f'5ba'2dzA'2dZ'5f'5d'5ba'2dzA'2dZ0'2d9'5f'5d'2a'5b'3d'3f'21'5d'3f >>= withAttribute StringTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'3a'5c'5b'5c'5d'3d'3f >>= withAttribute StringTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'28'40'7b1'2c2'7d'7c'5c'24'29'3f'5ba'2dzA'2dZ'5f'5d'5ba'2dzA'2dZ0'2d9'5f'5d'2a'5b'3d'3f'21'5d'3f'3a_ >>= withAttribute StringTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'5c'5b'5c'5d'3d'3f'3a_ >>= withAttribute StringTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext ("Ruby","Quoted String")) <|> ((pDetectChar False '\'' >>= withAttribute StringTok) >>~ pushContext ("Ruby","Apostrophed String")) <|> ((pDetectChar False '`' >>= withAttribute StringTok) >>~ pushContext ("Ruby","Command String")) <|> ((pString False "?#" >>= withAttribute NormalTok)) <|> ((pColumn 0 >> pRegExpr regex_'23'5cs'2aBEGIN'2e'2a'24 >>= withAttribute CommentTok)) <|> ((pColumn 0 >> pRegExpr regex_'23'5cs'2aEND'2e'2a'24 >>= withAttribute CommentTok)) <|> ((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext ("Ruby","General Comment")) <|> ((pDetectChar False '[' >>= withAttribute NormalTok)) <|> ((pDetectChar False ']' >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pDetectChar False '{' >>= withAttribute NormalTok)) <|> ((pDetectChar False '}' >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'40'5ba'2dzA'2dZ'5f0'2d9'5d'2b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pRegExpr regex_'40'40'5ba'2dzA'2dZ'5f0'2d9'5d'2b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pDetectChar False '/' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","RegEx 1")) <|> ((pRegExpr regex_'5cs'2a'5b'25'5d'28'3f'3d'5bQqxwW'5d'3f'5b'5e'5cs'5d'29 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","find_gdl_input")) <|> ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_1")) <|> ((pDetectIdentifier >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_2")) <|> (currentContext >>= \x -> guard (x == ("Ruby","Normal")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","check_div_1") = (((pRegExpr regex_'5cs'2a >>= withAttribute NormalTok)) <|> ((pAnyChar "/%" >>= withAttribute NormalTok) >>~ (popContext)) <|> ((popContext) >> currentContext >>= parseRules)) parseRules ("Ruby","check_div_1_pop") = (((pRegExpr regex_'5cs'2a >>= withAttribute NormalTok)) <|> ((pAnyChar "/%" >>= withAttribute NormalTok) >>~ (popContext >> popContext)) <|> ((popContext >> popContext) >> currentContext >>= parseRules)) parseRules ("Ruby","check_div_2") = (((pAnyChar "/%" >>= withAttribute NormalTok) >>~ (popContext)) <|> ((pRegExpr regex_'5cs'2b >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_2_internal")) <|> ((popContext) >> currentContext >>= parseRules)) parseRules ("Ruby","check_div_2_internal") = (((pRegExpr regex_'5b'2f'25'5d'28'3f'3d'5cs'29 >>= withAttribute NormalTok) >>~ (popContext >> popContext)) <|> ((popContext >> popContext) >> currentContext >>= parseRules)) parseRules ("Ruby","check_div_2_pop") = (((pAnyChar "/%" >>= withAttribute NormalTok) >>~ (popContext >> popContext)) <|> ((pRegExpr regex_'5cs'2b >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_2_pop_internal")) <|> ((popContext >> popContext) >> currentContext >>= parseRules)) parseRules ("Ruby","check_div_2_pop_internal") = (((pDetectChar False '%' >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext)) <|> ((pRegExpr regex_'2f'28'3f'3d'5cs'29 >>= withAttribute NormalTok) >>~ (popContext >> popContext >> popContext)) <|> ((popContext >> popContext >> popContext) >> currentContext >>= parseRules)) parseRules ("Ruby","Line Continue") = (((pFirstNonSpace >> pRegExpr regex_'28while'7cuntil'29'5cb'28'3f'21'2e'2a'5cbdo'5cb'29 >>= withAttribute KeywordTok)) <|> ((pFirstNonSpace >> pRegExpr regex_'28if'7cunless'29'5cb >>= withAttribute KeywordTok)) <|> ((parseRules ("Ruby","Normal"))) <|> (currentContext >>= \x -> guard (x == ("Ruby","Line Continue")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","Find closing block brace") = (((pDetectChar False '}' >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_1_pop")) <|> ((parseRules ("Ruby","Normal"))) <|> (currentContext >>= \x -> guard (x == ("Ruby","Find closing block brace")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","Quoted String") = (((pString False "\\\\" >>= withAttribute StringTok)) <|> ((pRegExpr regex_'5c'5c'5c'22 >>= withAttribute StringTok)) <|> ((pRegExpr regex_'23'40'7b1'2c2'7d >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Short Subst")) <|> ((pDetect2Chars False '#' '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Subst")) <|> ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext ("Ruby","check_div_1_pop")) <|> (currentContext >>= \x -> guard (x == ("Ruby","Quoted String")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","Apostrophed String") = (((pString False "\\\\" >>= withAttribute StringTok)) <|> ((pRegExpr regex_'5c'5c'5c'27 >>= withAttribute StringTok)) <|> ((pDetectChar False '\'' >>= withAttribute StringTok) >>~ pushContext ("Ruby","check_div_1_pop")) <|> (currentContext >>= \x -> guard (x == ("Ruby","Apostrophed String")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","Command String") = (((pString False "\\\\" >>= withAttribute StringTok)) <|> ((pRegExpr regex_'5c'5c'5c'60 >>= withAttribute StringTok)) <|> ((pRegExpr regex_'23'40'7b1'2c2'7d >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Short Subst")) <|> ((pDetect2Chars False '#' '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Subst")) <|> ((pDetectChar False '`' >>= withAttribute StringTok) >>~ pushContext ("Ruby","check_div_1_pop")) <|> (currentContext >>= \x -> guard (x == ("Ruby","Command String")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","Embedded documentation") = (((pColumn 0 >> pRegExpr regex_'3dend'28'3f'3a'5cs'2e'2a'7c'24'29 >>= withAttribute CommentTok) >>~ (popContext)) <|> ((Text.Highlighting.Kate.Syntax.Alert.parseExpression (Just ("Alerts","")) >>= ((withAttribute CommentTok) . snd))) <|> (currentContext >>= \x -> guard (x == ("Ruby","Embedded documentation")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Ruby","RegEx 1") = (((pRegExpr regex_'5c'5c'5c'2f >>= withAttribute OtherTok)) <|> ((pRegExpr regex_'23'40'7b1'2c2'7d >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Short Subst")) <|> ((pDetect2Chars False '#' '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Subst")) <|> ((pRegExpr regex_'2f'5buiomxn'5d'2a >>= withAttribute OtherTok) >>~ pushContext ("Ruby","check_div_1_pop")) <|> (currentContext >>= \x -> guard (x == ("Ruby","RegEx 1")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","Subst") = (((pDetectChar False '}' >>= withAttribute OtherTok) >>~ (popContext)) <|> ((parseRules ("Ruby","Normal"))) <|> (currentContext >>= \x -> guard (x == ("Ruby","Subst")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","Short Subst") = (((pRegExpr regex_'23'40'7b1'2c2'7d >>= withAttribute OtherTok)) <|> ((pRegExpr regex_'5cw'28'3f'21'5cw'29 >>= withAttribute OtherTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","Short Subst")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","Member Access") = (((pRegExpr regex_'5c'2e'3f'5b'5fa'2dz'5d'5cw'2a'28'5c'3f'7c'5c'21'29'3f'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 >>= withAttribute NormalTok) >>~ pushContext ("Ruby","check_div_2_pop")) <|> ((pRegExpr regex_'5c'2e'3f'5b'5fa'2dz'5d'5cw'2a'28'5c'3f'7c'5c'21'29'3f >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5bA'2dZ'5d'2b'5f'2a'28'5cd'7c'5ba'2dz'5d'29'5cw'2a'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby","check_div_2_pop")) <|> ((pRegExpr regex_'5bA'2dZ'5d'2b'5f'2a'28'5b0'2d9'5d'7c'5ba'2dz'5d'29'5cw'2a >>= withAttribute DataTypeTok)) <|> ((pRegExpr regex_'5b'5fA'2dZ'5d'5b'5fA'2dZ0'2d9'5d'2a'28'3f'3d'5b'5e'5cw'5cd'5c'2e'5c'3a'5d'29 >>= withAttribute DataTypeTok) >>~ pushContext ("Ruby","check_div_2_pop")) <|> ((pRegExpr regex_'5b'5fA'2dZ'5d'5b'5fA'2dZ0'2d9'5d'2a >>= withAttribute DataTypeTok)) <|> ((pDetect2Chars False ':' ':' >>= withAttribute NormalTok)) <|> ((pDetectChar False '.' >>= withAttribute NormalTok)) <|> ((pAnyChar "=+-*/%|&[]{}~" >>= withAttribute NormalTok) >>~ (popContext)) <|> ((pDetectChar False '#' >>= withAttribute CommentTok) >>~ (popContext)) <|> ((pAnyChar "()\\" >>= withAttribute NormalTok) >>~ (popContext)) <|> ((pRegExpr regex_'5cW >>= withAttribute NormalTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","Member Access")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","Comment Line") = (((pRegExpr regex_'5cw'5c'3a'5c'3a'5cs >>= withAttribute CommentTok) >>~ pushContext ("Ruby","RDoc Label")) <|> ((Text.Highlighting.Kate.Syntax.Alert.parseExpression (Just ("Alerts","")) >>= ((withAttribute CommentTok) . snd))) <|> (currentContext >>= \x -> guard (x == ("Ruby","Comment Line")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Ruby","General Comment") = (((Text.Highlighting.Kate.Syntax.Alert.parseExpression (Just ("Alerts","")) >>= ((withAttribute CommentTok) . snd))) <|> (currentContext >>= \x -> guard (x == ("Ruby","General Comment")) >> pDefault >>= withAttribute CommentTok)) parseRules ("Ruby","RDoc Label") = (currentContext >>= \x -> guard (x == ("Ruby","RDoc Label")) >> pDefault >>= withAttribute OtherTok) parseRules ("Ruby","find_heredoc") = (((pRegExpr regex_'27'28'5cw'2b'29'27 >>= withAttribute KeywordTok) >>~ pushContext ("Ruby","apostrophed_normal_heredoc")) <|> ((pRegExpr regex_'22'3f'28'5cw'2b'29'22'3f >>= withAttribute KeywordTok) >>~ pushContext ("Ruby","normal_heredoc")) <|> (currentContext >>= \x -> guard (x == ("Ruby","find_heredoc")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","find_indented_heredoc") = (((pRegExpr regex_'27'28'5cw'2b'29'27 >>= withAttribute KeywordTok) >>~ pushContext ("Ruby","apostrophed_indented_heredoc")) <|> ((pRegExpr regex_'22'3f'28'5cw'2b'29'22'3f >>= withAttribute KeywordTok) >>~ pushContext ("Ruby","indented_heredoc")) <|> (currentContext >>= \x -> guard (x == ("Ruby","find_indented_heredoc")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","indented_heredoc") = (((pFirstNonSpace >> pRegExprDynamic "%1$" >>= withAttribute KeywordTok) >>~ (popContext >> popContext)) <|> ((parseRules ("Ruby","heredoc_rules"))) <|> (currentContext >>= \x -> guard (x == ("Ruby","indented_heredoc")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","apostrophed_indented_heredoc") = (((pFirstNonSpace >> pRegExprDynamic "%1$" >>= withAttribute KeywordTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","apostrophed_indented_heredoc")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","normal_heredoc") = (((pColumn 0 >> pRegExprDynamic "%1$" >>= withAttribute KeywordTok) >>~ (popContext >> popContext)) <|> ((parseRules ("Ruby","heredoc_rules"))) <|> (currentContext >>= \x -> guard (x == ("Ruby","normal_heredoc")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","apostrophed_normal_heredoc") = (((pColumn 0 >> pRegExprDynamic "%1$" >>= withAttribute KeywordTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","apostrophed_normal_heredoc")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","heredoc_rules") = (((pRegExpr regex_'23'40'7b1'2c2'7d >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Short Subst")) <|> ((pDetect2Chars False '#' '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Subst")) <|> (currentContext >>= \x -> guard (x == ("Ruby","heredoc_rules")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","find_gdl_input") = (((pRegExpr regex_w'5c'28 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_1")) <|> ((pRegExpr regex_w'5c'7b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_2")) <|> ((pRegExpr regex_w'5c'5b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_3")) <|> ((pRegExpr regex_w'3c >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_4")) <|> ((pRegExpr regex_w'28'5b'5e'5cs'5cw'5d'29 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_5")) <|> ((pRegExpr regex_W'5c'28 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_1")) <|> ((pRegExpr regex_W'5c'7b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_2")) <|> ((pRegExpr regex_W'5c'5b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_3")) <|> ((pRegExpr regex_W'3c >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_4")) <|> ((pRegExpr regex_W'28'5b'5e'5cs'5cw'5d'29 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_token_array_5")) <|> ((pRegExpr regex_q'5c'28 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_apostrophed_1")) <|> ((pRegExpr regex_q'5c'7b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_apostrophed_2")) <|> ((pRegExpr regex_q'5c'5b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_apostrophed_3")) <|> ((pRegExpr regex_q'3c >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_apostrophed_4")) <|> ((pRegExpr regex_q'28'5b'5e'5cs'5cw'5d'29 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_apostrophed_5")) <|> ((pRegExpr regex_x'5c'28 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_shell_command_1")) <|> ((pRegExpr regex_x'5c'7b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_shell_command_2")) <|> ((pRegExpr regex_x'5c'5b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_shell_command_3")) <|> ((pRegExpr regex_x'3c >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_shell_command_4")) <|> ((pRegExpr regex_x'28'5b'5e'5cs'5cw'5d'29 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_shell_command_5")) <|> ((pRegExpr regex_r'5c'28 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_1")) <|> ((pRegExpr regex_r'5c'7b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_2")) <|> ((pRegExpr regex_r'5c'5b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_3")) <|> ((pRegExpr regex_r'3c >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_4")) <|> ((pRegExpr regex_r'28'5b'5e'5cs'5cw'5d'29 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_5")) <|> ((pRegExpr regex_Q'3f'5c'28 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_dq_string_1")) <|> ((pRegExpr regex_Q'3f'5c'7b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_dq_string_2")) <|> ((pRegExpr regex_Q'3f'5c'5b >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_dq_string_3")) <|> ((pRegExpr regex_Q'3f'3c >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_dq_string_4")) <|> ((pRegExpr regex_Q'3f'28'5b'5e'5cs'5cw'5d'29 >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_dq_string_5")) <|> (currentContext >>= \x -> guard (x == ("Ruby","find_gdl_input")) >> pDefault >>= withAttribute NormalTok)) parseRules ("Ruby","gdl_dq_string_1") = (((parseRules ("Ruby","dq_string_rules"))) <|> ((pDetect2Chars False '\\' ')' >>= withAttribute StringTok)) <|> ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_dq_string_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_1")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_dq_string_1_nested") = (((parseRules ("Ruby","dq_string_rules"))) <|> ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_dq_string_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_1_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_dq_string_2") = (((parseRules ("Ruby","dq_string_rules"))) <|> ((pDetect2Chars False '\\' '}' >>= withAttribute StringTok)) <|> ((pDetectChar False '}' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> ((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_dq_string_2_nested")) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_2")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_dq_string_2_nested") = (((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_dq_string_2_nested")) <|> ((pDetectChar False '}' >>= withAttribute StringTok) >>~ (popContext)) <|> ((parseRules ("Ruby","dq_string_rules"))) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_2_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_dq_string_3") = (((parseRules ("Ruby","dq_string_rules"))) <|> ((pDetect2Chars False '\\' ']' >>= withAttribute StringTok)) <|> ((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_dq_string_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_3")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_dq_string_3_nested") = (((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_dq_string_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute StringTok) >>~ (popContext)) <|> ((parseRules ("Ruby","dq_string_rules"))) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_3_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_dq_string_4") = (((parseRules ("Ruby","dq_string_rules"))) <|> ((pDetect2Chars False '\\' '>' >>= withAttribute StringTok)) <|> ((pDetectChar False '<' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_dq_string_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_4")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_dq_string_4_nested") = (((pDetectChar False '<' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_dq_string_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute StringTok) >>~ (popContext)) <|> ((parseRules ("Ruby","dq_string_rules"))) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_4_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_dq_string_5") = (((parseRules ("Ruby","dq_string_rules"))) <|> ((pRegExprDynamic "\\\\%1" >>= withAttribute StringTok)) <|> ((pRegExprDynamic "\\s*%1" >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_dq_string_5")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","dq_string_rules") = (((pDetect2Chars False '\\' '\\' >>= withAttribute StringTok)) <|> ((pRegExpr regex_'23'40'7b1'2c2'7d >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Short Subst")) <|> ((pDetect2Chars False '#' '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Subst")) <|> (currentContext >>= \x -> guard (x == ("Ruby","dq_string_rules")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_1") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pDetect2Chars False '\\' ')' >>= withAttribute StringTok)) <|> ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_token_array_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_1")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_1_nested") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_token_array_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_1_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_2") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pDetect2Chars False '\\' '}' >>= withAttribute StringTok)) <|> ((pDetectChar False '}' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> ((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_token_array_2_nested")) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_2")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_2_nested") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_token_array_2_nested")) <|> ((pDetectChar False '}' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_2_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_3") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pDetect2Chars False '\\' ']' >>= withAttribute StringTok)) <|> ((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_token_array_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_3")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_3_nested") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_token_array_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_3_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_4") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pDetect2Chars False '\\' '>' >>= withAttribute StringTok)) <|> ((pDetectChar False '<' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_token_array_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_4")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_4_nested") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pDetectChar False '<' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_token_array_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_4_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_token_array_5") = (((parseRules ("Ruby","token_array_rules"))) <|> ((pRegExprDynamic "\\\\%1" >>= withAttribute StringTok)) <|> ((pRegExprDynamic "\\s*%1" >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_token_array_5")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","token_array_rules") = (((pString False "\\\\" >>= withAttribute StringTok)) <|> (currentContext >>= \x -> guard (x == ("Ruby","token_array_rules")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_1") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pDetect2Chars False '\\' ')' >>= withAttribute StringTok)) <|> ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_apostrophed_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_1")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_1_nested") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_apostrophed_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_1_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_2") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pDetect2Chars False '\\' '}' >>= withAttribute StringTok)) <|> ((pDetectChar False '}' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> ((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_apostrophed_2_nested")) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_2")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_2_nested") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_apostrophed_2_nested")) <|> ((pDetectChar False '}' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_2_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_3") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pDetect2Chars False '\\' ']' >>= withAttribute StringTok)) <|> ((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_apostrophed_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_3")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_3_nested") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_apostrophed_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_3_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_4") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pDetect2Chars False '\\' '>' >>= withAttribute StringTok)) <|> ((pDetectChar False '<' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_apostrophed_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_4")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_4_nested") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pDetectChar False '<' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_apostrophed_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_4_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_apostrophed_5") = (((parseRules ("Ruby","apostrophed_rules"))) <|> ((pRegExprDynamic "\\\\%1" >>= withAttribute StringTok)) <|> ((pRegExprDynamic "\\s*%1" >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_apostrophed_5")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","apostrophed_rules") = (((pDetect2Chars False '\\' '\\' >>= withAttribute StringTok)) <|> (currentContext >>= \x -> guard (x == ("Ruby","apostrophed_rules")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_1") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pDetect2Chars False '\\' ')' >>= withAttribute StringTok)) <|> ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_shell_command_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_1")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_1_nested") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_shell_command_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_1_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_2") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pDetect2Chars False '\\' '}' >>= withAttribute StringTok)) <|> ((pDetectChar False '}' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> ((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_shell_command_2_nested")) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_2")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_2_nested") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_shell_command_2_nested")) <|> ((pDetectChar False '}' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_2_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_3") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pDetect2Chars False '\\' ']' >>= withAttribute StringTok)) <|> ((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_shell_command_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_3")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_3_nested") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_shell_command_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_3_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_4") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pDetect2Chars False '\\' '>' >>= withAttribute StringTok)) <|> ((pDetectChar False '<' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_shell_command_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_4")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_4_nested") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pDetectChar False '<' >>= withAttribute StringTok) >>~ pushContext ("Ruby","gdl_shell_command_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute StringTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_4_nested")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_shell_command_5") = (((parseRules ("Ruby","shell_command_rules"))) <|> ((pRegExprDynamic "\\\\%1" >>= withAttribute StringTok)) <|> ((pRegExprDynamic "\\s*%1" >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_shell_command_5")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","shell_command_rules") = (((pDetect2Chars False '\\' '\\' >>= withAttribute StringTok)) <|> ((pRegExpr regex_'23'40'7b1'2c2'7d >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Short Subst")) <|> ((pDetect2Chars False '#' '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Subst")) <|> (currentContext >>= \x -> guard (x == ("Ruby","shell_command_rules")) >> pDefault >>= withAttribute StringTok)) parseRules ("Ruby","gdl_regexpr_1") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pDetect2Chars False '\\' ')' >>= withAttribute OtherTok)) <|> ((pDetectChar False '(' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_1_nested")) <|> ((pRegExpr regex_'5c'29'5buiomxn'5d'2a >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_1")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","gdl_regexpr_1_nested") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pDetectChar False '(' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_1_nested")) <|> ((pDetectChar False ')' >>= withAttribute OtherTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_1_nested")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","gdl_regexpr_2") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pDetect2Chars False '\\' '}' >>= withAttribute OtherTok)) <|> ((pRegExpr regex_'5c'7d'5buiomxn'5d'2a >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> ((pDetectChar False '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_2_nested")) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_2")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","gdl_regexpr_2_nested") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pDetectChar False '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_2_nested")) <|> ((pDetectChar False '}' >>= withAttribute OtherTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_2_nested")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","gdl_regexpr_3") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pDetect2Chars False '\\' ']' >>= withAttribute OtherTok)) <|> ((pDetectChar False '[' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_3_nested")) <|> ((pRegExpr regex_'5c'5d'5buiomxn'5d'2a >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_3")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","gdl_regexpr_3_nested") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pDetectChar False '[' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_3_nested")) <|> ((pDetectChar False ']' >>= withAttribute OtherTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_3_nested")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","gdl_regexpr_4") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pDetect2Chars False '\\' '>' >>= withAttribute OtherTok)) <|> ((pDetectChar False '<' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_4_nested")) <|> ((pRegExpr regex_'3e'5buiomxn'5d'2a >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_4")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","gdl_regexpr_4_nested") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pDetectChar False '<' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","gdl_regexpr_4_nested")) <|> ((pDetectChar False '>' >>= withAttribute OtherTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_4_nested")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","gdl_regexpr_5") = (((parseRules ("Ruby","regexpr_rules"))) <|> ((pRegExprDynamic "\\\\%1" >>= withAttribute OtherTok)) <|> ((pRegExprDynamic "\\s*%1[uiomxn]*" >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> (currentContext >>= \x -> guard (x == ("Ruby","gdl_regexpr_5")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","regexpr_rules") = (((pDetect2Chars False '\\' '\\' >>= withAttribute OtherTok)) <|> ((pRegExpr regex_'23'40'7b1'2c2'7d >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Short Subst")) <|> ((pDetect2Chars False '#' '{' >>= withAttribute OtherTok) >>~ pushContext ("Ruby","Subst")) <|> (currentContext >>= \x -> guard (x == ("Ruby","regexpr_rules")) >> pDefault >>= withAttribute OtherTok)) parseRules ("Ruby","DATA") = (currentContext >>= \x -> guard (x == ("Ruby","DATA")) >> pDefault >>= withAttribute NormalTok) parseRules ("Alerts", _) = Text.Highlighting.Kate.Syntax.Alert.parseExpression Nothing parseRules x = parseRules ("Ruby","Normal") <|> fail ("Unknown context" ++ show x)