{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Xml (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex syntax :: Syntax syntax = Syntax { sName = "XML" , sFilename = "xml.xml" , sShortname = "Xml" , sContexts = fromList [ ( "Attribute" , Context { cName = "Attribute" , cSyntax = "XML" , cRules = [ Rule { rMatcher = DetectChar '=' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "XML" , "Value" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\S" , reCompiled = Just (compileRegex True "\\S") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "CDATA" , Context { cName = "CDATA" , cSyntax = "XML" , cRules = [ Rule { rMatcher = DetectSpaces , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectIdentifier , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "]]>" , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = StringDetect "]]>" , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Comment" , Context { cName = "Comment" , cSyntax = "XML" , cRules = [ Rule { rMatcher = DetectSpaces , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "-->" , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "-(-(?!->))+" , reCompiled = Just (compileRegex True "-(-(?!->))+") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Alerts" , "" ) , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectIdentifier , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Doctype" , Context { cName = "Doctype" , cSyntax = "XML" , cRules = [ Rule { rMatcher = DetectChar '>' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '[' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "XML" , "Doctype Internal Subset" ) ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Doctype Internal Subset" , Context { cName = "Doctype Internal Subset" , cSyntax = "XML" , cRules = [ Rule { rMatcher = DetectChar ']' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = RegExpr RE { reString = "' , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "XML" , "Doctype Markupdecl DQ" ) ] } , Rule { rMatcher = DetectChar '\'' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "XML" , "Doctype Markupdecl SQ" ) ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Doctype Markupdecl DQ" , Context { cName = "Doctype Markupdecl DQ" , cSyntax = "XML" , cRules = [ Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "XML" , "FindPEntityRefs" ) , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Doctype Markupdecl SQ" , Context { cName = "Doctype Markupdecl SQ" , cSyntax = "XML" , cRules = [ Rule { rMatcher = DetectChar '\'' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "XML" , "FindPEntityRefs" ) , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "El Content" , Context { cName = "El Content" , cSyntax = "XML" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop , Pop ] } , Rule { rMatcher = RegExpr RE { reString = "\\S" , reCompiled = Just (compileRegex True "\\S") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Element" , Context { cName = "Element" , cSyntax = "XML" , cRules = [ Rule { rMatcher = Detect2Chars '/' '>' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = DetectChar '>' , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "XML" , "El Content" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(?![0-9])[\\w_:][\\w.:_-]*" , reCompiled = Just (compileRegex True "(?![0-9])[\\w_:][\\w.:_-]*") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [ Push ( "XML" , "Attribute" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\s+(?![0-9])[\\w_:][\\w.:_-]*" , reCompiled = Just (compileRegex True "\\s+(?![0-9])[\\w_:][\\w.:_-]*") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "XML" , "Attribute" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\S" , reCompiled = Just (compileRegex True "\\S") , reCaseSensitive = True } , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "FindEntityRefs" , Context { cName = "FindEntityRefs" , cSyntax = "XML" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "&(#[0-9]+|#[xX][0-9A-Fa-f]+|(?![0-9])[\\w_:][\\w.:_-]*);" , reCompiled = Just (compileRegex True "&(#[0-9]+|#[xX][0-9A-Fa-f]+|(?![0-9])[\\w_:][\\w.:_-]*);") , reCaseSensitive = True } , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = AnyChar "&<" , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "FindPEntityRefs" , Context { cName = "FindPEntityRefs" , cSyntax = "XML" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "&(#[0-9]+|#[xX][0-9A-Fa-f]+|(?![0-9])[\\w_:][\\w.:_-]*);" , reCompiled = Just (compileRegex True "&(#[0-9]+|#[xX][0-9A-Fa-f]+|(?![0-9])[\\w_:][\\w.:_-]*);") , reCaseSensitive = True } , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "%(?![0-9])[\\w_:][\\w.:_-]*;" , reCompiled = Just (compileRegex True "%(?![0-9])[\\w_:][\\w.:_-]*;") , reCaseSensitive = True } , rAttribute = DecValTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = AnyChar "&%" , rAttribute = ErrorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "FindXML" , Context { cName = "FindXML" , cSyntax = "XML" , cRules = [ Rule { rMatcher = DetectSpaces , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = StringDetect "