{-# LANGUAGE OverloadedStrings #-} module Skylighting.Syntax.Haskell (syntax) where import Skylighting.Types import Data.Map import Skylighting.Regex import qualified Data.Set syntax :: Syntax syntax = Syntax { sName = "Haskell" , sFilename = "haskell.xml" , sShortname = "Haskell" , sContexts = fromList [ ( "C Preprocessor" , Context { cName = "C Preprocessor" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "defined" , "if" , "ifdef" , "ifndef" , "include" , "undef" ]) , rAttribute = OtherTok , 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 = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } ] , cAttribute = OtherTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Haddock" , Context { cName = "Haddock" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "'([A-Z][a-zA-Z0-9_']*\\.)*[a-z_][a-zA-Z0-9_']*'" , reCompiled = Just (compileRegex True "'([A-Z][a-zA-Z0-9_']*\\.)*[a-z_][a-zA-Z0-9_']*'") , reCaseSensitive = True } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\"([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*\"" , reCompiled = Just (compileRegex True "\"([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*\"") , reCaseSensitive = True } , rAttribute = CommentTok , 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 = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "Start Haddock Emphasis" ) ] } , Rule { rMatcher = RegExpr RE { reString = "__.*__" , reCompiled = Just (compileRegex True "__.*__") , reCaseSensitive = True } , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = True , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "Start Haddock Bold" ) ] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Haddock Bold" , Context { cName = "Haddock Bold" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Detect2Chars '_' '_' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "Haskell" , "Haddock" ) , 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 } ) , ( "Haddock Emphasis" , Context { cName = "Haddock Emphasis" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = DetectChar '/' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } , Rule { rMatcher = IncludeRules ( "Haskell" , "Haddock" ) , 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 } ) , ( "Hamlet" , Context { cName = "Hamlet" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = IncludeRules ( "Haskell" , "QuasiQuote" ) , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = IncludeRules ( "Hamlet" , "" ) , 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 } ) , ( "QuasiQuote" , Context { cName = "QuasiQuote" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Detect2Chars '|' ']' , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Start Haddock Bold" , Context { cName = "Start Haddock Bold" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Detect2Chars '_' '_' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "Haddock Bold" ) ] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "Start Haddock Emphasis" , Context { cName = "Start Haddock Emphasis" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = DetectChar '/' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "Haddock Emphasis" ) ] } ] , cAttribute = CommentTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "c2hs directive" , Context { cName = "c2hs directive" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Detect2Chars '#' '}' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "as" , "call" , "foreign" , "get" , "lib" , "nocode" , "prefix" , "pure" , "qualified" , "set" , "stable" , "unsafe" , "with" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "context" , reCompiled = Just (compileRegex True "context") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "call" , reCompiled = Just (compileRegex True "call") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "sizeof" , reCompiled = Just (compileRegex True "sizeof") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "alignof" , reCompiled = Just (compileRegex True "alignof") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "fun" , reCompiled = Just (compileRegex True "fun") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "c2hs fun" ) ] } , Rule { rMatcher = RegExpr RE { reString = "pointer" , reCompiled = Just (compileRegex True "pointer") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "c2hs pointer" ) ] } , Rule { rMatcher = RegExpr RE { reString = "enum" , reCompiled = Just (compileRegex True "enum") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "c2hs enum" ) ] } , Rule { rMatcher = RegExpr RE { reString = "import" , reCompiled = Just (compileRegex True "import") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "c2hs import" ) ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "c2hs enum" , Context { cName = "c2hs enum" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '#' '}' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "c2hs fun" , Context { cName = "c2hs fun" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "as" , "call" , "foreign" , "get" , "lib" , "nocode" , "prefix" , "pure" , "qualified" , "set" , "stable" , "unsafe" , "with" ]) , rAttribute = KeywordTok , 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 = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '#' '}' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "c2hs import" , Context { cName = "c2hs import" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '#' '}' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "c2hs pointer" , Context { cName = "c2hs pointer" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "as" , "call" , "foreign" , "get" , "lib" , "nocode" , "prefix" , "pure" , "qualified" , "set" , "stable" , "unsafe" , "with" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "newtype" , reCompiled = Just (compileRegex True "newtype") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Detect2Chars '#' '}' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop , Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "char" , Context { cName = "char" , cSyntax = "Haskell" , 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 = [] } , Rule { rMatcher = DetectChar '\'' , 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 } ) , ( "code" , Context { cName = "code" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = RegExpr RE { reString = "\\{-#.*#-\\}" , reCompiled = Just (compileRegex True "\\{-#.*#-\\}") , reCaseSensitive = True } , rAttribute = OtherTok , 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 = [] } , 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 = [ Push ( "Haskell" , "comments" ) ] } , 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 = [ Push ( "Haskell" , "comment" ) ] } , Rule { rMatcher = RegExpr RE { reString = "import\\s+" , reCompiled = Just (compileRegex True "import\\s+") , reCaseSensitive = True } , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "import" ) ] } , Rule { rMatcher = Detect2Chars '{' '#' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "c2hs directive" ) ] } , Rule { rMatcher = DetectChar '#' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Just 0 , rContextSwitch = [ Push ( "Haskell" , "C Preprocessor" ) ] } , Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "case" , "class" , "data" , "deriving" , "do" , "else" , "if" , "in" , "infixl" , "infixr" , "instance" , "let" , "module" , "newtype" , "of" , "primitive" , "then" , "type" , "where" ]) , 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 [ "FilePath" , "IOError" , "abs" , "acos" , "acosh" , "all" , "and" , "any" , "appendFile" , "approxRational" , "asTypeOf" , "asin" , "asinh" , "atan" , "atan2" , "atanh" , "basicIORun" , "break" , "catch" , "ceiling" , "chr" , "compare" , "concat" , "concatMap" , "const" , "cos" , "cosh" , "curry" , "cycle" , "decodeFloat" , "denominator" , "digitToInt" , "div" , "divMod" , "drop" , "dropWhile" , "either" , "elem" , "encodeFloat" , "enumFrom" , "enumFromThen" , "enumFromThenTo" , "enumFromTo" , "error" , "even" , "exp" , "exponent" , "fail" , "filter" , "flip" , "floatDigits" , "floatRadix" , "floatRange" , "floor" , "fmap" , "foldMap" , "foldl" , "foldl1" , "foldr" , "foldr1" , "fromDouble" , "fromEnum" , "fromInt" , "fromInteger" , "fromIntegral" , "fromRational" , "fst" , "gcd" , "getChar" , "getContents" , "getLine" , "group" , "head" , "id" , "inRange" , "index" , "init" , "intToDigit" , "interact" , "ioError" , "isAlpha" , "isAlphaNum" , "isAscii" , "isControl" , "isDenormalized" , "isDigit" , "isHexDigit" , "isIEEE" , "isInfinite" , "isLower" , "isNaN" , "isNegativeZero" , "isOctDigit" , "isPrint" , "isSpace" , "isUpper" , "iterate" , "last" , "lcm" , "length" , "lex" , "lexDigits" , "lexLitChar" , "lines" , "log" , "logBase" , "lookup" , "map" , "mapM" , "mapM_" , "mappend" , "max" , "maxBound" , "maximum" , "maybe" , "mconcat" , "mempty" , "min" , "minBound" , "minimum" , "mod" , "negate" , "not" , "notElem" , "null" , "numerator" , "odd" , "or" , "ord" , "otherwise" , "pack" , "pi" , "pred" , "primExitWith" , "print" , "product" , "properFraction" , "pure" , "putChar" , "putStr" , "putStrLn" , "quot" , "quotRem" , "range" , "rangeSize" , "read" , "readDec" , "readFile" , "readFloat" , "readHex" , "readIO" , "readInt" , "readList" , "readLitChar" , "readLn" , "readOct" , "readParen" , "readSigned" , "reads" , "readsPrec" , "realToFrac" , "recip" , "rem" , "repeat" , "replicate" , "return" , "reverse" , "round" , "scaleFloat" , "scanl" , "scanl1" , "scanr" , "scanr1" , "seq" , "sequence" , "sequenceA" , "sequence_" , "show" , "showChar" , "showInt" , "showList" , "showLitChar" , "showParen" , "showSigned" , "showString" , "shows" , "showsPrec" , "significand" , "signum" , "sin" , "sinh" , "snd" , "sort" , "span" , "splitAt" , "sqrt" , "subtract" , "succ" , "sum" , "tail" , "take" , "takeWhile" , "tan" , "tanh" , "threadToIOResult" , "toEnum" , "toInt" , "toInteger" , "toLower" , "toRational" , "toUpper" , "traverse" , "truncate" , "uncurry" , "undefined" , "unlines" , "until" , "unwords" , "unzip" , "unzip3" , "userError" , "words" , "writeFile" , "zip" , "zip3" , "zipWith" , "zipWith3" ]) , rAttribute = NormalTok , 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 [ "Bool" , "ByteString" , "Char" , "Double" , "Either" , "FilePath" , "Float" , "IO" , "IOError" , "Int" , "Integer" , "Maybe" , "Ordering" , "Ratio" , "Rational" , "ReadS" , "ShowS" , "String" , "Word" ]) , rAttribute = DataTypeTok , 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 [ "EQ" , "False" , "GT" , "Just" , "LT" , "Left" , "Nothing" , "Right" , "True" ]) , rAttribute = DataTypeTok , 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 [ "Applicative" , "Bounded" , "Enum" , "Eq" , "Floating" , "Foldable" , "Fractional" , "Functor" , "Integral" , "Ix" , "Monad" , "Monoid" , "Num" , "Ord" , "Read" , "Real" , "RealFloat" , "RealFrac" , "Show" , "Traversable" ]) , rAttribute = DataTypeTok , 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 = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = AnyChar "\8759\8658\8594\8592\8704\8707" , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\s*[a-z_][a-zA-Z0-9_']*\\s*(?=::([^\\-!#\\$%&\\*\\+/<=>\\?\\@\\^\\|~\\.:]|$))" , reCompiled = Just (compileRegex True "\\s*[a-z_][a-zA-Z0-9_']*\\s*(?=::([^\\-!#\\$%&\\*\\+/<=>\\?\\@\\^\\|~\\.:]|$))") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\s*(\\([\\-!#\\$%&\\*\\+/<=>\\?\\@\\^\\|~\\.:]*\\))*\\s*(?=::[^\\-!#\\$%&\\*\\+/<=>\\?\\@\\^\\|~\\.:])" , reCompiled = Just (compileRegex True "\\s*(\\([\\-!#\\$%&\\*\\+/<=>\\?\\@\\^\\|~\\.:]*\\))*\\s*(?=::[^\\-!#\\$%&\\*\\+/<=>\\?\\@\\^\\|~\\.:])") , reCaseSensitive = True } , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[a-z_][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[a-z_][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-0_']*\\.)*[\\-!#\\$%&\\*\\+/<=>\\?\\@\\^\\|~\\.:]+" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-0_']*\\.)*[\\-!#\\$%&\\*\\+/<=>\\?\\@\\^\\|~\\.:]+") , reCaseSensitive = True } , rAttribute = FunctionTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = DataTypeTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\d+\\.\\d+([Ee][+-]?\\d+)?|\\d+[Ee][+-]?\\d+" , reCompiled = Just (compileRegex True "\\d+\\.\\d+([Ee][+-]?\\d+)?|\\d+[Ee][+-]?\\d+") , reCaseSensitive = True } , rAttribute = FloatTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "0[Oo][0-7]+" , reCompiled = Just (compileRegex True "0[Oo][0-7]+") , reCaseSensitive = True } , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "0[Xx][0-9A-Fa-f]+" , reCompiled = Just (compileRegex True "0[Xx][0-9A-Fa-f]+") , reCaseSensitive = True } , rAttribute = BaseNTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = Int , rAttribute = DecValTok , 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 ( "Haskell" , "char" ) ] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "string" ) ] } , Rule { rMatcher = DetectChar '`' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "infix" ) ] } , Rule { rMatcher = Detect2Chars '.' '.' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = AnyChar "\8229" , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "\\[[wx]?hamlet\\|" , reCompiled = Just (compileRegex True "\\[[wx]?hamlet\\|") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "Hamlet" ) ] } , Rule { rMatcher = RegExpr RE { reString = "\\[[a-zA-Z_'](\\w|[_'])*\\|" , reCompiled = Just (compileRegex True "\\[[a-zA-Z_'](\\w|[_'])*\\|") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "QuasiQuote" ) ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "comment" , Context { cName = "comment" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = IncludeRules ( "Haskell" , "Haddock" ) , 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 } ) , ( "comments" , Context { cName = "comments" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Detect2Chars '{' '-' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "comment" ) ] } , Rule { rMatcher = Detect2Chars '-' '}' , rAttribute = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } , Rule { rMatcher = IncludeRules ( "Haskell" , "Haddock" ) , 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 } ) , ( "import" , Context { cName = "import" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = Keyword KeywordAttr { keywordCaseSensitive = True , keywordDelims = Data.Set.fromList "\t\n !%&()*+,-./:;<=>?[\\]^{|}~" } (makeWordSet True [ "as" , "hiding" , "qualified" ]) , rAttribute = KeywordTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[a-z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[a-z][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = NormalTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [] } , Rule { rMatcher = RegExpr RE { reString = "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*" , reCompiled = Just (compileRegex True "([A-Z][a-zA-Z0-9_']*\\.)*[A-Z][a-zA-Z0-9_']*") , reCaseSensitive = True } , rAttribute = DataTypeTok , 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 = OtherTok , 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 = CommentTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Push ( "Haskell" , "comments" ) ] } , 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 = [ Push ( "Haskell" , "comment" ) ] } ] , cAttribute = NormalTok , cLineEmptyContext = [] , cLineEndContext = [ Pop ] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "infix" , Context { cName = "infix" , cSyntax = "Haskell" , cRules = [ Rule { rMatcher = DetectChar '`' , rAttribute = OtherTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = OtherTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) , ( "string" , Context { cName = "string" , cSyntax = "Haskell" , 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 = [] } , Rule { rMatcher = DetectChar '"' , rAttribute = StringTok , rIncludeAttribute = False , rDynamic = False , rCaseSensitive = True , rChildren = [] , rLookahead = False , rFirstNonspace = False , rColumn = Nothing , rContextSwitch = [ Pop ] } ] , cAttribute = StringTok , cLineEmptyContext = [] , cLineEndContext = [] , cLineBeginContext = [] , cFallthrough = False , cFallthroughContext = [] , cDynamic = False } ) ] , sAuthor = "Nicolas Wu (zenzike@gmail.com)" , sVersion = "4" , sLicense = "LGPL" , sExtensions = [ "*.hs" , "*.chs" ] , sStartingContext = "code" }