module Text.Highlighting.Kate.Syntax.Boo
(highlight, parseExpression, syntaxName, syntaxExtensions)
where
import Text.Highlighting.Kate.Types
import Text.Highlighting.Kate.Common
import Text.ParserCombinators.Parsec hiding (State)
import Control.Monad.State
import Data.Char (isSpace)
import qualified Data.Set as Set
syntaxName :: String
syntaxName = "Boo"
syntaxExtensions :: String
syntaxExtensions = "*.boo"
highlight :: String -> [SourceLine]
highlight input = evalState (mapM parseSourceLine $ lines input) startingState
parseSourceLine :: String -> State SyntaxState SourceLine
parseSourceLine = mkParseSourceLine (parseExpression Nothing)
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 = [("Boo","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 }
("Boo","Normal") -> return ()
("Boo","parenthesised") -> return ()
("Boo","Quasi-Quotation") -> return ()
("Boo","Tripple A-comment") -> return ()
("Boo","Tripple Q-comment") -> return ()
("Boo","Tripple A-string") -> return ()
("Boo","Raw Tripple A-string") -> return ()
("Boo","Tripple Q-string") -> return ()
("Boo","Raw Tripple Q-string") -> return ()
("Boo","Comment SlashSlash") -> (popContext) >> pEndLine
("Boo","Single A-comment") -> return ()
("Boo","Single Q-comment") -> return ()
("Boo","Single A-string") -> return ()
("Boo","Single Q-string") -> return ()
("Boo","Raw A-string") -> return ()
("Boo","Raw Q-string") -> 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_namespace = Set.fromList $ words $ "import from as namespace"
list_operators = Set.fromList $ words $ "and assert in is not or"
list_primitive = Set.fromList $ words $ "bool byte sbyte double decimal single short ushort int char uint long ulong object duck string regex date timespan"
list_definition = Set.fromList $ words $ "abstract virtual override static final transient macro protected private public internal partial class struct interface enum callable of def constructor destructor do get set event return yield"
list_boolean = Set.fromList $ words $ "true false"
list_literals = Set.fromList $ words $ "null self super"
list_keywords = Set.fromList $ words $ "and break cast continue elif else except ensure for given goto if in is isa not or otherwise pass raise try unless when while ref"
list_builtins = Set.fromList $ words $ "assert __eval__ __switch__ enumerate filter len typeof map max min property using getter required lock range zip checked unchecked rawArrayIndexing normalArrayIndexing print array matrix yieldAll"
regex_'5ba'2dzA'2dZ'5f'5d'5ba'2dzA'2dZ'5f0'2d9'5d'2b = compileRegex True "[a-zA-Z_][a-zA-Z_0-9]+"
regex__'28'28'28'5b0'2d9'5d'2a'5c'2e'5b0'2d9'5d'2b'7c'5b0'2d9'5d'2b'5c'2e'29'7c'28'5b0'2d9'5d'2b'7c'28'5b0'2d9'5d'2a'5c'2e'5b0'2d9'5d'2b'7c'5b0'2d9'5d'2b'5c'2e'29'29'5beE'5d'28'5c'2b'7c'2d'29'3f'5b0'2d9'5d'2b'29'7c'5b0'2d9'5d'2b'29'5bjJ'5d = compileRegex True " ((([0-9]*\\.[0-9]+|[0-9]+\\.)|([0-9]+|([0-9]*\\.[0-9]+|[0-9]+\\.))[eE](\\+|-)?[0-9]+)|[0-9]+)[jJ]"
regex_'28'5b0'2d9'5d'2b'5c'2e'5b0'2d9'5d'2a'7c'5c'2e'5b0'2d9'5d'2b'29'28'5beE'5d'5b0'2d9'5d'2b'29'3f = compileRegex True "([0-9]+\\.[0-9]*|\\.[0-9]+)([eE][0-9]+)?"
regex_'28'5b1'2d9'5d'5b0'2d9'5d'2a'28'5beE'5d'5b0'2d9'5d'2b'29'3f'7c0'29 = compileRegex True "([1-9][0-9]*([eE][0-9]+)?|0)"
regex_'5b1'2d9'5d'5b0'2d9'5d'2a'28'5beE'5d'5b0'2d9'2e'5d'2b'29'3f'5bLl'5d = compileRegex True "[1-9][0-9]*([eE][0-9.]+)?[Ll]"
regex_0'5bXx'5d'5b0'2d9a'2dfA'2dF'5d'2b = compileRegex True "0[Xx][0-9a-fA-F]+"
regex_0'5b1'2d9'5d'5b0'2d9'5d'2a = compileRegex True "0[1-9][0-9]*"
regex_'5brR'5d'27'27'27 = compileRegex True "[rR]'''"
regex_'5brR'5d'22'22'22 = compileRegex True "[rR]\"\"\""
regex_'5brR'5d'27 = compileRegex True "[rR]'"
regex_'5brR'5d'22 = compileRegex True "[rR]\""
regex_'23'2e'2a'24 = compileRegex True "#.*$"
regex_'5cs'2au'3f'27'27'27 = compileRegex True "\\s*u?'''"
regex_'5cs'2au'3f'22'22'22 = compileRegex True "\\s*u?\"\"\""
regex_'5b'2b'2a'2f'25'5c'7c'3d'3b'5c'21'3c'3e'21'5e'26'7e'2d'5d = compileRegex True "[+*/%\\|=;\\!<>!^&~-]"
regex_'25'5ba'2dzA'2dZ'5d = compileRegex True "%[a-zA-Z]"
regex_'22'22'22 = compileRegex True "\"\"\""
regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d = compileRegex True "%\\([a-zA-Z0-9_]+\\)[a-zA-Z]"
regex_'27'27'27 = compileRegex True "'''"
parseRules ("Boo","Normal") =
(((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_namespace >>= withAttribute CharTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_definition >>= withAttribute KeywordTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_operators >>= withAttribute OperatorTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_keywords >>= withAttribute KeywordTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_builtins >>= withAttribute DataTypeTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_literals >>= withAttribute OtherTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_boolean >>= withAttribute OtherTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_primitive >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'5ba'2dzA'2dZ'5f'5d'5ba'2dzA'2dZ'5f0'2d9'5d'2b >>= withAttribute NormalTok))
<|>
((pRegExpr regex__'28'28'28'5b0'2d9'5d'2a'5c'2e'5b0'2d9'5d'2b'7c'5b0'2d9'5d'2b'5c'2e'29'7c'28'5b0'2d9'5d'2b'7c'28'5b0'2d9'5d'2a'5c'2e'5b0'2d9'5d'2b'7c'5b0'2d9'5d'2b'5c'2e'29'29'5beE'5d'28'5c'2b'7c'2d'29'3f'5b0'2d9'5d'2b'29'7c'5b0'2d9'5d'2b'29'5bjJ'5d >>= withAttribute OtherTok))
<|>
((pRegExpr regex_'28'5b0'2d9'5d'2b'5c'2e'5b0'2d9'5d'2a'7c'5c'2e'5b0'2d9'5d'2b'29'28'5beE'5d'5b0'2d9'5d'2b'29'3f >>= withAttribute FloatTok))
<|>
((pRegExpr regex_'28'5b1'2d9'5d'5b0'2d9'5d'2a'28'5beE'5d'5b0'2d9'5d'2b'29'3f'7c0'29 >>= withAttribute DecValTok))
<|>
((pRegExpr regex_'5b1'2d9'5d'5b0'2d9'5d'2a'28'5beE'5d'5b0'2d9'2e'5d'2b'29'3f'5bLl'5d >>= withAttribute OtherTok))
<|>
((pRegExpr regex_0'5bXx'5d'5b0'2d9a'2dfA'2dF'5d'2b >>= withAttribute OtherTok))
<|>
((pRegExpr regex_0'5b1'2d9'5d'5b0'2d9'5d'2a >>= withAttribute OtherTok))
<|>
((pRegExpr regex_'5brR'5d'27'27'27 >>= withAttribute StringTok) >>~ pushContext ("Boo","Raw Tripple A-string"))
<|>
((pRegExpr regex_'5brR'5d'22'22'22 >>= withAttribute StringTok) >>~ pushContext ("Boo","Raw Tripple Q-string"))
<|>
((pRegExpr regex_'5brR'5d'27 >>= withAttribute StringTok) >>~ pushContext ("Boo","Raw A-string"))
<|>
((pRegExpr regex_'5brR'5d'22 >>= withAttribute StringTok) >>~ pushContext ("Boo","Raw Q-string"))
<|>
((pRegExpr regex_'23'2e'2a'24 >>= withAttribute CommentTok))
<|>
((pColumn 0 >> pRegExpr regex_'5cs'2au'3f'27'27'27 >>= withAttribute CommentTok) >>~ pushContext ("Boo","Tripple A-comment"))
<|>
((pColumn 0 >> pRegExpr regex_'5cs'2au'3f'22'22'22 >>= withAttribute CommentTok) >>~ pushContext ("Boo","Tripple Q-comment"))
<|>
((pDetect2Chars False '/' '/' >>= withAttribute CommentTok) >>~ pushContext ("Boo","Comment SlashSlash"))
<|>
((pString False "'''" >>= withAttribute StringTok) >>~ pushContext ("Boo","Tripple A-string"))
<|>
((pString False "\"\"\"" >>= withAttribute StringTok) >>~ pushContext ("Boo","Tripple Q-string"))
<|>
((pDetectChar False '\'' >>= withAttribute StringTok) >>~ pushContext ("Boo","Single A-string"))
<|>
((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext ("Boo","Single Q-string"))
<|>
((pDetectChar False '(' >>= withAttribute OperatorTok) >>~ pushContext ("Boo","parenthesised"))
<|>
((pDetectChar False ')' >>= withAttribute OperatorTok) >>~ (popContext))
<|>
((pString False "[|" >>= withAttribute OperatorTok) >>~ pushContext ("Boo","Quasi-Quotation"))
<|>
((pString False "|]" >>= withAttribute OperatorTok) >>~ (popContext))
<|>
((pRegExpr regex_'5b'2b'2a'2f'25'5c'7c'3d'3b'5c'21'3c'3e'21'5e'26'7e'2d'5d >>= withAttribute OperatorTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Normal")) >> pDefault >>= withAttribute NormalTok))
parseRules ("Boo","parenthesised") =
(((parseRules ("Boo","Normal")))
<|>
(currentContext >>= \x -> guard (x == ("Boo","parenthesised")) >> pDefault >>= withAttribute NormalTok))
parseRules ("Boo","Quasi-Quotation") =
(((parseRules ("Boo","Normal")))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Quasi-Quotation")) >> pDefault >>= withAttribute OperatorTok))
parseRules ("Boo","Tripple A-comment") =
(((pString False "'''" >>= withAttribute CommentTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Tripple A-comment")) >> pDefault >>= withAttribute CommentTok))
parseRules ("Boo","Tripple Q-comment") =
(((pHlCChar >>= withAttribute CommentTok))
<|>
((pRegExpr regex_'22'22'22 >>= withAttribute CommentTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Tripple Q-comment")) >> pDefault >>= withAttribute CommentTok))
parseRules ("Boo","Tripple A-string") =
(((pHlCStringChar >>= withAttribute CharTok))
<|>
((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'27'27'27 >>= withAttribute StringTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Tripple A-string")) >> pDefault >>= withAttribute StringTok))
parseRules ("Boo","Raw Tripple A-string") =
(((pHlCStringChar >>= withAttribute StringTok))
<|>
((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'27'27'27 >>= withAttribute StringTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Raw Tripple A-string")) >> pDefault >>= withAttribute StringTok))
parseRules ("Boo","Tripple Q-string") =
(((pHlCStringChar >>= withAttribute CharTok))
<|>
((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'22'22'22 >>= withAttribute StringTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Tripple Q-string")) >> pDefault >>= withAttribute StringTok))
parseRules ("Boo","Raw Tripple Q-string") =
(((pHlCStringChar >>= withAttribute StringTok))
<|>
((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'22'22'22 >>= withAttribute StringTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Raw Tripple Q-string")) >> pDefault >>= withAttribute StringTok))
parseRules ("Boo","Comment SlashSlash") =
(((pLineContinue >>= withAttribute CommentTok))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Comment SlashSlash")) >> pDefault >>= withAttribute CommentTok))
parseRules ("Boo","Single A-comment") =
(((pHlCStringChar >>= withAttribute CommentTok))
<|>
((pDetectChar False '\'' >>= withAttribute CommentTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Single A-comment")) >> pDefault >>= withAttribute CommentTok))
parseRules ("Boo","Single Q-comment") =
(((pHlCStringChar >>= withAttribute CommentTok))
<|>
((pDetectChar False '"' >>= withAttribute CommentTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Single Q-comment")) >> pDefault >>= withAttribute CommentTok))
parseRules ("Boo","Single A-string") =
(((pHlCStringChar >>= withAttribute CharTok))
<|>
((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pDetectChar False '\'' >>= withAttribute StringTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Single A-string")) >> pDefault >>= withAttribute StringTok))
parseRules ("Boo","Single Q-string") =
(((pHlCStringChar >>= withAttribute CharTok))
<|>
((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Single Q-string")) >> pDefault >>= withAttribute StringTok))
parseRules ("Boo","Raw A-string") =
(((pHlCStringChar >>= withAttribute StringTok))
<|>
((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pDetectChar False '\'' >>= withAttribute StringTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Raw A-string")) >> pDefault >>= withAttribute StringTok))
parseRules ("Boo","Raw Q-string") =
(((pHlCStringChar >>= withAttribute StringTok))
<|>
((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute NormalTok))
<|>
((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("Boo","Raw Q-string")) >> pDefault >>= withAttribute StringTok))
parseRules x = parseRules ("Boo","Normal") <|> fail ("Unknown context" ++ show x)