{- This module was generated from data in the Kate syntax
   highlighting file clojure.xml, version 2, by Dominik Haumann [lisp] modified for clojure by Caspar Hasenclever -}

module Text.Highlighting.Kate.Syntax.Clojure
          (highlight, parseExpression, syntaxName, syntaxExtensions)
where
import Text.Highlighting.Kate.Types
import Text.Highlighting.Kate.Common
import Text.ParserCombinators.Parsec hiding (State)
import Data.Map (fromList)
import Control.Monad.State
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)
import qualified Data.Set as Set

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

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

-- | 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 parseExpressionInternal pEndLine

-- | Parse an expression using appropriate local context.
parseExpression :: KateParser Token
parseExpression = do
  st <- getState
  let oldLang = synStLanguage st
  setState $ st { synStLanguage = "Clojure" }
  context <- currentContext <|> (pushContext "Level0" >> currentContext)
  result <- parseRules context
  optional $ eof >> pEndLine
  updateState $ \st -> st { synStLanguage = oldLang }
  return result

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

pEndLine = do
  updateState $ \st -> st{ synStPrevNonspace = False }
  context <- currentContext
  case context of
    "Level0" -> return ()
    "Default" -> return ()
    "function_decl" -> return ()
    "SpecialNumber" -> (popContext) >> pEndLine
    "String" -> return ()
    "Level1" -> return ()
    "Level2" -> return ()
    "Level3" -> return ()
    "Level4" -> return ()
    "Level5" -> return ()
    "Level6" -> return ()
    _ -> 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)

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

list_definitions = Set.fromList $ words $ "def def- defalias defhinted definline defmacro defmacro- defmethod defmulti defn defn- defnk defn-memo defonce defonce- defprotocol defrecord defstruct defstruct- deftest deftest- deftype defunbound defunbound- defvar defvar-"
list_keywords = Set.fromList $ words $ "< <= = == > >= - -> ->> / . .. * + accessor aclone add-classpath add-watcher agent agent-errors aget alength alias all-ns alter alter-meta! alter-var-root amap ancestors and append-child apply apply-template are areduce array-map aset aset-boolean aset-byte aset-char aset-double aset-float aset-int aset-long aset-short assert assert-any assert-expr assert-predicate assoc assoc! associative? assoc-in atom atom? attrs await await1 await-for bases bean bigdec bigint binding bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set bit-shift-left bit-shift-right bit-test bit-xor boolean boolean-array booleans bound-fn bound-fn* branch? butlast byte byte-array bytes case cast catch char char? char-array char-escape-string char-name-string chars children chunk chunk-append chunk-buffer chunk-cons chunked-seq? chunk-first chunk-next chunk-rest class class? clear-agent-errors clojure-version coll? collection-tag comment commute comp comparator compare compare-and-set! compile complement compose-fixtures concat cond condp conj conj! cons constantly construct-proxy contains? content content-handler count counted? create-ns create-struct cycle dec decimal? declare delay delay? deliver deref derive descendants destructure difference disj disj! dissoc dissoc! distinct distinct? do doall doc dorun doseq dosync do-template dotimes doto double double-array doubles down drop drop-last drop-while e edit element emit emit-element empty empty? end? ensure enumeration-seq eval even? every? extend extenders extend-protocol extends? extend-type false? ffirst file-position file-seq filter finally find find-doc find-ns find-var first float float? float-array floats flush fn fn? fnext for force format function? future future? future-call future-cancel future-cancelled? future-done? gen-and-load-class gen-and-save-class gen-class gen-interface gensym get get-child get-child-count get-in get-method get-possibly-unbound-var get-proxy-class get-thread-bindings get-validator handle handler-case hash hash-map hash-set identical? identity if if-let ifn? if-not import inc inc-report-counter index init-proxy in-ns insert-child insert-left insert-right inspect inspect-table inspect-tree instance? int int-array integer? interleave intern interpose intersection into into-array ints io! is isa? is-leaf iterate iterator-seq join join-fixtures juxt key keys keyword keyword? keywordize-keys last lazy-cat lazy-seq left leftmost lefts let letfn line-seq list list* list? list-model list-provider load loaded-libs load-file load-reader load-script load-string locking long long-array longs loop macroexpand macroexpand-1 macroexpand-all main make-array make-hierarchy make-node map map? mapcat map-invert max max-key memfn memoize merge merge-with meta methods method-sig min min-key mod name namespace neg? newline next nfirst nil? nnext node not not= not-any? not-empty not-every? ns ns-aliases ns-imports ns-interns ns-map ns-name ns-publics ns-refers ns-resolve ns-unalias ns-unmap nth nthnext num number? odd? or parents partial partition path pcalls peek persistent! pmap pop pop! pop-thread-bindings pos? postwalk postwalk-demo postwalk-replace pr prefer-method prefers prev prewalk prewalk-demo prewalk-replace primitives-classnames print print-cause-trace print-ctor print-doc print-dup printf println println-str print-method print-namespace-doc print-simple print-special-doc print-stack-trace print-str print-throwable print-trace-element prn prn-str project promise proxy proxy-call-with-super proxy-mappings proxy-name proxy-super pr-str push-thread-bindings pvalues quot rand rand-int range ratio? rational? rationalize read read-line read-string recur reduce ref refer refer-clojure ref-history-count re-find ref-max-history ref-min-history ref-set re-groups reify release-pending-sends rem re-matcher re-matches remove remove-method remove-ns remove-watcher rename rename-keys re-pattern repeat repeatedly repl replace repl-caught repl-exception replicate repl-prompt repl-read report require re-seq reset! reset-meta! resolve rest resultset-seq reverse reversible? right rightmost rights root rseq rsubseq run-all-tests run-tests satisfies? second select select-keys send send-off seq seq? seque sequence sequential? seq-zip set set? set-test set-validator! short short-array shorts shutdown-agents skip-if-eol skip-whitespace slurp some sort sort-by sorted? sorted-map sorted-map-by sorted-set sorted-set-by special-form-anchor special-symbol? split-at split-with str stream? string? stringify-keys struct struct-map subs subseq subvec successful? supers swap! symbol symbol? sync syntax-symbol-anchor take take-last take-nth take-while test test-all-vars testing testing-contexts-str testing-vars-str test-ns test-var the-ns throw time to-array to-array-2d trampoline transient tree-seq true? try try-expr type unchecked-add unchecked-dec unchecked-divide unchecked-inc unchecked-multiply unchecked-negate unchecked-remainder unchecked-subtract underive unimport union unquote unquote-splicing up update-in update-proxy use use-fixtures val vals var? var-get var-set vary-meta vec vector vector? walk when when-first when-let when-not while with-bindings with-bindings* with-in-str with-loading-context with-local-vars with-meta with-open with-out-str with-precision with-test with-test-out xml-seq zero?"
list_variables = Set.fromList $ words $ "*1 *2 *3 *agent* *allow-unresolved-vars* *assert* *clojure-version* *command-line-args* *compile-files* *compile-path* *current* *e *err* *file* *flush-on-newline* *in* *initial-report-counters* *load-tests* *macro-meta* *math-context* *ns* *out* *print-dup* *print-length* *print-level* *print-meta* *print-readably* *read-eval* *report-counters* *sb* *source-path* *stack* *stack-trace-depth* *state* *testing-contexts* *testing-vars* *test-out* *use-context-classloader* *warn-on-reflection*"

regex_'3b'2e'2a'24 = compileRegex ";.*$"
regex_'5b'40'7e'5d'5cS'2b = compileRegex "[@~]\\S+"
regex_'3a'3a'3f'5ba'2dzA'2dZ0'2d9'5c'2d'5d'2b = compileRegex "::?[a-zA-Z0-9\\-]+"
regex_'5c'5c'2e = compileRegex "\\\\."
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*"
regex_'23'5c'5c'2e = compileRegex "#\\\\."

defaultAttributes = [("Level0",NormalTok),("Default",NormalTok),("function_decl",FunctionTok),("SpecialNumber",NormalTok),("String",StringTok),("Level1",NormalTok),("Level2",NormalTok),("Level3",NormalTok),("Level4",NormalTok),("Level5",NormalTok),("Level6",NormalTok)]

parseRules "Level0" =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext "Level1")
   <|>
   ((pDetect2Chars False '#' '(' >>= withAttribute NormalTok) >>~ pushContext "Level1")
   <|>
   ((parseRules "Default")))

parseRules "Default" =
  (((pRegExpr regex_'3b'2e'2a'24 >>= withAttribute CommentTok))
   <|>
   ((pDetect2Chars False '#' '_' >>= withAttribute CommentTok))
   <|>
   ((pRegExpr regex_'5b'40'7e'5d'5cS'2b >>= withAttribute KeywordTok))
   <|>
   ((pRegExpr regex_'3a'3a'3f'5ba'2dzA'2dZ0'2d9'5c'2d'5d'2b >>= withAttribute KeywordTok))
   <|>
   ((pDetect2Chars False '#' '{' >>= withAttribute NormalTok))
   <|>
   ((pDetect2Chars False '^' '{' >>= withAttribute NormalTok))
   <|>
   ((pDetectChar False '{' >>= withAttribute NormalTok))
   <|>
   ((pDetectChar False '}' >>= withAttribute NormalTok))
   <|>
   ((pDetectChar False '[' >>= withAttribute NormalTok))
   <|>
   ((pDetectChar False ']' >>= withAttribute NormalTok))
   <|>
   ((pDetect2Chars False '#' '\'' >>= withAttribute KeywordTok))
   <|>
   ((pKeyword " \n\t.(),%&;[]^{|}~" list_keywords >>= withAttribute KeywordTok))
   <|>
   ((pKeyword " \n\t.(),%&;[]^{|}~" list_variables >>= withAttribute KeywordTok))
   <|>
   ((pKeyword " \n\t.(),%&;[]^{|}~" list_definitions >>= withAttribute KeywordTok) >>~ pushContext "function_decl")
   <|>
   ((pRegExpr regex_'5c'5c'2e >>= withAttribute CharTok))
   <|>
   ((pDetect2Chars False '#' '"' >>= withAttribute StringTok) >>~ pushContext "String")
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext "String")
   <|>
   ((pFloat >>= withAttribute FloatTok))
   <|>
   ((pInt >>= withAttribute DecValTok))
   <|>
   ((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext "Level1"))

parseRules "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))

parseRules "SpecialNumber" =
  (((pFloat >>= withAttribute FloatTok) >>~ (popContext))
   <|>
   ((pInt >>= withAttribute DecValTok) >>~ (popContext))
   <|>
   ((pHlCOct >>= withAttribute BaseNTok) >>~ (popContext))
   <|>
   ((pHlCHex >>= withAttribute FloatTok) >>~ (popContext)))

parseRules "String" =
  (((pRegExpr regex_'23'5c'5c'2e >>= withAttribute CharTok))
   <|>
   ((pHlCStringChar >>= withAttribute NormalTok))
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext)))

parseRules "Level1" =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext "Level2")
   <|>
   ((pDetect2Chars False '#' '(' >>= withAttribute NormalTok) >>~ pushContext "Level2")
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules "Default")))

parseRules "Level2" =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext "Level3")
   <|>
   ((pDetect2Chars False '#' '(' >>= withAttribute NormalTok) >>~ pushContext "Level3")
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules "Default")))

parseRules "Level3" =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext "Level4")
   <|>
   ((pDetect2Chars False '#' '(' >>= withAttribute NormalTok) >>~ pushContext "Level4")
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules "Default")))

parseRules "Level4" =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext "Level5")
   <|>
   ((pDetect2Chars False '#' '(' >>= withAttribute NormalTok) >>~ pushContext "Level5")
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules "Default")))

parseRules "Level5" =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext "Level6")
   <|>
   ((pDetect2Chars False '#' '(' >>= withAttribute NormalTok) >>~ pushContext "Level6")
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules "Default")))

parseRules "Level6" =
  (((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext "Level1")
   <|>
   ((pDetect2Chars False '#' '(' >>= withAttribute NormalTok) >>~ pushContext "Level1")
   <|>
   ((pDetectChar False ')' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((parseRules "Default")))

parseRules "" = parseRules "Level0"

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