{- This module was generated from data in the Kate syntax highlighting file sql-mysql.xml, version 1.13,
   by  Shane Wright (me@shanewright.co.uk) -}

module Text.Highlighting.Kate.Syntax.SqlMysql ( 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 = "SQL (MySQL)"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.sql;*.SQL"

-- | 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 = "SQL (MySQL)" }
  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 [("SQL (MySQL)",["Normal"])], synStLanguage = "SQL (MySQL)", synStCurrentLine = "", synStCharsParsedInLine = 0, synStPrevChar = '\n', synStCaseSensitive = False, synStKeywordCaseSensitive = False, synStCaptures = []}

parseSourceLine = manyTill parseExpressionInternal pEndLine

pEndLine = do
  lookAhead $ newline <|> (eof >> return '\n')
  context <- currentContext
  case context of
    "Normal" -> return () >> pHandleEndLine
    "String" -> return () >> pHandleEndLine
    "String2" -> return () >> pHandleEndLine
    "Name" -> return () >> pHandleEndLine
    "SingleLineComment" -> (popContext) >> pEndLine
    "MultiLineComment" -> return () >> pHandleEndLine
    "Preprocessor" -> (popContext) >> pEndLine
    _ -> 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"),("Function","fu"),("Data Type","dt"),("Decimal","dv"),("Float","fl"),("Hex","bn"),("String","st"),("Name","st"),("String Char","ch"),("Comment","co"),("Symbol","ch"),("Preprocessor","ot")]

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

list_keywords = Set.fromList $ words $ "access add all alter analyze and as asc auto_increment bdb berkeleydb between both by cascade case change charset column columns constraint create cross current_date current_time current_timestamp database databases day_hour day_minute day_second dec default delayed delete desc describe distinct distinctrow drop else enclosed escaped exists explain fields for foreign from fulltext function grant group having high_priority if ignore in index infile inner innodb insert interval into is join key keys kill leading left like limit lines load lock low_priority master_server_id match mrg_myisam natural national not null numeric on optimize option optionally or order outer outfile partial precision primary privileges procedure purge read references regexp rename replace require restrict returns revoke right rlike select set show soname sql_big_result sql_calc_found_rows sql_small_result ssl starting straight_join striped table tables terminated then to trailing truncate type union unique unlock unsigned update usage use user_resources using values varying when where with write xor year_month zerofill"
list_operators = Set.fromList $ words $ "+ - * / || = != <> < <= > >= ~= ^= := => ** .."
list_functions = Set.fromList $ words $ "ascii ord conv bin oct hex char concat concat_ws length octet_length char_length character_length bit_length locate position instr lpad rpad left right substring substring_index mid ltrim rtrim trim soundex space replace repeat reverse insert elt field find_in_set make_set export_set lcase lower ucase upper load_file quote abs sign mod floor ceiling round exp ln log log2 log10 pow power sqrt pi cos sin tan acos asin atan atan2 cot rand least greatest degrees radians dayofweek weekday dayofmonth dayofyear month dayname monthname quarter week year yearweek hour minute second period_add period_diff date_add date_sub adddate subdate extract to_days from_days date_format time_format curdate current_date curtime current_time now sysdate current_timestamp unix_timestamp from_unixtime sec_to_time time_to_sec cast convert bit_count database user system_user session_user password encrypt encode decode md5 sha1 sha aes_encrypt aes_decrypt des_encrypt des_decrypt last_insert_id format version connection_id get_lock release_lock is_free_lock benchmark inet_ntoa inet_aton master_pos_wait found_rows count avg min max sum std stddev bit_or bit_and"
list_types = Set.fromList $ words $ "char character varchar binary varbinary tinyblob mediumblob blob longblob tinytext mediumtext text longtext enum bit bool boolean tinyint smallint mediumint middleint int integer bigint float double real decimal dec fixed numeric long serial date datetime time timestamp year"

regex_SET'28'3f'3d'5cs'2a'5c'28'29 = compileRegex "SET(?=\\s*\\()"
regex_'5cbCHARACTER_SET'5cb = compileRegex "\\bCHARACTER SET\\b"
regex_'25'28'3f'3abulk'5f'28'3f'3aexceptions'7crowcount'29'7cfound'7cisopen'7cnotfound'7crowcount'7crowtype'7ctype'29'5cb = compileRegex "%(?:bulk_(?:exceptions|rowcount)|found|isopen|notfound|rowcount|rowtype|type)\\b"
regex_rem'5cb = compileRegex "rem\\b"
regex_'2f'24 = compileRegex "/$"
regex_'40'40'3f'5b'5e'40_'5ct'5cr'5cn'5d = compileRegex "@@?[^@ \\t\\r\\n]"

defaultAttributes = [("Normal","Normal Text"),("String","String"),("String2","String"),("Name","Name"),("SingleLineComment","Comment"),("MultiLineComment","Comment"),("Preprocessor","Preprocessor")]

parseRules "Normal" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_SET'28'3f'3d'5cs'2a'5c'28'29 >>= withAttribute "Data Type"))
                        <|>
                        ((pRegExpr regex_'5cbCHARACTER_SET'5cb >>= withAttribute "Keyword"))
                        <|>
                        ((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_types >>= withAttribute "Data Type"))
                        <|>
                        ((pDetectIdentifier >>= withAttribute "Normal Text"))
                        <|>
                        ((pRegExpr regex_'25'28'3f'3abulk'5f'28'3f'3aexceptions'7crowcount'29'7cfound'7cisopen'7cnotfound'7crowcount'7crowtype'7ctype'29'5cb >>= withAttribute "Data Type"))
                        <|>
                        ((pHlCHex >>= withAttribute "Hex"))
                        <|>
                        ((pFloat >>= withAttribute "Float"))
                        <|>
                        ((pInt >>= withAttribute "Decimal"))
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "String") >>~ pushContext "String")
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "String2")
                        <|>
                        ((pDetectChar False '`' >>= withAttribute "Name") >>~ pushContext "Name")
                        <|>
                        ((pDetectChar False '#' >>= withAttribute "Comment") >>~ pushContext "SingleLineComment")
                        <|>
                        ((pDetect2Chars False '-' '-' >>= withAttribute "Comment") >>~ pushContext "SingleLineComment")
                        <|>
                        ((pDetect2Chars False '/' '*' >>= withAttribute "Comment") >>~ pushContext "MultiLineComment")
                        <|>
                        ((pColumn 0 >> pRegExpr regex_rem'5cb >>= withAttribute "Comment") >>~ pushContext "SingleLineComment")
                        <|>
                        ((pAnyChar ":&" >>= withAttribute "Symbol"))
                        <|>
                        ((pColumn 0 >> pRegExpr regex_'2f'24 >>= withAttribute "Symbol"))
                        <|>
                        ((pColumn 0 >> pRegExpr regex_'40'40'3f'5b'5e'40_'5ct'5cr'5cn'5d >>= withAttribute "Preprocessor") >>~ pushContext "Preprocessor")
                        <|>
                        ((pDetectChar False '.' >>= withAttribute "String Char")))
     return (attr, result)

parseRules "String" = 
  do (attr, result) <- (((pLineContinue >>= withAttribute "String") >>~ (popContext))
                        <|>
                        ((pHlCStringChar >>= withAttribute "String Char"))
                        <|>
                        ((pDetectChar False '&' >>= withAttribute "Symbol"))
                        <|>
                        ((pDetectChar False '\'' >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "String2" = 
  do (attr, result) <- (((pLineContinue >>= withAttribute "String") >>~ (popContext))
                        <|>
                        ((pHlCStringChar >>= withAttribute "String Char"))
                        <|>
                        ((pDetectChar False '&' >>= withAttribute "Symbol"))
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "Name" = 
  do (attr, result) <- (((pLineContinue >>= withAttribute "Name") >>~ (popContext))
                        <|>
                        ((pHlCStringChar >>= withAttribute "String Char"))
                        <|>
                        ((pDetectChar False '`' >>= withAttribute "Name") >>~ (popContext)))
     return (attr, result)

parseRules "SingleLineComment" = 
  pzero

parseRules "MultiLineComment" = 
  do (attr, result) <- (((pLineContinue >>= withAttribute "Comment") >>~ (popContext))
                        <|>
                        ((pDetect2Chars False '*' '/' >>= withAttribute "Comment") >>~ (popContext)))
     return (attr, result)

parseRules "Preprocessor" = 
  pzero

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