{- 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 Control.Monad.State
import Data.Char (isSpace)
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 (parseExpression Nothing)

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

startingState = SyntaxState {synStContexts = [("Clojure","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
      ("Clojure","Level0") -> return ()
      ("Clojure","Default") -> return ()
      ("Clojure","function_decl") -> return ()
      ("Clojure","SpecialNumber") -> (popContext) >> pEndLine
      ("Clojure","String") -> return ()
      ("Clojure","Level1") -> return ()
      ("Clojure","Level2") -> return ()
      ("Clojure","Level3") -> return ()
      ("Clojure","Level4") -> return ()
      ("Clojure","Level5") -> return ()
      ("Clojure","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_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 "#\\\\."

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

parseRules ("Clojure","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 ("Clojure","function_decl"))
   <|>
   ((pRegExpr regex_'5c'5c'2e >>= withAttribute CharTok))
   <|>
   ((pDetect2Chars False '#' '"' >>= withAttribute StringTok) >>~ pushContext ("Clojure","String"))
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext ("Clojure","String"))
   <|>
   ((pFloat >>= withAttribute FloatTok))
   <|>
   ((pInt >>= withAttribute DecValTok))
   <|>
   ((pDetectChar False '(' >>= withAttribute NormalTok) >>~ pushContext ("Clojure","Level1"))
   <|>
   (currentContext >>= \x -> guard (x == ("Clojure","Default")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Clojure","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 == ("Clojure","function_decl")) >> pDefault >>= withAttribute FunctionTok))

parseRules ("Clojure","SpecialNumber") =
  (((pFloat >>= withAttribute FloatTok) >>~ (popContext))
   <|>
   ((pInt >>= withAttribute DecValTok) >>~ (popContext))
   <|>
   ((pHlCOct >>= withAttribute BaseNTok) >>~ (popContext))
   <|>
   ((pHlCHex >>= withAttribute FloatTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("Clojure","SpecialNumber")) >> pDefault >>= withAttribute NormalTok))

parseRules ("Clojure","String") =
  (((pRegExpr regex_'23'5c'5c'2e >>= withAttribute CharTok))
   <|>
   ((pHlCStringChar >>= withAttribute NormalTok))
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext))
   <|>
   (currentContext >>= \x -> guard (x == ("Clojure","String")) >> pDefault >>= withAttribute StringTok))

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

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

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

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

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

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


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