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

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

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

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

parseSourceLine = manyTill parseExpressionInternal pEndLine

pEndLine = do
  lookAhead $ newline <|> (eof >> return '\n')
  context <- currentContext
  case context of
    "Normal" -> return () >> pHandleEndLine
    "function_decl" -> return () >> pHandleEndLine
    "SpecialNumber" -> (popContext) >> pEndLine
    "String" -> return () >> pHandleEndLine
    _ -> 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"),("Operator","kw"),("Modifier","kw"),("Variable","kw"),("Definition","kw"),("Data","dt"),("Decimal","dv"),("BaseN","bn"),("Float","fl"),("Function","fu"),("Char","ch"),("String","st"),("Comment","co"),("Region Marker","re")]

parseExpressionInternal = do
  context <- currentContext
  parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ 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"
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_'3a'5cS'2b = compileRegex ":\\S+"
regex_'5b'40'7e'5d'5cS'2b = compileRegex "[@~]\\S+"
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 = [("Normal","Normal"),("function_decl","Function"),("SpecialNumber","Normal"),("String","String")]

parseRules "Normal" = 
  do (attr, result) <- (((pRegExpr regex_'3b'2e'2a'24 >>= withAttribute "Comment"))
                        <|>
                        ((pDetect2Chars False '#' '_' >>= withAttribute "Comment"))
                        <|>
                        ((pRegExpr regex_'3a'5cS'2b >>= withAttribute "Modifier"))
                        <|>
                        ((pRegExpr regex_'5b'40'7e'5d'5cS'2b >>= withAttribute "Modifier"))
                        <|>
                        ((pDetect2Chars False '#' '(' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetectChar False '(' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetectChar False ')' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetect2Chars False '#' '{' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetect2Chars False '^' '{' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetectChar False '{' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetectChar False '}' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetectChar False '[' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetectChar False ']' >>= withAttribute "Brackets"))
                        <|>
                        ((pDetect2Chars False '#' '\'' >>= withAttribute "Variable"))
                        <|>
                        ((pKeyword " \n\t.(),%&;[]^{|}~" list_keywords >>= withAttribute "Keyword"))
                        <|>
                        ((pKeyword " \n\t.(),%&;[]^{|}~" list_variables >>= withAttribute "Variable"))
                        <|>
                        ((pKeyword " \n\t.(),%&;[]^{|}~" list_definitions >>= withAttribute "Definition") >>~ pushContext "function_decl")
                        <|>
                        ((pRegExpr regex_'5c'5c'2e >>= withAttribute "Char"))
                        <|>
                        ((pDetect2Chars False '#' '"' >>= withAttribute "String") >>~ pushContext "String")
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "String")
                        <|>
                        ((pFloat >>= withAttribute "Float"))
                        <|>
                        ((pInt >>= withAttribute "Decimal")))
     return (attr, result)

parseRules "function_decl" = 
  do (attr, result) <- ((pRegExpr regex_'5cs'2a'5bA'2dZa'2dz0'2d9'2d'2b'5c'3c'5c'3e'2f'2f'5c'2a'5d'2a'5cs'2a >>= withAttribute "Function") >>~ (popContext))
     return (attr, result)

parseRules "SpecialNumber" = 
  do (attr, result) <- (((pFloat >>= withAttribute "Float") >>~ (popContext))
                        <|>
                        ((pInt >>= withAttribute "Decimal") >>~ (popContext))
                        <|>
                        ((pHlCOct >>= withAttribute "BaseN") >>~ (popContext))
                        <|>
                        ((pHlCHex >>= withAttribute "Float") >>~ (popContext)))
     return (attr, result)

parseRules "String" = 
  do (attr, result) <- (((pRegExpr regex_'23'5c'5c'2e >>= withAttribute "Char"))
                        <|>
                        ((pHlCStringChar >>= withAttribute "String Char"))
                        <|>
                        ((pDetectChar False '"' >>= withAttribute "String") >>~ (popContext)))
     return (attr, result)

parseRules "" = parseRules "Normal"

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