{- This module was generated from data in the Kate syntax highlighting file rest.xml, version 2, by -} module Text.Highlighting.Kate.Syntax.Rest (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) -- | Full name of language. syntaxName :: String syntaxName = "reStructuredText" -- | Filename extensions for this language. syntaxExtensions :: String syntaxExtensions = "*.rst" -- | 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 = [("reStructuredText","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 } ("reStructuredText","Normal") -> return () ("reStructuredText","InlineMarkup") -> return () ("reStructuredText","Field") -> return () ("reStructuredText","InterpretedText") -> (popContext) >> pEndLine ("reStructuredText","Role") -> (popContext) >> pEndLine ("reStructuredText","TrailingRole") -> (popContext) >> pEndLine ("reStructuredText","Comment") -> return () ("reStructuredText","CodeBlock") -> return () ("reStructuredText","Code") -> return () _ -> return () else return () withAttribute attr txt = do when (null txt) $ fail "Parser matched no text" updateState $ \st -> st { synStPrevChar = last txt , synStPrevNonspace = synStPrevNonspace st || not (all isSpace txt) } return (attr, txt) regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'2a'5c'2a'5b'5e'5cs'5d'2e'2a'5c'2a'5c'2a'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 = compileRegex True "(^|[-\\s'\"\\(\\[{/:\\.,;!\\?\\\\]|$)" regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'2a'5b'5e'5cs'5d'2e'2a'5c'2a'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 = compileRegex True "(^|[-\\s'\"\\(\\[{/:\\.,;!\\?\\\\]|$)" regex_'5cs'2a'5c'2e'5c'2e_'5c'5b'28'5cd'2b'7c'23'7c'5c'2a'7c'23'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d'5d'2b'29'5c'5d'5cs = compileRegex True "\\s*\\.\\. \\[(\\d+|#|\\*|#[\\w_\\.:\\+\\-]+)\\]\\s" regex_'5cs'2a'5c'2e'5c'2e_'5c'5b'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d'5d'2b'5c'5d'5cs = compileRegex True "\\s*\\.\\. \\[[\\w_\\.:\\+\\-]+\\]\\s" regex_'5cs'2a'28'5c'2e'5c'2e_'28'5f'5f'3a'7c'5f'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d_'5d'2b'3a'28'5cs'7c'24'29'29'7c'5f'5f_'29 = compileRegex True "\\s*(\\.\\. (__:|_[\\w_\\.:\\+\\- ]+:(\\s|$))|__ )" regex_'5cs'2a'5c'2e'5c'2e_code'2dblock'3a'3a = compileRegex True "\\s*\\.\\. code-block::" regex_'5cs'2a'5c'2e'5c'2e_'5b'5cw'2d'5f'5c'2e'5d'2b'3a'3a'28'5cs'7c'24'29 = compileRegex True "\\s*\\.\\. [\\w-_\\.]+::(\\s|$)" regex_'3a'3a'24 = compileRegex True "::$" regex_'5cs'2a'5c'2e'5c'2e_'5c'7c'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d_'5d'2b'5c'7c'5cs'2b'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d'5d'2b'3a'3a'5cs = compileRegex True "\\s*\\.\\. \\|[\\w_\\.:\\+\\- ]+\\|\\s+[\\w_\\.:\\+\\-]+::\\s" regex_'3a'28'3f'3d'28'5b'5e'3a'5d'2a'5c'5c'3a'29'2a'5b'5e'3a'5d'2a'3a'28'5cs'7c'24'29'29 = compileRegex True ":(?=([^:]*\\\\:)*[^:]*:(\\s|$))" regex_'28'5cs'2a'29'5c'2e'5c'2e'5cs'28'3f'21'5b'5cw'2d'5f'5c'2e'5d'2b'3a'3a'28'5cs'7c'24'29'29 = compileRegex True "(\\s*)\\.\\.\\s(?![\\w-_\\.]+::(\\s|$))" regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'60'60'5b'5e'5cs'5d'2e'2a'60'60'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 = compileRegex True "(^|[-\\s'\"\\(\\[{/:\\.,;!\\?\\\\]|$)" regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'7c'5b'5e'5cs'5d'2e'2a'5c'7c'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 = compileRegex True "(^|[-\\s'\"\\(\\[{/:\\.,;!\\?\\\\]|$)" regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5f'60'5b'5e'5cs'5d'2e'2a'60'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 = compileRegex True "(^|[-\\s'\"\\(\\[{/:\\.,;!\\?\\\\]|$)" regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'5b'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d'5d'2b'5c'5d'5f'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 = compileRegex True "(^|[-\\s'\"\\(\\[{/:\\.,;!\\?\\\\]|$)" regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'60'5b'5e'5cs'5d'2e'2a'60'5f'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 = compileRegex True "(^|[-\\s'\"\\(\\[{/:\\.,;!\\?\\\\]|$)" regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5cw'2b'5f'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 = compileRegex True "(^|[-\\s'\"\\(\\[{/:\\.,;!\\?\\\\]|$)" regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'60'5b'5e'5cs'5d'2e'2a'60'28'3f'3d'3a'5b'5cw'2d'5f'5c'2e'5c'2b'5d'2b'3a'29 = compileRegex True "(^|[-\\s'\"\\(\\[{>= withAttribute NormalTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'2a'5b'5e'5cs'5d'2e'2a'5c'2a'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute NormalTok)) <|> ((parseRules ("reStructuredText","InlineMarkup"))) <|> ((pColumn 0 >> pRegExpr regex_'5cs'2a'5c'2e'5c'2e_'5c'5b'28'5cd'2b'7c'23'7c'5c'2a'7c'23'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d'5d'2b'29'5c'5d'5cs >>= withAttribute DataTypeTok)) <|> ((pColumn 0 >> pRegExpr regex_'5cs'2a'5c'2e'5c'2e_'5c'5b'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d'5d'2b'5c'5d'5cs >>= withAttribute DataTypeTok)) <|> ((pColumn 0 >> pRegExpr regex_'5cs'2a'28'5c'2e'5c'2e_'28'5f'5f'3a'7c'5f'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d_'5d'2b'3a'28'5cs'7c'24'29'29'7c'5f'5f_'29 >>= withAttribute DataTypeTok)) <|> ((pColumn 0 >> pRegExpr regex_'5cs'2a'5c'2e'5c'2e_code'2dblock'3a'3a >>= withAttribute DataTypeTok) >>~ pushContext ("reStructuredText","CodeBlock")) <|> ((pColumn 0 >> pRegExpr regex_'5cs'2a'5c'2e'5c'2e_'5b'5cw'2d'5f'5c'2e'5d'2b'3a'3a'28'5cs'7c'24'29 >>= withAttribute DataTypeTok)) <|> ((pRegExpr regex_'3a'3a'24 >>= withAttribute DataTypeTok) >>~ pushContext ("reStructuredText","CodeBlock")) <|> ((pColumn 0 >> pRegExpr regex_'5cs'2a'5c'2e'5c'2e_'5c'7c'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d_'5d'2b'5c'7c'5cs'2b'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d'5d'2b'3a'3a'5cs >>= withAttribute DataTypeTok)) <|> ((pFirstNonSpace >> pRegExpr regex_'3a'28'3f'3d'28'5b'5e'3a'5d'2a'5c'5c'3a'29'2a'5b'5e'3a'5d'2a'3a'28'5cs'7c'24'29'29 >>= withAttribute FunctionTok) >>~ pushContext ("reStructuredText","Field")) <|> ((pColumn 0 >> pRegExpr regex_'28'5cs'2a'29'5c'2e'5c'2e'5cs'28'3f'21'5b'5cw'2d'5f'5c'2e'5d'2b'3a'3a'28'5cs'7c'24'29'29 >>= withAttribute CommentTok) >>~ pushContext ("reStructuredText","Comment")) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","Normal")) >> pDefault >>= withAttribute NormalTok)) parseRules ("reStructuredText","InlineMarkup") = (((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'60'60'5b'5e'5cs'5d'2e'2a'60'60'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute DataTypeTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'7c'5b'5e'5cs'5d'2e'2a'5c'7c'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute FunctionTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5f'60'5b'5e'5cs'5d'2e'2a'60'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute FunctionTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'5b'5b'5cw'5f'5c'2e'3a'5c'2b'5c'2d'5d'2b'5c'5d'5f'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute OtherTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'60'5b'5e'5cs'5d'2e'2a'60'5f'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute OtherTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5cw'2b'5f'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute OtherTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'60'5b'5e'5cs'5d'2e'2a'60'28'3f'3d'3a'5b'5cw'2d'5f'5c'2e'5c'2b'5d'2b'3a'29 >>= withAttribute DecValTok) >>~ pushContext ("reStructuredText","TrailingRole")) <|> ((pRegExpr regex_'3a'5b'5cw'2d'5f'5c'2e'5c'2b'5d'2b'3a'28'3f'3d'60'29 >>= withAttribute KeywordTok) >>~ pushContext ("reStructuredText","Role")) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","InlineMarkup")) >> pDefault >>= withAttribute NormalTok)) parseRules ("reStructuredText","Field") = (((pDetectChar False ':' >>= withAttribute FunctionTok) >>~ (popContext)) <|> ((pDetect2Chars False '\\' ':' >>= withAttribute FunctionTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'2a'5c'2a'5b'5e'5cs'5d'2e'2a'5c'2a'5c'2a'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute FunctionTok)) <|> ((pRegExpr regex_'28'5e'7c'5b'2d'5cs'27'22'5c'28'5c'5b'7b'3c'2f'3a'2018'201c'2019'ab'a1'bf'2010'2011'2012'2013'2014_'5d'29'5c'2a'5b'5e'5cs'5d'2e'2a'5c'2a'28'3f'3d'5b'2d'5cs'2019'201d'bb'2010'2011'2012'2013'2014_'27'22'5c'29'5c'5d'7d'3e'2f'3a'5c'2e'2c'3b'21'5c'3f'5c'5c'5d'7c'24'29 >>= withAttribute FunctionTok)) <|> ((parseRules ("reStructuredText","InlineMarkup"))) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","Field")) >> pDefault >>= withAttribute FunctionTok)) parseRules ("reStructuredText","InterpretedText") = (((pDetectChar False '`' >>= withAttribute DecValTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","InterpretedText")) >> pDefault >>= withAttribute DecValTok)) parseRules ("reStructuredText","Role") = (((pDetectChar False '`' >>= withAttribute DecValTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","Role")) >> pDefault >>= withAttribute KeywordTok)) parseRules ("reStructuredText","TrailingRole") = (((pRegExpr regex_'3a'5b'5cw'2d'5f'5c'2e'5c'2b'5d'2b'3a >>= withAttribute KeywordTok) >>~ (popContext)) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","TrailingRole")) >> pDefault >>= withAttribute KeywordTok)) parseRules ("reStructuredText","Comment") = (((pColumn 0 >> pRegExprDynamic "%1 " >>= withAttribute DataTypeTok)) <|> ((pColumn 0 >> lookAhead (pRegExpr regex_'28'2e'7c'24'29) >> (popContext) >> currentContext >>= parseRules)) <|> ((Text.Highlighting.Kate.Syntax.Alert.parseExpression (Just ("Alerts","")) >>= ((withAttribute CommentTok) . snd))) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","Comment")) >> pDefault >>= withAttribute CommentTok)) parseRules ("reStructuredText","CodeBlock") = (((pColumn 0 >> pRegExpr regex_'28'5cs'2b'29'28'3f'3d'5cS'29 >>= withAttribute DataTypeTok) >>~ pushContext ("reStructuredText","Code")) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","CodeBlock")) >> pDefault >>= withAttribute DataTypeTok)) parseRules ("reStructuredText","Code") = (((pColumn 0 >> pRegExprDynamic "%1" >>= withAttribute DataTypeTok)) <|> ((pColumn 0 >> lookAhead (pRegExpr regex_'28'2e'7c'24'29) >> (popContext >> popContext) >> currentContext >>= parseRules)) <|> (currentContext >>= \x -> guard (x == ("reStructuredText","Code")) >> pDefault >>= withAttribute DataTypeTok)) parseRules ("Alerts", _) = Text.Highlighting.Kate.Syntax.Alert.parseExpression Nothing parseRules x = parseRules ("reStructuredText","Normal") <|> fail ("Unknown context" ++ show x)