module Text.Highlighting.Kate.Syntax.R ( highlight, parseExpression, syntaxName, syntaxExtensions ) where
import Text.Highlighting.Kate.Definitions
import Text.Highlighting.Kate.Common
import Text.ParserCombinators.Parsec
import Control.Monad (when)
import Data.Map (fromList)
import Data.Maybe (fromMaybe, maybeToList)
import qualified Data.Set as Set
syntaxName :: String
syntaxName = "R Script"
syntaxExtensions :: String
syntaxExtensions = "*.R;*.r;*.S;*.s;*.q"
highlight :: String -> Either String [SourceLine]
highlight input =
case runParser parseSource startingState "source" input of
Left err -> Left $ show err
Right result -> Right result
parseExpression :: GenParser Char SyntaxState LabeledSource
parseExpression = do
st <- getState
let oldLang = synStLanguage st
setState $ st { synStLanguage = "R Script" }
context <- currentContext <|> (pushContext "level0" >> 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 [("R Script",["level0"])], synStLanguage = "R Script", synStCurrentLine = "", synStCharsParsedInLine = 0, synStPrevChar = '\n', synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}
parseSourceLine = manyTill parseExpressionInternal pEndLine
pEndLine = do
lookAhead $ newline <|> (eof >> return '\n')
context <- currentContext
case context of
"level0" -> return () >> pHandleEndLine
"ctx0" -> return () >> pHandleEndLine
"parenthesis" -> return () >> pHandleEndLine
"string" -> return () >> pHandleEndLine
"string2" -> return () >> pHandleEndLine
"backquotedsymbol" -> return () >> pHandleEndLine
"Headline" -> (popContext) >> pEndLine
"Comment" -> (popContext) >> pEndLine
"CommonRules" -> return () >> pHandleEndLine
_ -> pHandleEndLine
withAttribute attr txt = do
when (null txt) $ fail "Parser matched no text"
let labs = attr : maybeToList (lookup attr styles)
st <- getState
let oldCharsParsed = synStCharsParsedInLine st
let prevchar = if null txt then '\n' else last txt
updateState $ \st -> st { synStCharsParsedInLine = oldCharsParsed + length txt, synStPrevChar = prevchar }
return (labs, txt)
styles = [("Keyword","kw"),("Identifier","dt"),("String","st"),("Comment","co"),("Reserved Words","ot"),("Error","er"),("String Char","ch"),("Float","fl"),("Int","dv")]
parseExpressionInternal = do
context <- currentContext
parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ lookup context defaultAttributes))
list_controls = Set.fromList $ words $ "for in next break while repeat if else switch function"
list_words = Set.fromList $ words $ "TRUE FALSE NULL NA NA_integer_ NA_real_ NA_complex_ NA_character_ Inf NaN"
regex_'5ba'2dzA'2dZ'5f'5c'2e'5d'5b0'2d9a'2dzA'2dZ'5f'5c'2e'5d'2a'5b'5cs'5d'2a'3d'28'3f'3d'28'5b'5e'3d'5d'7c'24'29'29 = compileRegex "[a-zA-Z_\\.][0-9a-zA-Z_\\.]*[\\s]*=(?=([^=]|$))"
regex_'5ba'2dzA'2dZ'5f'5d'2b'5ba'2dzA'2dZ'5f'5c'2e0'2d9'5d'2a'28'3f'3d'5b'5cs'5d'2a'5b'28'5d'29 = compileRegex "[a-zA-Z_]+[a-zA-Z_\\.0-9]*(?=[\\s]*[(])"
regex_'5c'2e'5ba'2dzA'2dZ'5f'5c'2e'5d'2b'5ba'2dzA'2dZ'5f'5c'2e0'2d9'5d'2a'28'3f'3d'5b'5cs'5d'2a'5b'28'5d'29 = compileRegex "\\.[a-zA-Z_\\.]+[a-zA-Z_\\.0-9]*(?=[\\s]*[(])"
regex_'5c'28 = compileRegex "\\("
regex_'28'5b'5c'2b'5c'2d'5c'2a'2f'5c'5e'5c'3a'5c'24'7e'21'26'5c'7c'3d'3e'40'5e'5d'29'28'5b'3c'5d'7b1'2c2'7d'5c'2d'7c'5c'2d'5b'3e'5d'7b1'2c2'7d'29 = compileRegex "([\\+\\-\\*/\\^\\:\\$~!&\\|=>@^])([<]{1,2}\\-|\\-[>]{1,2})"
regex_'28'5b'3c'5d'7b1'2c2'7d'5c'2d'7c'5c'2d'5b'3e'5d'7b1'2c2'7d'29'28'5b'5c'2b'5c'2d'5c'2a'2f'5c'5e'5c'3a'5c'24'7e'21'26'5c'7c'3d'3c'40'5d'29 = compileRegex "([<]{1,2}\\-|\\-[>]{1,2})([\\+\\-\\*/\\^\\:\\$~!&\\|=<@])"
regex_'28'5b'3c'5d'7b3'7d'7c'5b'3e'5d'7b3'7d'29 = compileRegex "([<]{3}|[>]{3})"
regex_'5b'3c'5d'7b1'2c2'7d'5c'2d = compileRegex "[<]{1,2}\\-"
regex_'5c'2d'5b'3e'5d'7b1'2c2'7d = compileRegex "\\-[>]{1,2}"
regex_'28'5b'5c'2b'5c'2d'5c'2a'2f'5c'5e'5c'3a'5c'24'7e'26'5c'7c'40'5e'5d'29'3d = compileRegex "([\\+\\-\\*/\\^\\:\\$~&\\|@^])="
regex_'3d'28'5b'5c'2b'5c'2d'5c'2a'2f'5c'5e'5c'3a'5c'24'7e'21'3c'3e'26'5c'7c'40'5e'5d'29 = compileRegex "=([\\+\\-\\*/\\^\\:\\$~!<>&\\|@^])"
regex_'3d'28'3f'21'3d'29 = compileRegex "=(?!=)"
regex_'28'5c'2b'7c'5c'2d'7c'5c'2a'7c'2f'7c'3c'3d'7c'3e'3d'7c'3d'7b1'2c2'7d'7c'5c'21'3d'7c'5c'7c'7b1'2c2'7d'7c'26'7b1'2c2'7d'7c'3a'7b1'2c3'7d'7c'5c'5e'7c'40'7c'5c'24'7c'7e'29'28'28'3f'21'28'5c'2b'7c'5c'2d'7c'5c'2a'7c'2f'7c'3c'3d'7c'3e'3d'7c'3d'7c'5c'21'3d'7c'5c'7c'7c'26'7c'3a'7c'5c'5e'7c'40'7c'5c'24'7c'7e'29'29'7c'24'29 = compileRegex "(\\+|\\-|\\*|/|<=|>=|={1,2}|\\!=|\\|{1,2}|&{1,2}|:{1,3}|\\^|@|\\$|~)((?!(\\+|\\-|\\*|/|<=|>=|=|\\!=|\\||&|:|\\^|@|\\$|~))|$)"
regex_'28'5c'2b'7c'5c'2d'7c'5c'2a'7c'2f'7c'3c'3d'7c'3e'3d'7c'3d'7b1'2c2'7d'7c'5c'21'3d'7c'5c'7c'7b1'2c2'7d'7c'26'7b1'2c2'7d'7c'3a'7b1'2c3'7d'7c'5c'5e'7c'40'7c'5c'24'7c'7e'29'7b2'2c'7d = compileRegex "(\\+|\\-|\\*|/|<=|>=|={1,2}|\\!=|\\|{1,2}|&{1,2}|:{1,3}|\\^|@|\\$|~){2,}"
regex_'25'5b'5e'25'5d'2a'25 = compileRegex "%[^%]*%"
defaultAttributes = [("level0","Normal Text"),("ctx0","Normal Text"),("parenthesis","In Parenthesis"),("string","String"),("string2","String"),("backquotedsymbol","Identifier"),("Headline","Headline"),("Comment","Comment"),("CommonRules","Normal Text")]
parseRules "level0" =
do (attr, result) <- (((parseRules "CommonRules"))
<|>
((pDetectChar False '}' >>= withAttribute "Error"))
<|>
((pDetectChar False ')' >>= withAttribute "Error")))
return (attr, result)
parseRules "ctx0" =
do (attr, result) <- (((parseRules "CommonRules"))
<|>
((pDetectChar False '}' >>= withAttribute "Symbol") >>~ (popContext))
<|>
((pDetectChar False ')' >>= withAttribute "Error")))
return (attr, result)
parseRules "parenthesis" =
do (attr, result) <- (((pLineContinue >>= withAttribute "Boolean"))
<|>
((pDetectChar False ')' >>= withAttribute "Symbol") >>~ (popContext))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5f'5c'2e'5d'5b0'2d9a'2dzA'2dZ'5f'5c'2e'5d'2a'5b'5cs'5d'2a'3d'28'3f'3d'28'5b'5e'3d'5d'7c'24'29'29 >>= withAttribute "Identifier"))
<|>
((parseRules "CommonRules"))
<|>
((pDetectChar False '}' >>= withAttribute "Error")))
return (attr, result)
parseRules "string" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "String") >>~ (popContext))
<|>
((pHlCStringChar >>= withAttribute "String Char")))
return (attr, result)
parseRules "string2" =
do (attr, result) <- (((pDetectChar False '\'' >>= withAttribute "String") >>~ (popContext))
<|>
((pHlCStringChar >>= withAttribute "String Char")))
return (attr, result)
parseRules "backquotedsymbol" =
do (attr, result) <- (((pDetectChar False '`' >>= withAttribute "String") >>~ (popContext))
<|>
((pHlCStringChar >>= withAttribute "String Char")))
return (attr, result)
parseRules "Headline" =
pzero
parseRules "Comment" =
pzero
parseRules "CommonRules" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "string")
<|>
((pDetectChar False '\'' >>= withAttribute "String") >>~ pushContext "string2")
<|>
((pDetectChar False '`' >>= withAttribute "String") >>~ pushContext "backquotedsymbol")
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_controls >>= withAttribute "Control Structure"))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_words >>= withAttribute "Reserved Words"))
<|>
((pFloat >>= withAttribute "Float"))
<|>
((pInt >>= withAttribute "Int"))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5f'5d'2b'5ba'2dzA'2dZ'5f'5c'2e0'2d9'5d'2a'28'3f'3d'5b'5cs'5d'2a'5b'28'5d'29 >>= withAttribute "Keyword"))
<|>
((pRegExpr regex_'5c'2e'5ba'2dzA'2dZ'5f'5c'2e'5d'2b'5ba'2dzA'2dZ'5f'5c'2e0'2d9'5d'2a'28'3f'3d'5b'5cs'5d'2a'5b'28'5d'29 >>= withAttribute "Keyword"))
<|>
((pRegExpr regex_'5c'28 >>= withAttribute "Symbol") >>~ pushContext "parenthesis")
<|>
((pString False "##" >>= withAttribute "Headline") >>~ pushContext "Headline")
<|>
((pDetectChar False '#' >>= withAttribute "Comment") >>~ pushContext "Comment")
<|>
((pRegExpr regex_'28'5b'5c'2b'5c'2d'5c'2a'2f'5c'5e'5c'3a'5c'24'7e'21'26'5c'7c'3d'3e'40'5e'5d'29'28'5b'3c'5d'7b1'2c2'7d'5c'2d'7c'5c'2d'5b'3e'5d'7b1'2c2'7d'29 >>= withAttribute "Error"))
<|>
((pRegExpr regex_'28'5b'3c'5d'7b1'2c2'7d'5c'2d'7c'5c'2d'5b'3e'5d'7b1'2c2'7d'29'28'5b'5c'2b'5c'2d'5c'2a'2f'5c'5e'5c'3a'5c'24'7e'21'26'5c'7c'3d'3c'40'5d'29 >>= withAttribute "Error"))
<|>
((pRegExpr regex_'28'5b'3c'5d'7b3'7d'7c'5b'3e'5d'7b3'7d'29 >>= withAttribute "Error"))
<|>
((pRegExpr regex_'5b'3c'5d'7b1'2c2'7d'5c'2d >>= withAttribute "Assign"))
<|>
((pRegExpr regex_'5c'2d'5b'3e'5d'7b1'2c2'7d >>= withAttribute "Assign"))
<|>
((pRegExpr regex_'28'5b'5c'2b'5c'2d'5c'2a'2f'5c'5e'5c'3a'5c'24'7e'26'5c'7c'40'5e'5d'29'3d >>= withAttribute "Error"))
<|>
((pRegExpr regex_'3d'28'5b'5c'2b'5c'2d'5c'2a'2f'5c'5e'5c'3a'5c'24'7e'21'3c'3e'26'5c'7c'40'5e'5d'29 >>= withAttribute "Error"))
<|>
((pRegExpr regex_'3d'28'3f'21'3d'29 >>= withAttribute "Assign"))
<|>
((pRegExpr regex_'28'5c'2b'7c'5c'2d'7c'5c'2a'7c'2f'7c'3c'3d'7c'3e'3d'7c'3d'7b1'2c2'7d'7c'5c'21'3d'7c'5c'7c'7b1'2c2'7d'7c'26'7b1'2c2'7d'7c'3a'7b1'2c3'7d'7c'5c'5e'7c'40'7c'5c'24'7c'7e'29'28'28'3f'21'28'5c'2b'7c'5c'2d'7c'5c'2a'7c'2f'7c'3c'3d'7c'3e'3d'7c'3d'7c'5c'21'3d'7c'5c'7c'7c'26'7c'3a'7c'5c'5e'7c'40'7c'5c'24'7c'7e'29'29'7c'24'29 >>= withAttribute "Operator"))
<|>
((pRegExpr regex_'28'5c'2b'7c'5c'2d'7c'5c'2a'7c'2f'7c'3c'3d'7c'3e'3d'7c'3d'7b1'2c2'7d'7c'5c'21'3d'7c'5c'7c'7b1'2c2'7d'7c'26'7b1'2c2'7d'7c'3a'7b1'2c3'7d'7c'5c'5e'7c'40'7c'5c'24'7c'7e'29'7b2'2c'7d >>= withAttribute "Error"))
<|>
((pRegExpr regex_'25'5b'5e'25'5d'2a'25 >>= withAttribute "Operator"))
<|>
((pDetectChar False '{' >>= withAttribute "Symbol") >>~ pushContext "ctx0")
<|>
((pDetectChar False '[' >>= withAttribute "Symbol"))
<|>
((pDetectChar False ']' >>= withAttribute "Symbol")))
return (attr, result)
parseRules x = fail $ "Unknown context" ++ x