{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Markdown (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex syntax :: Syntax syntax = Syntax { sName = "Markdown" , sFilename = "markdown.xml" , sShortname = "Markdown" , sContexts = fromList [ ( "Normal Text" , Context { cName = "Normal Text" , cSyntax = "Markdown" , cRules = [ Rule { rMatcher = DetectChar '>' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [ Push ( "Markdown" , "blockquote" ) ] } , Rule { rMatcher = RegExpr RE { reString = "#\\s.*[#]?$" , reCompiled = Just (compileRegex True "#\\s.*[#]?$") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "##\\s.*[#]?$" , reCompiled = Just (compileRegex True "##\\s.*[#]?$") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "###\\s.*[#]?$" , reCompiled = Just (compileRegex True "###\\s.*[#]?$") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "####\\s.*[#]?$" , reCompiled = Just (compileRegex True "####\\s.*[#]?$") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "#####\\s.*[#]?$" , reCompiled = Just (compileRegex True "#####\\s.*[#]?$") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "######\\s.*[#]?$" , reCompiled = Just (compileRegex True "######\\s.*[#]?$") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\s*([\\*\\-_]\\s?){3,}\\s*" , reCompiled = Just (compileRegex True "\\s*([\\*\\-_]\\s?){3,}\\s*") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\s|^)[\\*_]{2}[^\\s]{1}[^\\*_]+[\\*_]{2}(\\s|\\.|,|;|:|\\-|\\?|$)" , reCompiled = Just (compileRegex True "(\\s|^)[\\*_]{2}[^\\s]{1}[^\\*_]+[\\*_]{2}(\\s|\\.|,|;|:|\\-|\\?|$)") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\s|^)[\\*_]{1}[^\\s]{1}[^\\*_]+[\\*_]{1}(\\s|\\.|,|;|:|\\-|\\?|$)" , reCompiled = Just (compileRegex True "(\\s|^)[\\*_]{1}[^\\s]{1}[^\\*_]+[\\*_]{1}(\\s|\\.|,|;|:|\\-|\\?|$)") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\s|^)[\\*_]{3}[^\\*_]+[\\*_]{3}(\\s|\\.|,|;|:|\\-|\\?|$)" , reCompiled = Just (compileRegex True "(\\s|^)[\\*_]{3}[^\\*_]+[\\*_]{3}(\\s|\\.|,|;|:|\\-|\\?|$)") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "([\\s]{4,}|\\t+).*$" , reCompiled = Just (compileRegex True "([\\s]{4,}|\\t+).*$") , reCaseSensitive = True } , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "[\\*\\+\\-]\\s" , reCompiled = Just (compileRegex True "[\\*\\+\\-]\\s") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [ Push ( "Markdown" , "bullet" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[\\d]+\\.\\s" , reCompiled = Just (compileRegex True "[\\d]+\\.\\s") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [ Push ( "Markdown" , "numlist" ) ] } , Rule { rMatcher = RegExpr RE { reString = "(Title|Author|Date|Copyright|Revision|CSS|LaTeX\\ XSLT|Categories|Tags|BaseName|Excerpt):(.*)+$" , reCompiled = Just (compileRegex True "(Title|Author|Date|Copyright|Revision|CSS|LaTeX\\ XSLT|Categories|Tags|BaseName|Excerpt):(.*)+$") , reCaseSensitive = True } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Markdown" , "inc" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "blockquote" , Context { cName = "blockquote" , cSyntax = "Markdown" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(\\s|^)[\\*_]{2}[^\\s]{1}[^\\*_]+[\\*_]{2}(\\s|\\.|,|;|:|\\-|\\?|$)" , reCompiled = Just (compileRegex True "(\\s|^)[\\*_]{2}[^\\s]{1}[^\\*_]+[\\*_]{2}(\\s|\\.|,|;|:|\\-|\\?|$)") , reCaseSensitive = True } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\s|^)[\\*_]{1}[^\\s]{1}[^\\*_]+[\\*_]{1}(\\s|\\.|,|;|:|\\-|\\?|$)" , reCompiled = Just (compileRegex True "(\\s|^)[\\*_]{1}[^\\s]{1}[^\\*_]+[\\*_]{1}(\\s|\\.|,|;|:|\\-|\\?|$)") , reCaseSensitive = True } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Markdown" , "inc" ) , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = DataTypeTok , cLineEmptyContext = [ Pop ] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "bullet" , Context { cName = "bullet" , cSyntax = "Markdown" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(\\s|^)[\\*_]{2}[^\\s]{1}[^\\*_]+[\\*_]{2}(\\s|\\.|,|;|:|\\-|\\?|$)" , reCompiled = Just (compileRegex True "(\\s|^)[\\*_]{2}[^\\s]{1}[^\\*_]+[\\*_]{2}(\\s|\\.|,|;|:|\\-|\\?|$)") , reCaseSensitive = True } , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(\\s|^)[\\*_]{1}[^\\s]{1}[^\\*_]+[\\*_]{1}(\\s|\\.|,|;|:|\\-|\\?|$)" , reCompiled = Just (compileRegex True "(\\s|^)[\\*_]{1}[^\\s]{1}[^\\*_]+[\\*_]{1}(\\s|\\.|,|;|:|\\-|\\?|$)") , reCaseSensitive = True } , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Markdown" , "inc" ) , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = FloatTok , cLineEmptyContext = [ Pop ] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "comment" , Context { cName = "comment" , cSyntax = "Markdown" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "-->" , reCompiled = Just (compileRegex True "-->") , reCaseSensitive = True } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "inc" , Context { cName = "inc" , cSyntax = "Markdown" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "`[^`]+`" , reCompiled = Just (compileRegex True "`[^`]+`") , reCaseSensitive = True } , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "