{- This module was generated from data in the Kate syntax highlighting file perl.xml, version 1.20,
   by  Anders Lund (anders@alweb.dk) -}

module Text.Highlighting.Kate.Syntax.Perl ( 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 = "Perl"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.pl;*.pm"

-- | 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 = "Perl" }
  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 [("Perl",["normal"])], synStLanguage = "Perl", synStCurrentLine = "", synStCharsParsedInLine = 0, synStPrevChar = '\n', synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}

parseSourceLine = manyTill parseExpressionInternal pEndLine

pEndLine = do
  newline <|> (eof >> return '\n')
  context <- currentContext
  case context of
    "normal" -> return ()
    "find_quoted" -> return ()
    "find_qqx" -> return ()
    "find_qw" -> return ()
    "ipstring_internal" -> return ()
    "ip_string" -> return ()
    "ip_string_2" -> return ()
    "ip_string_3" -> return ()
    "ip_string_4" -> return ()
    "ip_string_5" -> return ()
    "ip_string_6" -> return ()
    "string" -> return ()
    "string_2" -> return ()
    "string_3" -> return ()
    "string_4" -> return ()
    "string_5" -> return ()
    "string_6" -> return ()
    "find_subst" -> return ()
    "subst_curlybrace_pattern" -> return ()
    "subst_curlybrace_middle" -> return ()
    "subst_curlybrace_replace" -> return ()
    "subst_curlybrace_replace_recursive" -> return ()
    "subst_paren_pattern" -> return ()
    "subst_paren_replace" -> return ()
    "subst_bracket_pattern" -> return ()
    "subst_bracket_replace" -> return ()
    "subst_slash_pattern" -> return ()
    "subst_slash_replace" -> return ()
    "subst_sq_pattern" -> return ()
    "subst_sq_replace" -> return ()
    "tr" -> (popContext >> return ())
    "find_pattern" -> return ()
    "pattern_slash" -> return ()
    "pattern" -> return ()
    "pattern_brace" -> return ()
    "pattern_bracket" -> return ()
    "pattern_paren" -> return ()
    "pattern_sq" -> return ()
    "regex_pattern_internal_rules_1" -> return ()
    "regex_pattern_internal_rules_2" -> return ()
    "regex_pattern_internal" -> return ()
    "regex_pattern_internal_ip" -> return ()
    "pat_ext" -> return ()
    "pat_char_class" -> return ()
    "find_variable" -> (popContext >> return ())
    "find_variable_unsafe" -> (popContext >> return ())
    "var_detect" -> (popContext >> popContext >> return ())
    "var_detect_unsafe" -> (popContext >> popContext >> return ())
    "var_detect_rules" -> (popContext >> popContext >> return ())
    "quote_word" -> return ()
    "quote_word_paren" -> return ()
    "quote_word_brace" -> return ()
    "quote_word_bracket" -> return ()
    "find_here_document" -> (popContext >> return ())
    "here_document" -> return ()
    "here_document_dumb" -> return ()
    "data_handle" -> return ()
    "end_handle" -> return ()
    "Backticked" -> return ()
    "slash_safe_escape" -> (popContext >> return ())
    "package_qualified_blank" -> return ()
    "sub_name_def" -> (popContext >> return ())
    "sub_arg_definition" -> return ()
    "pod" -> return ()
    "comment" -> (popContext >> return ())
    _ -> return ()
  lineContents <- lookAhead wholeLine
  updateState $ \st -> st { synStCurrentLine = lineContents, synStCharsParsedInLine = 0, synStPrevChar = '\n' }

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 = [("Keyword","kw"),("Pragma","kw"),("Function","fu"),("Operator","kw"),("Data Type","dt"),("Special Variable","dt"),("Decimal","dv"),("Octal","bn"),("Hex","bn"),("Float","fl"),("String","st"),("String (interpolated)","st"),("String Special Character","ch"),("Pattern","ot"),("Pattern Internal Operator","ch"),("Pattern Character Class","bn"),("Comment","co"),("Pod","co"),("Nothing","co")]

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

list_keywords = Set.fromList $ words $ "if unless else elsif while until for each foreach next last break continue return use no require my our local BEGIN END require package sub do __END__ __DATA__ __FILE__ __LINE__ __PACKAGE__"
list_operators = Set.fromList $ words $ "= != ~= += -= *= /= **= |= ||= &= &&= ?= + - * % || && | & < << > >> ^ -> => . , ; :: \\ and or not eq ne"
list_functions = Set.fromList $ words $ "abs accept alarm atan2 bind binmode bless caller chdir chmod chomp chop chown chr chroot close closedir connect cos crypt dbmclose dbmopen defined delete die dump endgrent endhostent endnetent endprotoent endpwent endservent eof eval exec exists exit exp fcntl fileno flock fork format formline getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr getnetbyname getnetent getpeername getpgrp getppid getpriority getprotobyname getprotobynumber getprotoent getpwent getpwnam getpwuid getservbyname getservbyport getservent getsockname getsockopt glob gmtime goto grep hex import index int ioctl join keys kill last lc lcfirst length link listen localtime lock log lstat map mkdir msgctl msgget msgrcv msgsnd oct open opendir ord pack package pipe pop pos print printf prototype push quotemeta rand read readdir readline readlink recv redo ref rename reset return reverse rewinddir rindex rmdir scalar seek seekdir select semctl semget semop send setgrent sethostent setnetent setpgrp setpriority setprotoent setpwent setservent setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep socket socketpair sort splice split sprintf sqrt srand stat study sub substr symlink syscall sysread sysseek system syswrite tell telldir tie time times truncate uc ucfirst umask undef unlink unpack unshift untie utime values vec wait waitpid wantarray warn write"
list_pragmas = Set.fromList $ words $ "strict english warnings vars subs utf8 sigtrap locale open less integer filetest constant bytes diagnostics"

regex_'23'21'5c'2f'2e'2a = compileRegex "#!\\/.*"
regex_'5cbsub'5cs'2b = compileRegex "\\bsub\\s+"
regex_'5c'3d'28'3f'3ahead'5b1'2d6'5d'7cover'7cback'7citem'7cfor'7cbegin'7cend'7cpod'29'28'5cs'7c'24'29 = compileRegex "\\=(?:head[1-6]|over|back|item|for|begin|end|pod)(\\s|$)"
regex_'5c'5c'28'5b'22'27'5d'29'5b'5e'5c1'5d = compileRegex "\\\\([\"'])[^\\1]"
regex_'28'3f'3a'5b'24'40'5d'5cS'7c'25'5b'5cw'7b'5d'7c'5c'2a'5b'5e'5cd'5c'2a'7b'5c'24'40'25'3d'28'5d'29 = compileRegex "(?:[$@]\\S|%[\\w{]|\\*[^\\d\\*{\\$@%=(])"
regex_'3c'5bA'2dZ0'2d9'5f'5d'2b'3e = compileRegex "<[A-Z0-9_]+>"
regex_'5cs'2a'3c'3c'28'3f'3d'5cw'2b'7c'5cs'2a'5b'22'27'5d'29 = compileRegex "\\s*<<(?=\\w+|\\s*[\"'])"
regex_'5cs'2a'5c'7d'5cs'2a'2f = compileRegex "\\s*\\}\\s*/"
regex_'5cs'2a'5b'29'5d'5cs'2a'2f = compileRegex "\\s*[)]\\s*/"
regex_'5cw'2b'3a'3a = compileRegex "\\w+::"
regex_'5cw'2b'5b'3d'5d = compileRegex "\\w+[=]"
regex_'5cbq'28'3f'3d'5bqwx'5d'3f'5cs'2a'5b'5e'5cw'5cs'5d'29 = compileRegex "\\bq(?=[qwx]?\\s*[^\\w\\s])"
regex_'5cbs'28'3f'3d'5cs'2a'5b'5e'5cw'5cs'5d'29 = compileRegex "\\bs(?=\\s*[^\\w\\s])"
regex_'5cb'28'3f'3atr'7cy'29'5cs'2a'28'3f'3d'5b'5e'5cw'5cs'5c'5d'7d'29'5d'29 = compileRegex "\\b(?:tr|y)\\s*(?=[^\\w\\s\\]})])"
regex_'5cb'28'3f'3am'7cqr'29'28'3f'3d'5cs'2a'5b'5e'5cw'5cs'5c'5d'7d'29'5d'29 = compileRegex "\\b(?:m|qr)(?=\\s*[^\\w\\s\\]})])"
regex_'5b'5cw'5f'5d'2b'5cs'2a'2f = compileRegex "[\\w_]+\\s*/"
regex_'5b'3c'3e'22'27'3a'5d'2f = compileRegex "[<>\"':]/"
regex_'2d'5brwxoRWXOeszfdlpSbctugkTBMAC'5d = compileRegex "-[rwxoRWXOeszfdlpSbctugkTBMAC]"
regex_x'5cs'2a'28'27'29 = compileRegex "x\\s*(')"
regex_'28'5b'5ea'2dzA'2dZ0'2d9'5f'5cs'5b'5c'5d'7b'7d'28'29'5d'29 = compileRegex "([^a-zA-Z0-9_\\s[\\]{}()])"
regex_'5cs'2b'23'2e'2a = compileRegex "\\s+#.*"
regex_'5c'5c'5bUuLlEtnaefr'5d = compileRegex "\\\\[UuLlEtnaefr]"
regex_'5c'5c'2e = compileRegex "\\\\."
regex_'28'3f'3a'5b'5c'24'40'5d'5cS'7c'25'5b'5cw'7b'5d'29 = compileRegex "(?:[\\$@]\\S|%[\\w{])"
regex_'28'5b'5e'5cw'5cs'5b'5c'5d'7b'7d'28'29'5d'29 = compileRegex "([^\\w\\s[\\]{}()])"
regex_'5cs'2b'23'2e'2a'24 = compileRegex "\\s+#.*$"
regex_'23'2e'2a'24 = compileRegex "#.*$"
regex_'5c'7d'5bcegimosx'5d'2a = compileRegex "\\}[cegimosx]*"
regex_'5c'29'5bcegimosx'5d'2a = compileRegex "\\)[cegimosx]*"
regex_'5c'5d'5bcegimosx'5d'2a = compileRegex "\\][cegimosx]*"
regex_'27'5bcegimosx'5d'2a = compileRegex "'[cegimosx]*"
regex_'5c'28'5b'5e'29'5d'2a'5c'29'5cs'2a'5c'28'3f'3a'5b'5e'29'5d'2a'5c'29 = compileRegex "\\([^)]*\\)\\s*\\(?:[^)]*\\)"
regex_'7b'5b'5e'7d'5d'2a'5c'7d'5cs'2a'5c'7b'5b'5e'7d'5d'2a'5c'7d = compileRegex "{[^}]*\\}\\s*\\{[^}]*\\}"
regex_'5c'5b'5b'5e'7d'5d'2a'5c'5d'5cs'2a'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d = compileRegex "\\[[^}]*\\]\\s*\\[[^\\]]*\\]"
regex_'28'5b'5ea'2dzA'2dZ0'2d9'5f'5cs'5b'5c'5d'7b'7d'28'29'5d'29'2e'2a'5c1'2e'2a'5c1 = compileRegex "([^a-zA-Z0-9_\\s[\\]{}()]).*\\1.*\\1"
regex_'28'5b'5e'5cw'5cs'5d'29 = compileRegex "([^\\w\\s])"
regex_'5c'24'28'3f'3d'2f'29 = compileRegex "\\$(?=/)"
regex_'2f'5bcgimosx'5d'2a = compileRegex "/[cgimosx]*"
regex_'5c'7d'5bcgimosx'5d'2a = compileRegex "\\}[cgimosx]*"
regex_'5c'5d'5bcgimosx'5d'2a = compileRegex "\\][cgimosx]*"
regex_'5c'29'5bcgimosx'5d'2a = compileRegex "\\)[cgimosx]*"
regex_'27'5bcgimosx'5d'2a = compileRegex "'[cgimosx]*"
regex_'5c'5c'5banDdSsWw'5d = compileRegex "\\\\[anDdSsWw]"
regex_'5c'5c'5bABbEGLlNUuQdQZz'5d = compileRegex "\\\\[ABbEGLlNUuQdQZz]"
regex_'5c'5c'5b'5cd'5d'2b = compileRegex "\\\\[\\d]+"
regex_'5b'28'29'3f'5c'5e'2a'2b'7c'5d = compileRegex "[()?\\^*+|]"
regex_'5c'7b'5b'5cd'2c_'5d'2b'5c'7d = compileRegex "\\{[\\d, ]+\\}"
regex_'5cs'7b3'2c'7d'23'2e'2a'24 = compileRegex "\\s{3,}#.*$"
regex_'5b'24'40'5d'5b'5e'5c'5d'5cs'7b'7d'28'29'7c'3e'27'5d = compileRegex "[$@][^\\]\\s{}()|>']"
regex_'5c'23'5b'5e'29'5d'2a = compileRegex "\\#[^)]*"
regex_'5b'3a'3d'21'3e'3c'5d'2b = compileRegex "[:=!><]+"
regex_'5c'5b'3a'5c'5e'3f'5ba'2dz'5d'2b'3a'5c'5d = compileRegex "\\[:\\^?[a-z]+:\\]"
regex_'5c'24'5b0'2d9'5d'2b = compileRegex "\\$[0-9]+"
regex_'5b'40'5c'24'5d'28'3f'3a'5b'5c'2b'5c'2d'5f'5d'5cB'7cARGV'5cb'7cINC'5cb'29 = compileRegex "[@\\$](?:[\\+\\-_]\\B|ARGV\\b|INC\\b)"
regex_'5b'25'5c'24'5d'28'3f'3aINC'5cb'7cENV'5cb'7cSIG'5cb'29 = compileRegex "[%\\$](?:INC\\b|ENV\\b|SIG\\b)"
regex_'5c'24'5c'24'5b'5c'24'5cw'5f'5d = compileRegex "\\$\\$[\\$\\w_]"
regex_'5c'24'5b'23'5f'5d'5b'5cw'5f'5d = compileRegex "\\$[#_][\\w_]"
regex_'5c'24'2b'3a'3a = compileRegex "\\$+::"
regex_'5c'24'5b'5ea'2dzA'2dZ0'2d9'5cs'7b'5d'5bA'2dZ'5d'3f = compileRegex "\\$[^a-zA-Z0-9\\s{][A-Z]?"
regex_'5b'5c'24'40'25'5d'5c'7b'5b'5cw'5f'5d'2b'5c'7d = compileRegex "[\\$@%]\\{[\\w_]+\\}"
regex_'5c'2a'5ba'2dzA'2dZ'5f'5d'2b = compileRegex "\\*[a-zA-Z_]+"
regex_'5c'2a'5b'5ea'2dzA'2dZ0'2d9'5cs'7b'5d'5bA'2dZ'5d'3f = compileRegex "\\*[^a-zA-Z0-9\\s{][A-Z]?"
regex_'5b'5c'24'40'25'5d = compileRegex "[\\$@%]"
regex_'5c'2a'5cw'2b = compileRegex "\\*\\w+"
regex_'5b'5cw'5f'5d'2b = compileRegex "[\\w_]+"
regex_'28'5cw'2b'29'5cs'2a'3b'3f = compileRegex "(\\w+)\\s*;?"
regex_'5cs'2a'22'28'5b'5e'22'5d'2b'29'22'5cs'2a'3b'3f = compileRegex "\\s*\"([^\"]+)\"\\s*;?"
regex_'5cs'2a'60'28'5b'5e'60'5d'2b'29'60'5cs'2a'3b'3f = compileRegex "\\s*`([^`]+)`\\s*;?"
regex_'5cs'2a'27'28'5b'5e'27'5d'2b'29'27'5cs'2a'3b'3f = compileRegex "\\s*'([^']+)'\\s*;?"
regex_'5c'3d'5cs'2a'3c'3c'5cs'2a'5b'22'27'5d'3f'28'5bA'2dZ0'2d9'5f'5c'2d'5d'2b'29'5b'22'27'5d'3f = compileRegex "\\=\\s*<<\\s*[\"']?([A-Z0-9_\\-]+)[\"']?"
regex_'5c'3d'28'3f'3ahead'5b1'2d6'5d'7cover'7cback'7citem'7cfor'7cbegin'7cend'7cpod'29'5cs'2b'2e'2a = compileRegex "\\=(?:head[1-6]|over|back|item|for|begin|end|pod)\\s+.*"
regex_'5c'3d'28'3f'3ahead'5b1'2d6'5d'7cover'7cback'7citem'7cfor'7cbegin'7cend'7cpod'29'5cs'2a'2e'2a = compileRegex "\\=(?:head[1-6]|over|back|item|for|begin|end|pod)\\s*.*"
regex_'5cs'2a'5c'5d'3f'5cs'2a'2f = compileRegex "\\s*\\]?\\s*/"
regex_'5cs'2a'5c'7d'3f'5cs'2a'2f = compileRegex "\\s*\\}?\\s*/"
regex_'5cs'2a'5c'29'3f'5cs'2a'2f = compileRegex "\\s*\\)?\\s*/"
regex_'5cw'2b = compileRegex "\\w+"
regex_'5c'24'5cS = compileRegex "\\$\\S"
regex_'5cs'2a'5c'28 = compileRegex "\\s*\\("
regex_'5c'3dcut'2e'2a'24 = compileRegex "\\=cut.*$"

defaultAttributes = [("normal","Normal Text"),("find_quoted","Normal Text"),("find_qqx","Normal Text"),("find_qw","Normal Text"),("ipstring_internal","String (interpolated)"),("ip_string","String (interpolated)"),("ip_string_2","String (interpolated)"),("ip_string_3","String (interpolated)"),("ip_string_4","String (interpolated)"),("ip_string_5","String (interpolated)"),("ip_string_6","String (interpolated)"),("string","String"),("string_2","String"),("string_3","String"),("string_4","String"),("string_5","String"),("string_6","String"),("find_subst","Normal Text"),("subst_curlybrace_pattern","Pattern"),("subst_curlybrace_middle","Normal Text"),("subst_curlybrace_replace","String (interpolated)"),("subst_curlybrace_replace_recursive","String (interpolated)"),("subst_paren_pattern","Pattern"),("subst_paren_replace","String (interpolated)"),("subst_bracket_pattern","Pattern"),("subst_bracket_replace","String (interpolated)"),("subst_slash_pattern","Pattern"),("subst_slash_replace","String (interpolated)"),("subst_sq_pattern","Pattern"),("subst_sq_replace","String"),("tr","Pattern"),("find_pattern","Pattern"),("pattern_slash","Pattern"),("pattern","Pattern"),("pattern_brace","Pattern"),("pattern_bracket","Pattern"),("pattern_paren","Pattern"),("pattern_sq","Pattern"),("regex_pattern_internal_rules_1",""),("regex_pattern_internal_rules_2",""),("regex_pattern_internal","Pattern"),("regex_pattern_internal_ip","Pattern"),("pat_ext","Pattern Internal Operator"),("pat_char_class","Pattern Character Class"),("find_variable","Data Type"),("find_variable_unsafe","Data Type"),("var_detect","Data Type"),("var_detect_unsafe","Data Type"),("var_detect_rules","Data Type"),("quote_word","Normal Text"),("quote_word_paren","Normal Text"),("quote_word_brace","Normal Text"),("quote_word_bracket","Normal Text"),("find_here_document","Normal Text"),("here_document","String (interpolated)"),("here_document_dumb","Normal Text"),("data_handle","Data"),("end_handle","Nothing"),("Backticked","String (interpolated)"),("slash_safe_escape","Normal Text"),("package_qualified_blank","Normal Text"),("sub_name_def","Normal Text"),("sub_arg_definition","Normal Text"),("pod","Pod"),("comment","Comment")]

parseRules "normal" = 
  do (attr, result) <- (((pColumn 0 >> pRegExpr regex_'23'21'5c'2f'2e'2a >>= withAttribute "Keyword"))
                        <|>
                        ((pFirstNonSpace >> pString False "__DATA__" >>= withAttribute "Keyword") >>~ pushContext "data_handle")
                        <|>
                        ((pFirstNonSpace >> pString False "__END__" >>= withAttribute "Keyword"))
                        <|>
                        ((pRegExpr regex_'5cbsub'5cs'2b >>= withAttribute "Keyword") >>~ pushContext "sub_name_def")
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_keywords >>= withAttribute "Keyword"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_operators >>= withAttribute "Operator"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_functions >>= withAttribute "Function"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_pragmas >>= withAttribute "Pragma"))
                        <|>
                        ((pColumn 0 >> pRegExpr regex_'5c'3d'28'3f'3ahead'5b1'2d6'5d'7cover'7cback'7citem'7cfor'7cbegin'7cend'7cpod'29'28'5cs'7c'24'29 >>= withAttribute "Pod") >>~ pushContext "pod")
                        <|>
                        ((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '#' >>= withAttribute "Comment") >>~ pushContext "comment")
                        <|>
                        ((pHlCOct >>= withAttribute "Octal") >>~ pushContext "slash_safe_escape")
                        <|>
                        ((pHlCHex >>= withAttribute "Hex") >>~ pushContext "slash_safe_escape")
                        <|>
                        ((pFloat >>= withAttribute "Float") >>~ pushContext "slash_safe_escape")
                        <|>
                        ((pInt >>= withAttribute "Decimal") >>~ pushContext "slash_safe_escape")
                        <|>
                        ((pRegExpr regex_'5c'5c'28'5b'22'27'5d'29'5b'5e'5c1'5d >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetect2Chars False '&' '\'' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "Operator") >>~ pushContext "ip_string")
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Operator") >>~ pushContext "string")
                        <|>
                        ((pDetectChar False '`' >>= withAttribute "Operator") >>~ pushContext "Backticked")
                        <|>
                        ((lookAhead (pRegExpr regex_'28'3f'3a'5b'24'40'5d'5cS'7c'25'5b'5cw'7b'5d'7c'5c'2a'5b'5e'5cd'5c'2a'7b'5c'24'40'25'3d'28'5d'29) >> return ([],"") ) >>~ pushContext "find_variable")
                        <|>
                        ((pRegExpr regex_'3c'5bA'2dZ0'2d9'5f'5d'2b'3e >>= withAttribute "Keyword"))
                        <|>
                        ((pRegExpr regex_'5cs'2a'3c'3c'28'3f'3d'5cw'2b'7c'5cs'2a'5b'22'27'5d'29 >>= withAttribute "Operator") >>~ pushContext "find_here_document")
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'7d'5cs'2a'2f >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'5cs'2a'5b'29'5d'5cs'2a'2f >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'5cw'2b'3a'3a >>= withAttribute "Function") >>~ pushContext "sub_name_def")
                        <|>
                        ((pRegExpr regex_'5cw'2b'5b'3d'5d >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'5cbq'28'3f'3d'5bqwx'5d'3f'5cs'2a'5b'5e'5cw'5cs'5d'29 >>= withAttribute "Operator") >>~ pushContext "find_quoted")
                        <|>
                        ((pRegExpr regex_'5cbs'28'3f'3d'5cs'2a'5b'5e'5cw'5cs'5d'29 >>= withAttribute "Operator") >>~ pushContext "find_subst")
                        <|>
                        ((pRegExpr regex_'5cb'28'3f'3atr'7cy'29'5cs'2a'28'3f'3d'5b'5e'5cw'5cs'5c'5d'7d'29'5d'29 >>= withAttribute "Operator") >>~ pushContext "tr")
                        <|>
                        ((pRegExpr regex_'5cb'28'3f'3am'7cqr'29'28'3f'3d'5cs'2a'5b'5e'5cw'5cs'5c'5d'7d'29'5d'29 >>= withAttribute "Operator") >>~ pushContext "find_pattern")
                        <|>
                        ((pRegExpr regex_'5b'5cw'5f'5d'2b'5cs'2a'2f >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'5b'3c'3e'22'27'3a'5d'2f >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '/' >>= withAttribute "Operator") >>~ pushContext "pattern_slash")
                        <|>
                        ((pRegExpr regex_'2d'5brwxoRWXOeszfdlpSbctugkTBMAC'5d >>= withAttribute "Operator"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text")))
     return (attr, result)

parseRules "find_quoted" = 
  do (attr, result) <- (((pRegExpr regex_x'5cs'2a'28'27'29 >>= withAttribute "Operator") >>~ pushContext "string_6")
                        <|>
                        ((pAnyChar "qx" >>= withAttribute "Operator") >>~ pushContext "find_qqx")
                        <|>
                        ((pDetectChar False 'w' >>= withAttribute "Operator") >>~ pushContext "find_qw")
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Operator") >>~ pushContext "string_2")
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Operator") >>~ pushContext "string_3")
                        <|>
                        ((pDetectChar False '[' >>= withAttribute "Operator") >>~ pushContext "string_4")
                        <|>
                        ((pDetectChar False '<' >>= withAttribute "Operator") >>~ pushContext "string_5")
                        <|>
                        ((pRegExpr regex_'28'5b'5ea'2dzA'2dZ0'2d9'5f'5cs'5b'5c'5d'7b'7d'28'29'5d'29 >>= withAttribute "Operator") >>~ pushContext "string_6")
                        <|>
                        ((pRegExpr regex_'5cs'2b'23'2e'2a >>= withAttribute "Comment")))
     return (attr, result)

parseRules "find_qqx" = 
  do (attr, result) <- (((pDetectChar False '(' >>= withAttribute "Operator") >>~ pushContext "ip_string_2")
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Operator") >>~ pushContext "ip_string_3")
                        <|>
                        ((pDetectChar False '[' >>= withAttribute "Operator") >>~ pushContext "ip_string_4")
                        <|>
                        ((pDetectChar False '<' >>= withAttribute "Operator") >>~ pushContext "ip_string_5")
                        <|>
                        ((pRegExpr regex_'28'5b'5ea'2dzA'2dZ0'2d9'5f'5cs'5b'5c'5d'7b'7d'28'29'5d'29 >>= withAttribute "Operator") >>~ pushContext "ip_string_6")
                        <|>
                        ((pRegExpr regex_'5cs'2b'23'2e'2a >>= withAttribute "Comment")))
     return (attr, result)

parseRules "find_qw" = 
  do (attr, result) <- (((pDetectChar False '(' >>= withAttribute "Operator") >>~ pushContext "quote_word_paren")
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Operator") >>~ pushContext "quote_word_brace")
                        <|>
                        ((pDetectChar False '[' >>= withAttribute "Operator") >>~ pushContext "quote_word_bracket")
                        <|>
                        ((pRegExpr regex_'28'5b'5ea'2dzA'2dZ0'2d9'5f'5cs'5b'5c'5d'7b'7d'28'29'5d'29 >>= withAttribute "Operator") >>~ pushContext "quote_word")
                        <|>
                        ((pRegExpr regex_'5cs'2b'23'2e'2a >>= withAttribute "Comment")))
     return (attr, result)

parseRules "ipstring_internal" = 
  do (attr, result) <- (((pDetectIdentifier >>= withAttribute "String (interpolated)"))
                        <|>
                        ((pRegExpr regex_'5c'5c'5bUuLlEtnaefr'5d >>= withAttribute "String Special Character"))
                        <|>
                        ((pRegExpr regex_'5c'5c'2e >>= withAttribute "String (interpolated)"))
                        <|>
                        ((lookAhead (pRegExpr regex_'28'3f'3a'5b'5c'24'40'5d'5cS'7c'25'5b'5cw'7b'5d'29) >> return ([],"") ) >>~ pushContext "find_variable_unsafe"))
     return (attr, result)

parseRules "ip_string" = 
  do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "Operator") >>~ (popContext >> return ()))
                        <|>
                        ((parseRules "ipstring_internal")))
     return (attr, result)

parseRules "ip_string_2" = 
  do (attr, result) <- (((pRangeDetect '(' ')' >>= withAttribute "String (interpolated)"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "ipstring_internal")))
     return (attr, result)

parseRules "ip_string_3" = 
  do (attr, result) <- (((pRangeDetect '{' '}' >>= withAttribute "String (interpolated)"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "ipstring_internal")))
     return (attr, result)

parseRules "ip_string_4" = 
  do (attr, result) <- (((pRangeDetect '[' ']' >>= withAttribute "String (interpolated)"))
                        <|>
                        ((pDetectChar False ']' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "ipstring_internal")))
     return (attr, result)

parseRules "ip_string_5" = 
  do (attr, result) <- (((pRangeDetect '<' '>' >>= withAttribute "String (interpolated)"))
                        <|>
                        ((pDetectChar False '>' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "ipstring_internal")))
     return (attr, result)

parseRules "ip_string_6" = 
  do (attr, result) <- (((pRegExprDynamic "\\%1" >>= withAttribute "String (interpolated)"))
                        <|>
                        ((pDetectChar True '1' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "ipstring_internal")))
     return (attr, result)

parseRules "string" = 
  do (attr, result) <- (((pDetectIdentifier >>= withAttribute "String"))
                        <|>
                        ((pDetect2Chars False '\\' '\'' >>= withAttribute "String Special Character"))
                        <|>
                        ((pDetect2Chars False '\\' '\\' >>= withAttribute "String Special Character"))
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Operator") >>~ (popContext >> return ())))
     return (attr, result)

parseRules "string_2" = 
  do (attr, result) <- (((pDetectIdentifier >>= withAttribute "String"))
                        <|>
                        ((pDetect2Chars False '\\' ')' >>= withAttribute "String Special Character"))
                        <|>
                        ((pDetect2Chars False '\\' '\\' >>= withAttribute "String Special Character"))
                        <|>
                        ((pRangeDetect '(' ')' >>= withAttribute "String"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ())))
     return (attr, result)

parseRules "string_3" = 
  do (attr, result) <- (((pDetectIdentifier >>= withAttribute "String"))
                        <|>
                        ((pDetect2Chars False '\\' '}' >>= withAttribute "String Special Character"))
                        <|>
                        ((pDetect2Chars False '\\' '\\' >>= withAttribute "String Special Character"))
                        <|>
                        ((pRangeDetect '{' '}' >>= withAttribute "String"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ())))
     return (attr, result)

parseRules "string_4" = 
  do (attr, result) <- (((pDetectIdentifier >>= withAttribute "String"))
                        <|>
                        ((pDetect2Chars False '\\' ']' >>= withAttribute "String Special Character"))
                        <|>
                        ((pDetect2Chars False '\\' '\\' >>= withAttribute "String Special Character"))
                        <|>
                        ((pRangeDetect '[' ']' >>= withAttribute "String"))
                        <|>
                        ((pDetectChar False ']' >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ())))
     return (attr, result)

parseRules "string_5" = 
  do (attr, result) <- (((pDetectIdentifier >>= withAttribute "String"))
                        <|>
                        ((pDetect2Chars False '\\' '<' >>= withAttribute "String Special Character"))
                        <|>
                        ((pDetect2Chars False '\\' '\\' >>= withAttribute "String Special Character"))
                        <|>
                        ((pDetect2Chars False '\\' '>' >>= withAttribute "String"))
                        <|>
                        ((pRangeDetect '<' '>' >>= withAttribute "String"))
                        <|>
                        ((pDetectChar False '>' >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ())))
     return (attr, result)

parseRules "string_6" = 
  do (attr, result) <- (((pDetectIdentifier >>= withAttribute "String"))
                        <|>
                        ((pDetect2Chars False '\\' '\\' >>= withAttribute "String Special Character"))
                        <|>
                        ((pRegExprDynamic "\\%1" >>= withAttribute "String Special Character"))
                        <|>
                        ((pDetectChar True '1' >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ())))
     return (attr, result)

parseRules "find_subst" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2b'23'2e'2a >>= withAttribute "Comment"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Operator") >>~ pushContext "subst_curlybrace_pattern")
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Operator") >>~ pushContext "subst_paren_pattern")
                        <|>
                        ((pDetectChar False '[' >>= withAttribute "Operator") >>~ pushContext "subst_bracket_pattern")
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Operator") >>~ pushContext "subst_sq_pattern")
                        <|>
                        ((pRegExpr regex_'28'5b'5e'5cw'5cs'5b'5c'5d'7b'7d'28'29'5d'29 >>= withAttribute "Operator") >>~ pushContext "subst_slash_pattern"))
     return (attr, result)

parseRules "subst_curlybrace_pattern" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2b'23'2e'2a'24 >>= withAttribute "Comment"))
                        <|>
                        ((parseRules "regex_pattern_internal_ip"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Operator") >>~ pushContext "subst_curlybrace_middle"))
     return (attr, result)

parseRules "subst_curlybrace_middle" = 
  do (attr, result) <- (((pRegExpr regex_'23'2e'2a'24 >>= withAttribute "Comment"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Operator") >>~ pushContext "subst_curlybrace_replace"))
     return (attr, result)

parseRules "subst_curlybrace_replace" = 
  do (attr, result) <- (((parseRules "ipstring_internal"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Normal Text") >>~ pushContext "subst_curlybrace_replace_recursive")
                        <|>
                        ((pRegExpr regex_'5c'7d'5bcegimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> popContext >> return ())))
     return (attr, result)

parseRules "subst_curlybrace_replace_recursive" = 
  do (attr, result) <- (((pDetectChar False '{' >>= withAttribute "String (interpolated)") >>~ pushContext "subst_curlybrace_replace_recursive")
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Normal Text") >>~ (popContext >> return ()))
                        <|>
                        ((parseRules "ipstring_internal")))
     return (attr, result)

parseRules "subst_paren_pattern" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2b'23'2e'2a'24 >>= withAttribute "Comment"))
                        <|>
                        ((parseRules "regex_pattern_internal_ip"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Operator") >>~ pushContext "subst_paren_replace"))
     return (attr, result)

parseRules "subst_paren_replace" = 
  do (attr, result) <- (((parseRules "ipstring_internal"))
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Operator"))
                        <|>
                        ((pRegExpr regex_'5c'29'5bcegimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ())))
     return (attr, result)

parseRules "subst_bracket_pattern" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2b'23'2e'2a'24 >>= withAttribute "Comment"))
                        <|>
                        ((parseRules "regex_pattern_internal_ip"))
                        <|>
                        ((pDetectChar False ']' >>= withAttribute "Operator") >>~ pushContext "subst_bracket_replace"))
     return (attr, result)

parseRules "subst_bracket_replace" = 
  do (attr, result) <- (((parseRules "ipstring_internal"))
                        <|>
                        ((pDetectChar False '[' >>= withAttribute "Operator"))
                        <|>
                        ((pRegExpr regex_'5c'5d'5bcegimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ())))
     return (attr, result)

parseRules "subst_slash_pattern" = 
  do (attr, result) <- (((pRegExprDynamic "\\$(?=%1)" >>= withAttribute "Pattern Internal Operator"))
                        <|>
                        ((pRegExprDynamic "(%1)" >>= withAttribute "Operator") >>~ pushContext "subst_slash_replace")
                        <|>
                        ((parseRules "regex_pattern_internal_ip")))
     return (attr, result)

parseRules "subst_slash_replace" = 
  do (attr, result) <- (((parseRules "ipstring_internal"))
                        <|>
                        ((pRegExprDynamic "%1[cegimosx]*" >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ())))
     return (attr, result)

parseRules "subst_sq_pattern" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2b'23'2e'2a'24 >>= withAttribute "Comment"))
                        <|>
                        ((parseRules "regex_pattern_internal"))
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Operator") >>~ pushContext "subst_sq_replace"))
     return (attr, result)

parseRules "subst_sq_replace" = 
  do (attr, result) <- ((pRegExpr regex_'27'5bcegimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ()))
     return (attr, result)

parseRules "tr" = 
  do (attr, result) <- (((pRegExpr regex_'5c'28'5b'5e'29'5d'2a'5c'29'5cs'2a'5c'28'3f'3a'5b'5e'29'5d'2a'5c'29 >>= withAttribute "Pattern") >>~ (popContext >> return ()))
                        <|>
                        ((pRegExpr regex_'7b'5b'5e'7d'5d'2a'5c'7d'5cs'2a'5c'7b'5b'5e'7d'5d'2a'5c'7d >>= withAttribute "Pattern") >>~ (popContext >> return ()))
                        <|>
                        ((pRegExpr regex_'5c'5b'5b'5e'7d'5d'2a'5c'5d'5cs'2a'5c'5b'5b'5e'5c'5d'5d'2a'5c'5d >>= withAttribute "Pattern") >>~ (popContext >> return ()))
                        <|>
                        ((pRegExpr regex_'28'5b'5ea'2dzA'2dZ0'2d9'5f'5cs'5b'5c'5d'7b'7d'28'29'5d'29'2e'2a'5c1'2e'2a'5c1 >>= withAttribute "Pattern") >>~ (popContext >> return ()))
                        <|>
                        ((popContext >> return ()) >> return ([], "")))
     return (attr, result)

parseRules "find_pattern" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2b'23'2e'2a >>= withAttribute "Comment"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Operator") >>~ pushContext "pattern_brace")
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Operator") >>~ pushContext "pattern_paren")
                        <|>
                        ((pDetectChar False '[' >>= withAttribute "Operator") >>~ pushContext "pattern_bracket")
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Operator") >>~ pushContext "pattern_sq")
                        <|>
                        ((pRegExpr regex_'28'5b'5e'5cw'5cs'5d'29 >>= withAttribute "Operator") >>~ pushContext "pattern"))
     return (attr, result)

parseRules "pattern_slash" = 
  do (attr, result) <- (((pRegExpr regex_'5c'24'28'3f'3d'2f'29 >>= withAttribute "Pattern Internal Operator"))
                        <|>
                        ((parseRules "regex_pattern_internal_ip"))
                        <|>
                        ((pRegExpr regex_'2f'5bcgimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> return ())))
     return (attr, result)

parseRules "pattern" = 
  do (attr, result) <- (((pRegExprDynamic "\\$(?=%1)" >>= withAttribute "Pattern Internal Operator"))
                        <|>
                        ((pRegExprDynamic "%1[cgimosx]*" >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "regex_pattern_internal_ip"))
                        <|>
                        ((pRegExprDynamic "\\$(?=\\%1)" >>= withAttribute "Pattern Internal Operator")))
     return (attr, result)

parseRules "pattern_brace" = 
  do (attr, result) <- (((pRegExpr regex_'5c'7d'5bcgimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "regex_pattern_internal_ip")))
     return (attr, result)

parseRules "pattern_bracket" = 
  do (attr, result) <- (((pRegExpr regex_'5c'5d'5bcgimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "regex_pattern_internal_ip")))
     return (attr, result)

parseRules "pattern_paren" = 
  do (attr, result) <- (((pRegExpr regex_'5c'29'5bcgimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "regex_pattern_internal_ip")))
     return (attr, result)

parseRules "pattern_sq" = 
  do (attr, result) <- (((pRegExpr regex_'27'5bcgimosx'5d'2a >>= withAttribute "Operator") >>~ (popContext >> popContext >> return ()))
                        <|>
                        ((parseRules "regex_pattern_internal")))
     return (attr, result)

parseRules "regex_pattern_internal_rules_1" = 
  do (attr, result) <- (((pFirstNonSpace >> pRegExpr regex_'23'2e'2a'24 >>= withAttribute "Comment"))
                        <|>
                        ((pRegExpr regex_'5c'5c'5banDdSsWw'5d >>= withAttribute "Pattern Character Class"))
                        <|>
                        ((pRegExpr regex_'5c'5c'5bABbEGLlNUuQdQZz'5d >>= withAttribute "Pattern Internal Operator"))
                        <|>
                        ((pRegExpr regex_'5c'5c'5b'5cd'5d'2b >>= withAttribute "Special Variable"))
                        <|>
                        ((pRegExpr regex_'5c'5c'2e >>= withAttribute "Pattern")))
     return (attr, result)

parseRules "regex_pattern_internal_rules_2" = 
  do (attr, result) <- (((pDetect2Chars False '(' '?' >>= withAttribute "Pattern Internal Operator") >>~ pushContext "pat_ext")
                        <|>
                        ((pDetectChar False '[' >>= withAttribute "Pattern Internal Operator") >>~ pushContext "pat_char_class")
                        <|>
                        ((pRegExpr regex_'5b'28'29'3f'5c'5e'2a'2b'7c'5d >>= withAttribute "Pattern Internal Operator"))
                        <|>
                        ((pRegExpr regex_'5c'7b'5b'5cd'2c_'5d'2b'5c'7d >>= withAttribute "Pattern Internal Operator"))
                        <|>
                        ((pDetectChar False '$' >>= withAttribute "Pattern Internal Operator"))
                        <|>
                        ((pRegExpr regex_'5cs'7b3'2c'7d'23'2e'2a'24 >>= withAttribute "Comment")))
     return (attr, result)

parseRules "regex_pattern_internal" = 
  do (attr, result) <- (((parseRules "regex_pattern_internal_rules_1"))
                        <|>
                        ((parseRules "regex_pattern_internal_rules_2")))
     return (attr, result)

parseRules "regex_pattern_internal_ip" = 
  do (attr, result) <- (((parseRules "regex_pattern_internal_rules_1"))
                        <|>
                        ((lookAhead (pRegExpr regex_'5b'24'40'5d'5b'5e'5c'5d'5cs'7b'7d'28'29'7c'3e'27'5d) >> return ([],"") ) >>~ pushContext "find_variable_unsafe")
                        <|>
                        ((parseRules "regex_pattern_internal_rules_2")))
     return (attr, result)

parseRules "pat_ext" = 
  do (attr, result) <- (((pRegExpr regex_'5c'23'5b'5e'29'5d'2a >>= withAttribute "Comment") >>~ (popContext >> return ()))
                        <|>
                        ((pRegExpr regex_'5b'3a'3d'21'3e'3c'5d'2b >>= withAttribute "Pattern Internal Operator") >>~ (popContext >> return ()))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Pattern Internal Operator") >>~ (popContext >> return ())))
     return (attr, result)

parseRules "pat_char_class" = 
  do (attr, result) <- (((pDetectChar False '^' >>= withAttribute "Pattern Internal Operator"))
                        <|>
                        ((pDetect2Chars False '\\' '\\' >>= withAttribute "Pattern Character Class"))
                        <|>
                        ((pDetect2Chars False '\\' ']' >>= withAttribute "Pattern Character Class"))
                        <|>
                        ((pRegExpr regex_'5c'5b'3a'5c'5e'3f'5ba'2dz'5d'2b'3a'5c'5d >>= withAttribute "Pattern Character Class"))
                        <|>
                        ((pDetectChar False ']' >>= withAttribute "Pattern Internal Operator") >>~ (popContext >> return ())))
     return (attr, result)

parseRules "find_variable" = 
  do (attr, result) <- (((pRegExpr regex_'5c'24'5b0'2d9'5d'2b >>= withAttribute "Special Variable") >>~ pushContext "var_detect")
                        <|>
                        ((pRegExpr regex_'5b'40'5c'24'5d'28'3f'3a'5b'5c'2b'5c'2d'5f'5d'5cB'7cARGV'5cb'7cINC'5cb'29 >>= withAttribute "Special Variable") >>~ pushContext "var_detect")
                        <|>
                        ((pRegExpr regex_'5b'25'5c'24'5d'28'3f'3aINC'5cb'7cENV'5cb'7cSIG'5cb'29 >>= withAttribute "Special Variable") >>~ pushContext "var_detect")
                        <|>
                        ((pRegExpr regex_'5c'24'5c'24'5b'5c'24'5cw'5f'5d >>= withAttribute "Data Type") >>~ pushContext "var_detect")
                        <|>
                        ((pRegExpr regex_'5c'24'5b'23'5f'5d'5b'5cw'5f'5d >>= withAttribute "Data Type") >>~ pushContext "var_detect")
                        <|>
                        ((pRegExpr regex_'5c'24'2b'3a'3a >>= withAttribute "Data Type") >>~ pushContext "var_detect")
                        <|>
                        ((pRegExpr regex_'5c'24'5b'5ea'2dzA'2dZ0'2d9'5cs'7b'5d'5bA'2dZ'5d'3f >>= withAttribute "Special Variable"))
                        <|>
                        ((pRegExpr regex_'5b'5c'24'40'25'5d'5c'7b'5b'5cw'5f'5d'2b'5c'7d >>= withAttribute "Data Type") >>~ pushContext "var_detect")
                        <|>
                        ((pAnyChar "$@%" >>= withAttribute "Data Type") >>~ pushContext "var_detect")
                        <|>
                        ((pRegExpr regex_'5c'2a'5ba'2dzA'2dZ'5f'5d'2b >>= withAttribute "Data Type") >>~ pushContext "var_detect")
                        <|>
                        ((pRegExpr regex_'5c'2a'5b'5ea'2dzA'2dZ0'2d9'5cs'7b'5d'5bA'2dZ'5d'3f >>= withAttribute "Special Variable"))
                        <|>
                        ((pAnyChar "$@%*" >>= withAttribute "Operator") >>~ (popContext >> return ()))
                        <|>
                        ((popContext >> return ()) >> return ([], "")))
     return (attr, result)

parseRules "find_variable_unsafe" = 
  do (attr, result) <- (((pRegExpr regex_'5c'24'5b0'2d9'5d'2b >>= withAttribute "Special Variable") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pRegExpr regex_'5b'40'5c'24'5d'28'3f'3a'5b'5c'2b'5c'2d'5f'5d'5cB'7cARGV'5cb'7cINC'5cb'29 >>= withAttribute "Special Variable") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pRegExpr regex_'5b'25'5c'24'5d'28'3f'3aINC'5cb'7cENV'5cb'7cSIG'5cb'29 >>= withAttribute "Special Variable") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pRegExpr regex_'5c'24'5c'24'5b'5c'24'5cw'5f'5d >>= withAttribute "Data Type") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pRegExpr regex_'5c'24'5b'23'5f'5d'5b'5cw'5f'5d >>= withAttribute "Data Type") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pRegExpr regex_'5c'24'2b'3a'3a >>= withAttribute "Data Type") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pRegExpr regex_'5c'24'5b'5ea'2dzA'2dZ0'2d9'5cs'7b'5d'5bA'2dZ'5d'3f >>= withAttribute "Special Variable"))
                        <|>
                        ((pRegExpr regex_'5b'5c'24'40'25'5d'5c'7b'5b'5cw'5f'5d'2b'5c'7d >>= withAttribute "Data Type") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pRegExpr regex_'5b'5c'24'40'25'5d >>= withAttribute "Data Type") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pRegExpr regex_'5c'2a'5cw'2b >>= withAttribute "Data Type") >>~ pushContext "var_detect_unsafe")
                        <|>
                        ((pAnyChar "$@%*" >>= withAttribute "Operator") >>~ (popContext >> return ()))
                        <|>
                        ((popContext >> return ()) >> return ([], "")))
     return (attr, result)

parseRules "var_detect" = 
  do (attr, result) <- (((parseRules "var_detect_rules"))
                        <|>
                        ((parseRules "slash_safe_escape"))
                        <|>
                        ((popContext >> popContext >> return ()) >> return ([], "")))
     return (attr, result)

parseRules "var_detect_unsafe" = 
  do (attr, result) <- (((parseRules "var_detect_rules"))
                        <|>
                        ((popContext >> popContext >> return ()) >> return ([], "")))
     return (attr, result)

parseRules "var_detect_rules" = 
  do (attr, result) <- (((pRegExpr regex_'5b'5cw'5f'5d'2b >>= withAttribute "Data Type"))
                        <|>
                        ((pDetect2Chars False ':' ':' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Operator"))
                        <|>
                        ((pDetect2Chars False '-' '>' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetect2Chars False '+' '+' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetect2Chars False '-' '-' >>= withAttribute "Normal Text")))
     return (attr, result)

parseRules "quote_word" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExprDynamic "\\\\%1" >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar True '1' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ())))
     return (attr, result)

parseRules "quote_word_paren" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetect2Chars False '\\' ')' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ())))
     return (attr, result)

parseRules "quote_word_brace" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetect2Chars False '\\' '}' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ())))
     return (attr, result)

parseRules "quote_word_bracket" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetect2Chars False '\\' ']' >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False ']' >>= withAttribute "Operator") >>~ (popContext >> popContext >> popContext >> return ())))
     return (attr, result)

parseRules "find_here_document" = 
  do (attr, result) <- (((pRegExpr regex_'28'5cw'2b'29'5cs'2a'3b'3f >>= withAttribute "Keyword") >>~ pushContext "here_document")
                        <|>
                        ((pRegExpr regex_'5cs'2a'22'28'5b'5e'22'5d'2b'29'22'5cs'2a'3b'3f >>= withAttribute "Keyword") >>~ pushContext "here_document")
                        <|>
                        ((pRegExpr regex_'5cs'2a'60'28'5b'5e'60'5d'2b'29'60'5cs'2a'3b'3f >>= withAttribute "Keyword") >>~ pushContext "here_document")
                        <|>
                        ((pRegExpr regex_'5cs'2a'27'28'5b'5e'27'5d'2b'29'27'5cs'2a'3b'3f >>= withAttribute "Keyword") >>~ pushContext "here_document_dumb"))
     return (attr, result)

parseRules "here_document" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "String (interpolated)"))
                        <|>
                        ((pColumn 0 >> pRegExprDynamic "%1" >>= withAttribute "Keyword") >>~ (popContext >> popContext >> return ()))
                        <|>
                        ((pRegExpr regex_'5c'3d'5cs'2a'3c'3c'5cs'2a'5b'22'27'5d'3f'28'5bA'2dZ0'2d9'5f'5c'2d'5d'2b'29'5b'22'27'5d'3f >>= withAttribute "Keyword") >>~ pushContext "here_document")
                        <|>
                        ((parseRules "ipstring_internal")))
     return (attr, result)

parseRules "here_document_dumb" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pColumn 0 >> pRegExprDynamic "%1" >>= withAttribute "Keyword") >>~ (popContext >> popContext >> return ()))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text")))
     return (attr, result)

parseRules "data_handle" = 
  do (attr, result) <- (((pColumn 0 >> pRegExpr regex_'5c'3d'28'3f'3ahead'5b1'2d6'5d'7cover'7cback'7citem'7cfor'7cbegin'7cend'7cpod'29'5cs'2b'2e'2a >>= withAttribute "Pod") >>~ pushContext "pod")
                        <|>
                        ((pFirstNonSpace >> pString False "__END__" >>= withAttribute "Keyword") >>~ pushContext "normal"))
     return (attr, result)

parseRules "end_handle" = 
  do (attr, result) <- (((pColumn 0 >> pRegExpr regex_'5c'3d'28'3f'3ahead'5b1'2d6'5d'7cover'7cback'7citem'7cfor'7cbegin'7cend'7cpod'29'5cs'2a'2e'2a >>= withAttribute "Pod") >>~ pushContext "pod")
                        <|>
                        ((pFirstNonSpace >> pString False "__DATA__" >>= withAttribute "Keyword") >>~ pushContext "data_handle"))
     return (attr, result)

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

parseRules "slash_safe_escape" = 
  do (attr, result) <- (((pRegExpr regex_'5cs'2a'5c'5d'3f'5cs'2a'2f >>= withAttribute "Normal Text") >>~ (popContext >> return ()))
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'7d'3f'5cs'2a'2f >>= withAttribute "Normal Text") >>~ (popContext >> return ()))
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'29'3f'5cs'2a'2f >>= withAttribute "Normal Text") >>~ (popContext >> return ()))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_keywords >>= withAttribute "Keyword") >>~ (popContext >> return ()))
                        <|>
                        ((popContext >> return ()) >> return ([], "")))
     return (attr, result)

parseRules "package_qualified_blank" = 
  do (attr, result) <- ((pRegExpr regex_'5b'5cw'5f'5d'2b >>= withAttribute "Normal Text") >>~ (popContext >> return ()))
     return (attr, result)

parseRules "sub_name_def" = 
  do (attr, result) <- (((pRegExpr regex_'5cw'2b >>= withAttribute "Function"))
                        <|>
                        ((lookAhead (pRegExpr regex_'5c'24'5cS) >> return ([],"") ) >>~ pushContext "find_variable")
                        <|>
                        ((pRegExpr regex_'5cs'2a'5c'28 >>= withAttribute "Normal Text") >>~ pushContext "sub_arg_definition")
                        <|>
                        ((pDetect2Chars False ':' ':' >>= withAttribute "Normal Text"))
                        <|>
                        ((popContext >> return ()) >> return ([], "")))
     return (attr, result)

parseRules "sub_arg_definition" = 
  do (attr, result) <- (((pAnyChar "*$@%" >>= withAttribute "Data Type"))
                        <|>
                        ((pAnyChar "&\\[];" >>= withAttribute "Normal Text"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Normal Text") >>~ pushContext "slash_safe_escape")
                        <|>
                        ((popContext >> popContext >> return ()) >> return ([], "")))
     return (attr, result)

parseRules "pod" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Pod"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Pod"))
                        <|>
                        ((pColumn 0 >> pRegExpr regex_'5c'3d'28'3f'3ahead'5b1'2d6'5d'7cover'7cback'7citem'7cfor'7cbegin'7cend'7cpod'29'5cs'2a'2e'2a >>= withAttribute "Pod"))
                        <|>
                        ((pColumn 0 >> pRegExpr regex_'5c'3dcut'2e'2a'24 >>= withAttribute "Pod") >>~ (popContext >> return ())))
     return (attr, result)

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

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