{- This module was generated from data in the Kate syntax highlighting file sql.xml, version 1.14,
   by  Yury Lebedev (yurylebedev@mail.ru) -}

module Text.Highlighting.Kate.Syntax.Sql ( 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"

-- | 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" }
  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",["Normal"])], synStLanguage = "SQL", 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 literal" -> return () >> pHandleEndLine
    "Singleline PL/SQL-style comment" -> (popContext) >> pEndLine
    "Multiline C-style comment" -> return () >> pHandleEndLine
    "SQL*Plus remark directive" -> (popContext) >> pEndLine
    "User-defined identifier" -> (popContext) >> pEndLine
    "SQL*Plus directive to include file" -> (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"),("Hex","bn"),("Float","fl"),("String","st"),("String Char","ch"),("Comment","co"),("Identifier","ot"),("External Variable","ch"),("Symbol","ch"),("Preprocessor","ot")]

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

list_keywords = Set.fromList $ words $ "access account add admin administer advise after agent all all_rows allocate alter analyze ancillary and any archive archivelog as asc assertion associate at attribute attributes audit authenticated authid authorization autoallocate autoextend automatic backup become before begin behalf between binding bitmap block block_range body bound both break broadcast btitle buffer_pool build bulk by cache cache_instances call cancel cascade case category chained change check checkpoint child choose chunk class clear clone close close_cached_open_cursors cluster coalesce column columns column_value comment commit committed compatibility compile complete composite_limit compress compute connect connect_time consider consistent constant constraint constraints container contents context continue controlfile copy cost cpu_per_call cpu_per_session create create_stored_outlines cross cube current cursor cycle dangling data database datafile datafiles dba ddl deallocate debug declare default deferrable deferred definer degree delete demand desc determines dictionary dimension directory disable disassociate disconnect diskgroup dismount distinct distributed domain drop dynamic each else elsif empty enable end enforce entry escape estimate events except exception exceptions exchange excluding exclusive exec execute exists expire explain explosion extends extent extents externally failed_login_attempts false fast file filter first_rows flagger flashback flush following for force foreign freelist freelists fresh from full function functions generated global globally global_name grant group groups hash hashkeys having header heap hierarchy hour id identified identifier idgenerators idle_time if immediate in including increment incremental index indexed indexes indextype indextypes indicator initial initialized initially initrans inner insert instance instances instead intermediate intersect into invalidate is isolation isolation_level java join keep key kill label layer leading left less level library like limit link list local locator lock locked logfile logging logical_reads_per_call logical_reads_per_session logoff logon loop manage managed management master materialized maxarchlogs maxdatafiles maxextents maxinstances maxlogfiles maxloghistory maxlogmembers maxsize maxtrans maxvalue method member merge minimize minimum minextents minus minute minvalue mode modify monitoring mount move movement mts_dispatchers multiset named natural needed nested nested_table_id network never new next nls_calendar nls_characterset nls_comp nls_currency nls_date_format nls_date_language nls_iso_currency nls_lang nls_language nls_numeric_characters nls_sort nls_special_chars nls_territory no noarchivelog noaudit nocache nocompress nocycle noforce nologging nomaxvalue nominimize nominvalue nomonitoring none noorder nooverride noparallel norely noresetlogs noreverse normal nosegment nosort not nothing novalidate nowait null nulls objno objno_reuse of off offline oid oidindex old on online only opcode open operator optimal optimizer_goal option or order organization out outer outline over overflow overlaps own package packages parallel parameters parent partition partitions partition_hash partition_range password password_grace_time password_life_time password_lock_time password_reuse_max password_reuse_time password_verify_function pctfree pctincrease pctthreshold pctused pctversion percent permanent plan plsql_debug post_transaction prebuilt preceding prepare present preserve previous primary prior private private_sga privilege privileges procedure profile public purge query queue quota random range rba read reads rebuild records_per_block recover recoverable recovery recycle reduced references referencing refresh rely rename replace reset resetlogs resize resolve resolver resource restrict restricted resume return returning reuse reverse revoke rewrite right role roles rollback rollup row rownum rows rule sample savepoint scan scan_instances schema scn scope sd_all sd_inhibit sd_show segment seg_block seg_file select selectivity sequence serializable servererror session session_cached_cursors sessions_per_user set share shared shared_pool shrink shutdown singletask size skip skip_unusable_indexes snapshot some sort source specification split sql_trace standby start startup statement_id statistics static stop storage store structure submultiset subpartition subpartitions successful summary supplemental suspend switch sys_op_bitvec sys_op_enforce_not_null$ sys_op_noexpand sys_op_ntcimg$ synonym sysdba sysoper system table tables tablespace tablespace_no tabno tempfile temporary than the then thread through timeout timezone_hour timezone_minute time_zone to toplevel trace tracing trailing transaction transitional trigger triggers true truncate type types unarchived unbound unbounded undo uniform union unique unlimited unlock unrecoverable until unusable unused upd_indexes updatable update uppper usage use use_stored_outlines user_defined using validate validation values view when whenever where with without work write"
list_operators = Set.fromList $ words $ "+ - * / || = != <> < <= > >= ~= ^= := => ** .."
list_functions = Set.fromList $ words $ "abs acos add_months ascii asciistr asin atan atan2 avg bfilename bin_to_num bitand cardinality cast ceil chartorowid chr coalesce collect compose concat convert corr corr_k corr_s cos cosh count covar_pop covar_samp cume_dist current_date current_timestamp cv dbtimezone decode decompose dense_rank depth deref dump empty_blob empty_clob existsnode exp extract extractvalue first first_value floor from_tz greatest group_id grouping grouping_id hextoraw initcap instr instrb lag last last_day last_value lead least length lengthb ln lnnvl localtimestamp log lower lpad ltrim make_ref max median min mod months_between nanvl nchr new_time next_day nls_charset_decl_len nls_charset_id nls_charset_name nls_initcap nls_lower nls_upper nlssort ntile nullif numtodsinterval numtoyminterval nvl nvl2 ora_hash ora_rowscn percent_rank percentile_cont percentile_disc power powermultiset powermultiset_by_cardinality presentnnv presentv rank ratio_to_report rawtohex rawtonhex ref reftohex regexp_instr regexp_like regexp_replace regexp_substr regr_slope regr_intercept regr_count regr_r2 regr_avgx regr_avgy regr_sxx regr_syy regr_sxy remainder round row_number rowidtochar rowidtonchar rpad rtrim scn_to_timestamp sessiontimezone sign sin sinh soundex sqrt stats_binomial_test stats_crosstab stats_f_test stats_ks_test stats_mode stats_mw_test stats_one_way_anova stats_t_test_one stats_t_test_paired stats_t_test_indep stats_t_test_indepu stats_wsr_test stddev stddev_pop stddev_samp substr substrb sum sys_connect_by_path sys_context sys_dburigen sys_extract_utc sys_guid sys_typeid sys_xmlagg sys_xmlgen sysdate systimestamp tan tanh timestamp_to_scn to_binary_double to_binary_float to_char to_clob to_date to_dsinterval to_lob to_multi_byte to_nchar to_nclob to_number to_single_byte to_timestamp to_timestamp_tz to_yminterval translate treat trim trunc tz_offset uid unistr updatexml upper user userenv value var_pop var_samp variance vsize width_bucket xmlagg xmlcolattval xmlconcat xmlelement xmlforest xmlsequence xmltransform"
list_types = Set.fromList $ words $ "anydata anydataset anytype array bfile binary_double binary_float binary_integer blob boolean cfile char character clob date day dburitype dec decimal double float flob httpuritype int integer interval lob long mlslabel month national nchar nclob number numeric nvarchar object pls_integer precision raw record real rowid second single smallint time timestamp urifactorytype uritype urowid varchar varchar2 varying varray xmltype year zone"

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_'28'3a'7c'26'26'3f'29'5cw'2b = compileRegex "(:|&&?)\\w+"
regex_'2f'24 = compileRegex "/$"
regex_'40'40'3f'5b'5e'40_'5ct'5cr'5cn'5d = compileRegex "@@?[^@ \\t\\r\\n]"
regex_'26'26'3f'5cw'2b = compileRegex "&&?\\w+"

defaultAttributes = [("Normal","Normal Text"),("String literal","String"),("Singleline PL/SQL-style comment","Comment"),("Multiline C-style comment","Comment"),("SQL*Plus remark directive","Comment"),("User-defined identifier","Identifier"),("SQL*Plus directive to include file","Preprocessor")]

parseRules "Normal" = 
  do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal Text"))
                        ((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 literal")
                        ((pDetect2Chars False '-' '-' >>= withAttribute "Comment") >>~ pushContext "Singleline PL/SQL-style comment")
                        ((pDetect2Chars False '/' '*' >>= withAttribute "Comment") >>~ pushContext "Multiline C-style comment")
                        ((pColumn 0 >> pRegExpr regex_rem'5cb >>= withAttribute "Comment") >>~ pushContext "SQL*Plus remark directive")
                        ((pDetectChar False '"' >>= withAttribute "Identifier") >>~ pushContext "User-defined identifier")
                        ((pRegExpr regex_'28'3a'7c'26'26'3f'29'5cw'2b >>= withAttribute "External Variable"))
                        ((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 "SQL*Plus directive to include file"))
     return (attr, result)

parseRules "String literal" = 
  do (attr, result) <- (((pDetect2Chars False '\\' '\'' >>= withAttribute "String") >>~ (popContext))
                        ((pHlCStringChar >>= withAttribute "String Char"))
                        ((pRegExpr regex_'26'26'3f'5cw'2b >>= withAttribute "External Variable"))
                        ((pDetect2Chars False '\'' '\'' >>= withAttribute "String Char"))
                        ((pDetectChar False '\'' >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "Singleline PL/SQL-style comment" = 

parseRules "Multiline C-style comment" = 
  do (attr, result) <- ((pDetect2Chars False '*' '/' >>= withAttribute "Comment") >>~ (popContext))
     return (attr, result)

parseRules "SQL*Plus remark directive" = 

parseRules "User-defined identifier" = 
  do (attr, result) <- ((pDetectChar False '"' >>= withAttribute "Identifier") >>~ (popContext))
     return (attr, result)

parseRules "SQL*Plus directive to include file" = 

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