{- This module was generated from data in the Kate syntax highlighting file boo.xml, version 0.91,
   by  Marc Dassonneville -}

module Text.Highlighting.Kate.Syntax.Boo ( 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
-- | Full name of language.
syntaxName :: String
syntaxName = "Boo"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.boo"

-- | 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 = "Boo" }
  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 [("Boo",["Normal"])], synStLanguage = "Boo", 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
    "Normal" -> return () >> pHandleEndLine
    "parenthesised" -> return () >> pHandleEndLine
    "Quasi-Quotation" -> return () >> pHandleEndLine
    "Tripple A-comment" -> return () >> pHandleEndLine
    "Tripple Q-comment" -> return () >> pHandleEndLine
    "Tripple A-string" -> return () >> pHandleEndLine
    "Raw Tripple A-string" -> return () >> pHandleEndLine
    "Tripple Q-string" -> return () >> pHandleEndLine
    "Raw Tripple Q-string" -> return () >> pHandleEndLine
    "Comment SlashSlash" -> (popContext) >> pEndLine
    "Single A-comment" -> return () >> pHandleEndLine
    "Single Q-comment" -> return () >> pHandleEndLine
    "Single A-string" -> return () >> pHandleEndLine
    "Single Q-string" -> return () >> pHandleEndLine
    "Raw A-string" -> return () >> pHandleEndLine
    "Raw Q-string" -> 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 = [("Definition Keyword","kw"),("Data Type","dt"),("Flow Control Keyword","kw"),("Builtin Function","dt"),("Special Variable","ot"),("Preprocessor","ch"),("String Char","ch"),("Long","ot"),("Float","fl"),("Int","dv"),("Hex","ot"),("Octal","ot"),("Complex","ot"),("Comment","co"),("String","st"),("Raw String","st")]

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

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 "[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 " ((([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 "([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 "([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 "[1-9][0-9]*([eE][0-9.]+)?[Ll]"
regex_0'5bXx'5d'5b0'2d9a'2dfA'2dF'5d'2b = compileRegex "0[Xx][0-9a-fA-F]+"
regex_0'5b1'2d9'5d'5b0'2d9'5d'2a = compileRegex "0[1-9][0-9]*"
regex_'5brR'5d'27'27'27 = compileRegex "[rR]'''"
regex_'5brR'5d'22'22'22 = compileRegex "[rR]\"\"\""
regex_'5brR'5d'27 = compileRegex "[rR]'"
regex_'5brR'5d'22 = compileRegex "[rR]\""
regex_'23'2e'2a'24 = compileRegex "#.*$"
regex_'5cs'2au'3f'27'27'27 = compileRegex "\\s*u?'''"
regex_'5cs'2au'3f'22'22'22 = compileRegex "\\s*u?\"\"\""
regex_'5b'2b'2a'2f'25'5c'7c'3d'3b'5c'21'3c'3e'21'5e'26'7e'2d'5d = compileRegex "[+*/%\\|=;\\!<>!^&~-]"
regex_'25'5ba'2dzA'2dZ'5d = compileRegex "%[a-zA-Z]"
regex_'22'22'22 = compileRegex "\"\"\""
regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d = compileRegex "%\\([a-zA-Z0-9_]+\\)[a-zA-Z]"
regex_'27'27'27 = compileRegex "'''"

defaultAttributes = [("Normal","Normal Text"),("parenthesised","Normal Text"),("Quasi-Quotation","Operator"),("Tripple A-comment","Comment"),("Tripple Q-comment","Comment"),("Tripple A-string","String"),("Raw Tripple A-string","Raw String"),("Tripple Q-string","String"),("Raw Tripple Q-string","Raw String"),("Comment SlashSlash","Comment"),("Single A-comment","Comment"),("Single Q-comment","Comment"),("Single A-string","String"),("Single Q-string","String"),("Raw A-string","Raw String"),("Raw Q-string","Raw String")]

parseRules "Normal" = 
  do (attr, result) <- (((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_namespace >>= withAttribute "Preprocessor"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_definition >>= withAttribute "Definition Keyword"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_operators >>= withAttribute "Operator"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_keywords >>= withAttribute "Flow Control Keyword"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_builtins >>= withAttribute "Builtin Function"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_literals >>= withAttribute "Special Variable"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_boolean >>= withAttribute "Special Variable"))
                        <|>
                        ((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_primitive >>= withAttribute "Data Type"))
                        <|>
                        ((pRegExpr regex_'5ba'2dzA'2dZ'5f'5d'5ba'2dzA'2dZ'5f0'2d9'5d'2b >>= withAttribute "Normal"))
                        <|>
                        ((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 "Complex"))
                        <|>
                        ((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 "Float"))
                        <|>
                        ((pRegExpr regex_'28'5b1'2d9'5d'5b0'2d9'5d'2a'28'5beE'5d'5b0'2d9'5d'2b'29'3f'7c0'29 >>= withAttribute "Int"))
                        <|>
                        ((pRegExpr regex_'5b1'2d9'5d'5b0'2d9'5d'2a'28'5beE'5d'5b0'2d9'2e'5d'2b'29'3f'5bLl'5d >>= withAttribute "Long"))
                        <|>
                        ((pRegExpr regex_0'5bXx'5d'5b0'2d9a'2dfA'2dF'5d'2b >>= withAttribute "Hex"))
                        <|>
                        ((pRegExpr regex_0'5b1'2d9'5d'5b0'2d9'5d'2a >>= withAttribute "Octal"))
                        <|>
                        ((pRegExpr regex_'5brR'5d'27'27'27 >>= withAttribute "Raw String") >>~ pushContext "Raw Tripple A-string")
                        <|>
                        ((pRegExpr regex_'5brR'5d'22'22'22 >>= withAttribute "Raw String") >>~ pushContext "Raw Tripple Q-string")
                        <|>
                        ((pRegExpr regex_'5brR'5d'27 >>= withAttribute "Raw String") >>~ pushContext "Raw A-string")
                        <|>
                        ((pRegExpr regex_'5brR'5d'22 >>= withAttribute "Raw String") >>~ pushContext "Raw Q-string")
                        <|>
                        ((pRegExpr regex_'23'2e'2a'24 >>= withAttribute "Comment"))
                        <|>
                        ((pColumn 0 >> pRegExpr regex_'5cs'2au'3f'27'27'27 >>= withAttribute "Comment") >>~ pushContext "Tripple A-comment")
                        <|>
                        ((pColumn 0 >> pRegExpr regex_'5cs'2au'3f'22'22'22 >>= withAttribute "Comment") >>~ pushContext "Tripple Q-comment")
                        <|>
                        ((pDetect2Chars False '/' '/' >>= withAttribute "Comment") >>~ pushContext "Comment SlashSlash")
                        <|>
                        ((pString False "'''" >>= withAttribute "String") >>~ pushContext "Tripple A-string")
                        <|>
                        ((pString False "\"\"\"" >>= withAttribute "String") >>~ pushContext "Tripple Q-string")
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "String") >>~ pushContext "Single A-string")
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "Single Q-string")
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Operator") >>~ pushContext "parenthesised")
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Operator") >>~ (popContext))
                        <|>
                        ((pString False "[|" >>= withAttribute "Operator") >>~ pushContext "Quasi-Quotation")
                        <|>
                        ((pString False "|]" >>= withAttribute "Operator") >>~ (popContext))
                        <|>
                        ((pRegExpr regex_'5b'2b'2a'2f'25'5c'7c'3d'3b'5c'21'3c'3e'21'5e'26'7e'2d'5d >>= withAttribute "Operator"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution")))
     return (attr, result)

parseRules "parenthesised" = 
  do (attr, result) <- ((parseRules "Normal"))
     return (attr, result)

parseRules "Quasi-Quotation" = 
  do (attr, result) <- ((parseRules "Normal"))
     return (attr, result)

parseRules "Tripple A-comment" = 
  do (attr, result) <- ((pString False "'''" >>= withAttribute "Comment") >>~ (popContext))
     return (attr, result)

parseRules "Tripple Q-comment" = 
  do (attr, result) <- (((pHlCChar >>= withAttribute "Comment"))
                        <|>
                        ((pRegExpr regex_'22'22'22 >>= withAttribute "Comment") >>~ (popContext)))
     return (attr, result)

parseRules "Tripple A-string" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "String Char"))
                        <|>
                        ((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'27'27'27 >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "Raw Tripple A-string" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "Raw String"))
                        <|>
                        ((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'27'27'27 >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "Tripple Q-string" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "String Char"))
                        <|>
                        ((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'22'22'22 >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "Raw Tripple Q-string" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "Raw String"))
                        <|>
                        ((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'22'22'22 >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "Comment SlashSlash" = 
  do (attr, result) <- ((pLineContinue >>= withAttribute "Comment"))
     return (attr, result)

parseRules "Single A-comment" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "Comment"))
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Comment") >>~ (popContext)))
     return (attr, result)

parseRules "Single Q-comment" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "Comment"))
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "Comment") >>~ (popContext)))
     return (attr, result)

parseRules "Single A-string" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "String Char"))
                        <|>
                        ((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "Single Q-string" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "String Char"))
                        <|>
                        ((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "Raw A-string" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "Raw String"))
                        <|>
                        ((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "Raw String") >>~ (popContext)))
     return (attr, result)

parseRules "Raw Q-string" = 
  do (attr, result) <- (((pHlCStringChar >>= withAttribute "Raw String"))
                        <|>
                        ((pRegExpr regex_'25'5c'28'5ba'2dzA'2dZ0'2d9'5f'5d'2b'5c'29'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pRegExpr regex_'25'5ba'2dzA'2dZ'5d >>= withAttribute "String Substitution"))
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "Raw String") >>~ (popContext)))
     return (attr, result)

parseRules "" = parseRules "Normal"

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