{- This module was generated from data in the Kate syntax
   highlighting file scheme.xml, version 1.13, by Dominik Haumann (dhdev@gmx.de) -}

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

-- | Full name of language.
syntaxName :: String
syntaxName = "Scheme"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.scm;*.ss;*.scheme;*.guile"

-- | Highlight source code using this syntax definition.
highlight :: String -> [SourceLine]
highlight input = evalState (mapM parseSourceLine $ lines input) startingState

parseSourceLine :: String -> State SyntaxState SourceLine
parseSourceLine = mkParseSourceLine parseExpression

-- | Parse an expression using appropriate local context.
parseExpression :: KateParser Token
parseExpression = do
  (lang,cont) <- currentContext
  result <- parseRules (lang,cont)
  optional $ do eof
                updateState $ \st -> st{ synStPrevChar = '\n' }
                pEndLine
  return result

startingState = SyntaxState {synStContexts = [("Scheme","Level0")], synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}

pEndLine = do
  updateState $ \st -> st{ synStPrevNonspace = False }
  context <- currentContext
  contexts <- synStContexts `fmap` getState
  if length contexts >= 2
    then case context of
      ("Scheme","Level0") -> return ()
      ("Scheme","Default") -> return ()
      ("Scheme","MultiLineComment") -> return ()
      ("Scheme","SpecialNumber") -> (popContext) >> pEndLine
      ("Scheme","String") -> return ()
      ("Scheme","function_decl") -> return ()
      ("Scheme","Level1") -> return ()
      ("Scheme","Level2") -> return ()
      ("Scheme","Level3") -> return ()
      ("Scheme","Level4") -> return ()
      ("Scheme","Level5") -> return ()
      ("Scheme","Level6") -> 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_operators = Set.fromList $ words $ "<= < = => >= > - / *,* *) +"
list_characters = Set.fromList $ words $ "#\\nul #\\soh #\\stx #\\etx #\\eot #\\enq #\\ack #\\bel #\\bs #\\ht #\\nl #\\vt #\\np #\\cr #\\so #\\si #\\dle #\\dc1 #\\dc2 #\\dc3 #\\dc4 #\\nak #\\syn #\\etb #\\can #\\em #\\sub #\\esc #\\fs #\\gs #\\rs #\\us #\\space #\\sp #\\newline #\\nl #\\tab #\\ht #\\backspace #\\bs #\\return #\\cr #\\page #\\np #\\null #\\nul"
list_defines = Set.fromList $ words $ "define define* define-accessor define-class defined? define-generic define-macro define-method define-module define-private define-public define*-public define-reader-ctor define-syntax define-syntax-macro defmacro defmacro* defmacro*-public"
list_keywords = Set.fromList $ words $ "abs acos and angle append applymap asin assoc assq assv atan begin boolean? break caaaar caaadr caaar caadar caaddr caadr caar cadaar cadadr cadar caddar cadddr caddr cadr call/cc call-with-current-continuation call-with-input-file call-with-output-file call-with-values car case catch cdaaar cdaadr cdaar cdadar cdaddr cdadr cdar cddaar cddadr cddar cdddar cddddr cdddr cddr cdr ceiling char-alphabetic? char-ci>=? char-ci>? char-ci=? char-ci<=? char-downcase char->integer char>=? char>? char=? char? char-lower-case? char<?c char<=? char-numeric? char-ready? char-upcase char-upper-case? char-whitespace? close-input-port close-output-port complex? cond cons continue cos current-input-port current-output-port denominator display do dynamic-wind else eof-object? eq? equal? eqv? eval even? exact->inexact exact? exp expt floor force for-each gcd har-ci<? if imag-part inexact->exact inexact? input-port? integer->char integer? interaction-environment lambda lcm length let let* letrec letrec-syntax let-syntax list->string list list? list-ref list-tail load log magnitude make-polar make-rectangular make-string make-vector max member memq memv min modulo negative? newline not null-environment null? number? number->string numerator odd? open-input-file open-output-file or output-port? pair? peek-char port? positive? procedure? quotient rational? rationalize read-char read real? real-part remainder reverse round scheme-report-environment set-car! set-cdr! sin sqrt string-append string-ci>=? string-ci>? string-ci=? string-ci<=? string-ci<? string-copy string-fill! string>=? string>? string->list string->number string->symbol string=? string string? string-length string<=? string<? string-ref string-set! substring symbol->string symbol? syntax-rules tan transcript-off transcript-on truncate values vector-fill! vector->listlist->vector vector vector? vector-length vector-ref vector-set! while with-input-from-file with-output-to-file write-char write zero?"

regex_'3b'2b'5cs'2aBEGIN'2e'2a'24 = compileRegex ";+\\s*BEGIN.*$"
regex_'3b'2b'5cs'2aEND'2e'2a'24 = compileRegex ";+\\s*END.*$"
regex_'3b'2e'2a'24 = compileRegex ";.*$"
regex_'23'5c'5c'2e = compileRegex "#\\\\."
regex_'23'5bbodxei'5d = compileRegex "#[bodxei]"
regex_'23'5btf'5d = compileRegex "#[tf]"
regex_'21'23'5cs'2a'24 = compileRegex "!#\\s*$"
regex_'5cd'2a'28'5c'2e'5cd'2b'29'3f = compileRegex "\\d*(\\.\\d+)?"
regex_'5cs'2a'5bA'2dZa'2dz0'2d9'2d'2b'5c'3c'5c'3e'2f'2f'5c'2a'5d'2a'5cs'2a = compileRegex "\\s*[A-Za-z0-9-+\\<\\>//\\*]*\\s*"

parseRules ("Scheme","Level0") =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Scheme","Level1"))
   <|>
   ((parseRules ("Scheme","Default")))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","Level0")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Scheme","Default") =
  (((pRegExpr regex_'3b'2b'5cs'2aBEGIN'2e'2a'24 >>= withAttribute RegionMarkerTok))
   <|>
   ((pRegExpr regex_'3b'2b'5cs'2aEND'2e'2a'24 >>= withAttribute RegionMarkerTok))
   <|>
   ((pRegExpr regex_'3b'2e'2a'24 >>= withAttribute CommentTok))
   <|>
   ((pDetect2Chars False '#' '!' >>= withAttribute CommentTok) >>~ pushContext ("Scheme","MultiLineComment"))
   <|>
   ((pKeyword " \n\t.(),%&;[]^{|}~" list_keywords >>= withAttribute KeywordTok))
   <|>
   ((pKeyword " \n\t.(),%&;[]^{|}~" list_operators >>= withAttribute KeywordTok))
   <|>
   ((pKeyword " \n\t.(),%&;[]^{|}~" list_defines >>= withAttribute KeywordTok) >>~ pushContext ("Scheme","function_decl"))
   <|>
   ((pKeyword " \n\t.(),%&;[]^{|}~" list_characters >>= withAttribute CharTok))
   <|>
   ((pRegExpr regex_'23'5c'5c'2e >>= withAttribute CharTok))
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext ("Scheme","String"))
   <|>
   ((pRegExpr regex_'23'5bbodxei'5d >>= withAttribute CharTok) >>~ pushContext ("Scheme","SpecialNumber"))
   <|>
   ((pRegExpr regex_'23'5btf'5d >>= withAttribute DecValTok))
   <|>
   ((pFloat >>= withAttribute FloatTok))
   <|>
   ((pInt >>= withAttribute DecValTok))
   <|>
   ((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Scheme","Level1"))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","Default")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Scheme","MultiLineComment") =
  (((pColumn 0 >> pRegExpr regex_'21'23'5cs'2a'24 >>= withAttribute CommentTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","MultiLineComment")) >> pDefault >>= withAttribute CommentTok))

parseRules ("Scheme","SpecialNumber") =
  (((pRegExpr regex_'5cd'2a'28'5c'2e'5cd'2b'29'3f >>= withAttribute DecValTok) >>~ (popContext))
   <|>
   (currentContext >>= parseRules))

parseRules ("Scheme","String") =
  (((pKeyword " \n\t.(),%&;[]^{|}~" list_characters >>= withAttribute CharTok))
   <|>
   ((pRegExpr regex_'23'5c'5c'2e >>= withAttribute CharTok))
   <|>
   ((pDetect2Chars False '\\' '"' >>= withAttribute CharTok))
   <|>
   ((pDetect2Chars False '\\' '\\' >>= withAttribute CharTok))
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","String")) >> pDefault >>= withAttribute StringTok))

parseRules ("Scheme","function_decl") =
  (((pRegExpr regex_'5cs'2a'5bA'2dZa'2dz0'2d9'2d'2b'5c'3c'5c'3e'2f'2f'5c'2a'5d'2a'5cs'2a >>= withAttribute FunctionTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","function_decl")) >> pDefault >>= withAttribute FunctionTok))

parseRules ("Scheme","Level1") =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Scheme","Level2"))
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules ("Scheme","Default")))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","Level1")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Scheme","Level2") =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Scheme","Level3"))
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules ("Scheme","Default")))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","Level2")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Scheme","Level3") =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Scheme","Level4"))
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules ("Scheme","Default")))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","Level3")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Scheme","Level4") =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Scheme","Level5"))
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules ("Scheme","Default")))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","Level4")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Scheme","Level5") =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Scheme","Level6"))
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules ("Scheme","Default")))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","Level5")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Scheme","Level6") =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Scheme","Level1"))
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules ("Scheme","Default")))
   <|>
   (currentContext >>= \x -> guard (x == ("Scheme","Level6")) >> pDefault >>= withAttribute NormalTok))


parseRules x = parseRules ("Scheme","Level0") <|> fail ("Unknown context" ++ show x)