{- This module was generated from data in the Kate syntax highlighting file xslt.xml, version 1.03, by Peter Lammich (views@gmx.de) -} module Text.Highlighting.Kate.Syntax.Xslt (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 = "xslt" -- | Filename extensions for this language. syntaxExtensions :: String syntaxExtensions = "*.xsl;*.xslt" -- | 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 = "xslt" } context <- currentContext <|> (pushContext "normalText" >> currentContext) result <- parseRules context optional $ eof >> pEndLine updateState $ \st -> st { synStLanguage = oldLang } return result startingState = SyntaxState {synStContexts = fromList [("xslt",["normalText"])], synStLanguage = "xslt", synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = False, synStCaptures = []} pEndLine = do updateState $ \st -> st{ synStPrevNonspace = False } context <- currentContext case context of "normalText" -> return () "CDATA" -> return () "PI" -> return () "Doctype" -> return () "Doctype Internal Subset" -> return () "Doctype Markupdecl" -> return () "Doctype Markupdecl DQ" -> return () "Doctype Markupdecl SQ" -> return () "detectEntRef" -> return () "FindPEntityRefs" -> return () "tagname" -> return () "attributes" -> return () "attrValue" -> return () "xattributes" -> return () "xattrValue" -> return () "string" -> return () "sqstring" -> return () "comment" -> return () "xpath" -> return () "sqxpath" -> return () "sqxpathstring" -> return () "xpathstring" -> 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_keytags = Set.fromList $ words $ "xsl:value-of xsl:output xsl:decimal-format xsl:apply-templates xsl:param xsl:transform xsl:namespace-alias xsl:comment xsl:element xsl:attribute xsl:apply-imports xsl:text xsl:when xsl:template xsl:processing-instruction xsl:include xsl:copy-of xsl:copy xsl:with-param xsl:stylesheet xsl:for-each xsl:choose xsl:sort xsl:otherwise xsl:key xsl:variable xsl:number xsl:message xsl:fallback xsl:strip-space xsl:import xsl:preserve-space xsl:if xsl:call-template xsl:attribute-set" list_keytags'5f2'2e0 = Set.fromList $ words $ "xsl:perform-sort xsl:import-schema xsl:for-each-group xsl:sequence xsl:non-matching-substring xsl:namespace xsl:next-match xsl:function xsl:analyze-string xsl:output-character xsl:matching-substring xsl:result-document xsl:character-map xsl:document" list_functions = Set.fromList $ words $ "format-number position lang substring-before substring normalize-space round translate starts-with concat local-name key count document system-property current boolean number contains name last unparsed-entity-uri sum generate-id function-available element-available false substring-after not string-length id floor ceiling namespace-uri true string text" list_functions'5f2'2e0 = Set.fromList $ words $ "zero-or-one replace namespace-uri-for-prefix current-grouping-key seconds-from-duration resolve-uri node-kind minutes-from-datetime implicit-timezone exactly-one current-time current-datetime unordered subtract-dates-yielding-daytimeduration string-join static-base-uri months-from-duration input exists default-collation datetime current-group current-date collection timezone-from-time matches local-name-from-qname day-from-date timezone-from-date round-half-to-even month-from-datetime month-from-date hours-from-duration escape-uri distinct-values avg years-from-duration unparsed-text unparsed-entity-public-id subtract-datetimes-yielding-daytimeduration subtract-dates-yielding-yearmonthduration string-to-codepoints sequence-node-identical hours-from-time hours-from-datetime format-time codepoints-to-string trace tokenize subtract-datetimes-yielding-yearmonthduration subsequence seconds-from-datetime regex-group one-or-more node-name namespace-uri-from-qname min idref format-datetime format-date days-from-duration compare base-uri seconds-from-time in-scope-prefixes expanded-qname adjust-date-to-timezone year-from-date resolve-qname remove qname minutes-from-time max lower-case index-of doc deep-equal data minutes-from-duration adjust-datetime-to-timezone abs timezone-from-datetime reverse error ends-with day-from-datetime year-from-datetime upper-case root normalize-unicode empty insert-before document-uri adjust-time-to-timezone" regex_'3c'21DOCTYPE'5cs'2b = compileRegex "))+" regex_'28FIXME'7cTODO'7cHACK'29 = compileRegex "(FIXME|TODO|HACK)" regex_'28ancestor'7cancestor'2dor'2dself'7cattribute'7cchild'7cdescendant'7cdescendant'2dor'2dself'7cfollowing'7cfollowing'2dsibling'7cnamespace'7cparent'7cpreceding'7cpreceding'2dsibling'7cself'29'3a'3a = compileRegex "(ancestor|ancestor-or-self|attribute|child|descendant|descendant-or-self|following|following-sibling|namespace|parent|preceding|preceding-sibling|self)::" regex_'40'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a = compileRegex "@[A-Za-z_:][\\w.:_-]*" regex_'5c'24'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a = compileRegex "\\$[A-Za-z_:][\\w.:_-]*" regex_'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a = compileRegex "[A-Za-z_:][\\w.:_-]*" defaultAttributes = [("normalText",NormalTok),("CDATA",NormalTok),("PI",NormalTok),("Doctype",NormalTok),("Doctype Internal Subset",NormalTok),("Doctype Markupdecl",NormalTok),("Doctype Markupdecl DQ",NormalTok),("Doctype Markupdecl SQ",NormalTok),("detectEntRef",NormalTok),("FindPEntityRefs",NormalTok),("tagname",KeywordTok),("attributes",OtherTok),("attrValue",ErrorTok),("xattributes",OtherTok),("xattrValue",ErrorTok),("string",StringTok),("sqstring",StringTok),("comment",CommentTok),("xpath",OtherTok),("sqxpath",OtherTok),("sqxpathstring",StringTok),("xpathstring",StringTok)] parseRules "normalText" = (((pString False "" >>= withAttribute CommentTok) >>~ (popContext)) <|> ((pRegExpr regex_'2d'28'2d'28'3f'21'2d'3e'29'29'2b >>= withAttribute ErrorTok)) <|> ((pRegExpr regex_'28FIXME'7cTODO'7cHACK'29 >>= withAttribute AlertTok))) parseRules "xpath" = (((pKeyword " \n\t.()!+,<=>%&*/;?[]^{|}~\\\"{}" list_functions >>= withAttribute KeywordTok)) <|> ((pKeyword " \n\t.()!+,<=>%&*/;?[]^{|}~\\\"{}" list_functions'5f2'2e0 >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'28ancestor'7cancestor'2dor'2dself'7cattribute'7cchild'7cdescendant'7cdescendant'2dor'2dself'7cfollowing'7cfollowing'2dsibling'7cnamespace'7cparent'7cpreceding'7cpreceding'2dsibling'7cself'29'3a'3a >>= withAttribute KeywordTok)) <|> ((pDetectChar False '}' >>= withAttribute OtherTok) >>~ (popContext)) <|> ((pDetectChar False '\'' >>= withAttribute StringTok) >>~ pushContext "sqxpathstring") <|> ((pDetectChar False '"' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> ((pRegExpr regex_'40'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5c'24'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a >>= withAttribute OtherTok)) <|> ((pDetectChar False '$' >>= withAttribute ErrorTok)) <|> ((parseRules "detectEntRef"))) parseRules "sqxpath" = (((pKeyword " \n\t.()!+,<=>%&*/;?[]^{|}~\\\"{}" list_functions >>= withAttribute KeywordTok)) <|> ((pKeyword " \n\t.()!+,<=>%&*/;?[]^{|}~\\\"{}" list_functions'5f2'2e0 >>= withAttribute KeywordTok)) <|> ((pRegExpr regex_'28ancestor'7cancestor'2dor'2dself'7cattribute'7cchild'7cdescendant'7cdescendant'2dor'2dself'7cfollowing'7cfollowing'2dsibling'7cnamespace'7cparent'7cpreceding'7cpreceding'2dsibling'7cself'29'3a'3a >>= withAttribute KeywordTok)) <|> ((pDetectChar False '}' >>= withAttribute OtherTok) >>~ (popContext)) <|> ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext "xpathstring") <|> ((pDetectChar False '\'' >>= withAttribute OtherTok) >>~ (popContext >> popContext)) <|> ((pRegExpr regex_'40'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5c'24'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a >>= withAttribute NormalTok)) <|> ((pRegExpr regex_'5bA'2dZa'2dz'5f'3a'5d'5b'5cw'2e'3a'5f'2d'5d'2a >>= withAttribute OtherTok)) <|> ((pDetectChar False '$' >>= withAttribute ErrorTok)) <|> ((parseRules "detectEntRef"))) parseRules "sqxpathstring" = (((pDetectChar False '\'' >>= withAttribute StringTok) >>~ (popContext)) <|> ((parseRules "detectEntRef"))) parseRules "xpathstring" = (((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext)) <|> ((parseRules "detectEntRef"))) parseRules "" = parseRules "normalText" parseRules x = fail $ "Unknown context" ++ x