{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Erlang (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "Erlang" , sFilename = "erlang.xml" , sShortname = "Erlang" , sContexts = fromList [ ( "Normal Text" , Context { cName = "Normal Text" , cSyntax = "Erlang" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(?:-module|-export|-define|-undef|-ifdef|-ifndef|-else|-endif|-include|-include_lib)" , reCompiled = Just (compileRegex True "(?:-module|-export|-define|-undef|-ifdef|-ifndef|-else|-endif|-include|-include_lib)") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "after" , "all_true" , "begin" , "case" , "catch" , "cond" , "end" , "fun" , "if" , "let" , "of" , "query" , "receive" , "some_true" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "and" , "band" , "bnot" , "bor" , "bsl" , "bsr" , "bxor" , "div" , "not" , "or" , "rem" , "xor" ]) , rAttribute = OperatorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(?:\\+|-|\\*|\\/|==|\\/=|=:=|=\\/=|<|=<|>|>=|\\+\\+|--|=|!|<-)" , reCompiled = Just (compileRegex True "(?:\\+|-|\\*|\\/|==|\\/=|=:=|=\\/=|<|=<|>|>=|\\+\\+|--|=|!|<-)") , reCaseSensitive = True } , rAttribute = OperatorTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "abs" , "accept" , "alarm" , "apply" , "atom_to_list" , "binary_to_list" , "binary_to_term" , "check_process_code" , "concat_binary" , "date" , "delete_module" , "disconnect_node" , "element" , "erase" , "exit" , "float" , "float_to_list" , "garbage_collect" , "get" , "get_keys" , "group_leader" , "halt" , "hd" , "integer_to_list" , "is_alive" , "is_atom" , "is_binary" , "is_boolean" , "is_float" , "is_function" , "is_integer" , "is_list" , "is_number" , "is_pid" , "is_port" , "is_process_alive" , "is_record" , "is_reference" , "is_tuple" , "length" , "link" , "list_to_atom" , "list_to_binary" , "list_to_float" , "list_to_integer" , "list_to_pid" , "list_to_tuple" , "load_module" , "loaded" , "localtime" , "make_ref" , "module_loaded" , "node" , "nodes" , "now" , "open_port" , "pid_to_list" , "port_close" , "port_command" , "port_connect" , "port_control" , "ports" , "pre_loaded" , "process_flag" , "process_info" , "processes" , "purge_module" , "put" , "register" , "registered" , "round" , "self" , "setelement" , "size" , "spawn" , "spawn_link" , "spawn_opt" , "split_binary" , "statistics" , "term_to_binary" , "throw" , "time" , "tl" , "trunc" , "tuple_to_list" , "unlink" , "unregister" , "whereis" ]) , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "(?:\\(|\\)|\\{|\\}|\\[|\\]|\\.|\\:|\\||\\|\\||;|\\,|\\?|->|\\#)" , reCompiled = Just (compileRegex True "(?:\\(|\\)|\\{|\\}|\\[|\\]|\\.|\\:|\\||\\|\\||;|\\,|\\?|->|\\#)") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectSpaces , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '%' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Erlang" , "comment" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$):\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)" , reCompiled = Just (compileRegex True "\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$):\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)\\(" , reCompiled = Just (compileRegex True "\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)\\(") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Erlang" , "isfunction" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\b[_A-Z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)" , reCompiled = Just (compileRegex True "\\b[_A-Z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)") , reCaseSensitive = True } , rAttribute = VariableTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '\'' , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Erlang" , "atomquote" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)" , reCompiled = Just (compileRegex True "\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Erlang" , "stringquote" ) ] } , Rule { rMatcher = RegExpr RE { reString = "[0-9]+\\.[0-9]+(?:[eE][+-]?[0-9]+)?" , reCompiled = Just (compileRegex True "[0-9]+\\.[0-9]+(?:[eE][+-]?[0-9]+)?") , reCaseSensitive = True } , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\d+#[a-zA-Z0-9]+" , reCompiled = Just (compileRegex True "\\d+#[a-zA-Z0-9]+") , reCaseSensitive = True } , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\$\\S" , reCompiled = Just (compileRegex True "\\$\\S") , 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]+" , reCompiled = Just (compileRegex True "[0-9]+") , reCaseSensitive = True } , 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 } ) , ( "atomquote" , Context { cName = "atomquote" , cSyntax = "Erlang" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(?:(?:\\\\')?[^']*)*'" , reCompiled = Just (compileRegex True "(?:(?:\\\\')?[^']*)*'") , reCaseSensitive = True } , rAttribute = CharTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = CharTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "comment" , Context { cName = "comment" , cSyntax = "Erlang" , cRules = [ Rule { rMatcher = DetectSpaces , rAttribute = CommentTok , 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 = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "isfunction" , Context { cName = "isfunction" , cSyntax = "Erlang" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)" , reCompiled = Just (compileRegex True "\\b[a-z][_a-z@-Z0-9]*(?:(?=[^_a-z@-Z0-9])|$)") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = FunctionTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "stringquote" , Context { cName = "stringquote" , cSyntax = "Erlang" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "(?:(?:\\\\\")?[^\"]*)*\"" , reCompiled = Just (compileRegex True "(?:(?:\\\\\")?[^\"]*)*\"") , reCaseSensitive = True } , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "Bill Ross (bill@emailme.net.au)" , sVersion = "3" , sLicense = "LGPLv2" , sExtensions = [ "*.erl" ] , sStartingContext = "Normal Text" }