module Text.Highlighting.Kate.Syntax.Yaml
(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)
syntaxName :: String
syntaxName = "YAML"
syntaxExtensions :: String
syntaxExtensions = "*.yaml;*.yml"
highlight :: String -> [SourceLine]
highlight input = evalState (mapM parseSourceLine $ lines input) startingState
parseSourceLine :: String -> State SyntaxState SourceLine
parseSourceLine = mkParseSourceLine parseExpressionInternal pEndLine
parseExpression :: KateParser Token
parseExpression = do
st <- getState
let oldLang = synStLanguage st
setState $ st { synStLanguage = "YAML" }
context <- currentContext <|> (pushContext "normal" >> currentContext)
result <- parseRules context
optional $ eof >> pEndLine
updateState $ \st -> st { synStLanguage = oldLang }
return result
startingState = SyntaxState {synStContexts = fromList [("YAML",["normal"])], synStLanguage = "YAML", synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}
pEndLine = do
updateState $ \st -> st{ synStPrevNonspace = False }
context <- currentContext
case context of
"normal" -> return ()
"dash" -> (popContext) >> pEndLine
"header" -> (popContext) >> pEndLine
"EOD" -> return ()
"directive" -> (popContext) >> pEndLine
"attribute" -> (popContext >> popContext) >> pEndLine
"attribute-inline" -> return ()
"attribute-pre" -> (popContext) >> pEndLine
"attribute-pre-inline" -> (popContext) >> pEndLine
"list" -> return ()
"hash" -> return ()
"attribute-string" -> return ()
"attribute-stringx" -> return ()
"attribute-string-inline" -> return ()
"attribute-stringx-inline" -> return ()
"attribute-end" -> (popContext >> popContext >> popContext) >> pEndLine
"attribute-end-inline" -> (popContext >> popContext >> popContext) >> pEndLine
"string" -> return ()
"stringx" -> return ()
"comment" -> (popContext) >> pEndLine
_ -> 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))
regex_'2d'2d'2d = compileRegex "---"
regex_'5c'2e'5c'2e'5c'2e'24 = compileRegex "\\.\\.\\.$"
regex_'25 = compileRegex "%"
regex_'21'21'5cS'2b = compileRegex "!!\\S+"
regex_'26'5cS'2b = compileRegex "&\\S+"
regex_'5c'2a'5cS'2b = compileRegex "\\*\\S+"
regex_'5c'3f'3f'5cs'2a'5b'5e'22'27'23'2d'5d'5b'5e'3a'23'5d'2a'3a = compileRegex "\\??\\s*[^\"'#-][^:#]*:"
regex_'5c'3f'3f'5cs'2a'22'5b'5e'22'23'5d'2b'22'5cs'2a'3a = compileRegex "\\??\\s*\"[^\"#]+\"\\s*:"
regex_'5c'3f'3f'5cs'2a'27'5b'5e'27'23'5d'2b'27'5cs'2a'3a = compileRegex "\\??\\s*'[^'#]+'\\s*:"
regex_null'24 = compileRegex "null$"
regex_'2e = compileRegex "."
regex_'5cs'2a = compileRegex "\\s*"
regex_'2c'5cs = compileRegex ",\\s"
defaultAttributes = [("normal",NormalTok),("dash",NormalTok),("header",OtherTok),("EOD",CommentTok),("directive",OtherTok),("attribute",NormalTok),("attribute-inline",NormalTok),("attribute-pre",NormalTok),("attribute-pre-inline",NormalTok),("list",NormalTok),("hash",NormalTok),("attribute-string",NormalTok),("attribute-stringx",NormalTok),("attribute-string-inline",NormalTok),("attribute-stringx-inline",NormalTok),("attribute-end",ErrorTok),("attribute-end-inline",ErrorTok),("string",NormalTok),("stringx",NormalTok),("comment",CommentTok)]
parseRules "normal" =
(((pColumn 0 >> pRegExpr regex_'2d'2d'2d >>= withAttribute OtherTok) >>~ pushContext "header")
<|>
((pColumn 0 >> pRegExpr regex_'5c'2e'5c'2e'5c'2e'24 >>= withAttribute CommentTok) >>~ pushContext "EOD")
<|>
((pColumn 0 >> pRegExpr regex_'25 >>= withAttribute OtherTok) >>~ pushContext "directive")
<|>
((pDetectSpaces >>= withAttribute NormalTok))
<|>
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment")
<|>
((pFirstNonSpace >> pDetectChar False '-' >>= withAttribute KeywordTok) >>~ pushContext "dash")
<|>
((pDetectChar False '[' >>= withAttribute KeywordTok) >>~ pushContext "list")
<|>
((pDetectChar False '{' >>= withAttribute KeywordTok) >>~ pushContext "hash")
<|>
((pFirstNonSpace >> pRegExpr regex_'21'21'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pFirstNonSpace >> pRegExpr regex_'26'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pFirstNonSpace >> pRegExpr regex_'5c'2a'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'5b'5e'22'27'23'2d'5d'5b'5e'3a'23'5d'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre")
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'22'5b'5e'22'23'5d'2b'22'5cs'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre")
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'27'5b'5e'27'23'5d'2b'27'5cs'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre")
<|>
((pDetectChar False '\'' >>= withAttribute NormalTok) >>~ pushContext "string")
<|>
((pDetectChar False '"' >>= withAttribute NormalTok) >>~ pushContext "stringx"))
parseRules "dash" =
(((pDetectSpaces >>= withAttribute NormalTok))
<|>
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment")
<|>
((pRegExpr regex_null'24 >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'21'21'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'26'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'5c'2a'5cS'2b >>= withAttribute DataTypeTok))
<|>
((lookAhead (pRegExpr regex_'2e) >> (popContext) >> currentContext >>= parseRules)))
parseRules "header" =
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment")
parseRules "EOD" =
pzero
parseRules "directive" =
pzero
parseRules "attribute" =
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment")
parseRules "attribute-inline" =
(((pDetectChar False ',' >>= withAttribute KeywordTok) >>~ (popContext >> popContext))
<|>
((lookAhead (pDetectChar False '}') >> (popContext >> popContext) >> currentContext >>= parseRules))
<|>
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment"))
parseRules "attribute-pre" =
(((pDetectSpaces >>= withAttribute NormalTok))
<|>
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment")
<|>
((pRegExpr regex_null'24 >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'21'21'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pDetectChar False '[' >>= withAttribute KeywordTok) >>~ pushContext "list")
<|>
((pDetectChar False '{' >>= withAttribute KeywordTok) >>~ pushContext "hash")
<|>
((pDetectChar False '\'' >>= withAttribute NormalTok) >>~ pushContext "attribute-string")
<|>
((pDetectChar False '"' >>= withAttribute NormalTok) >>~ pushContext "attribute-stringx")
<|>
((pRegExpr regex_'26'5cS'2b >>= withAttribute DataTypeTok) >>~ pushContext "attribute")
<|>
((pRegExpr regex_'5c'2a'5cS'2b >>= withAttribute DataTypeTok) >>~ pushContext "attribute")
<|>
((pRegExpr regex_'2e >>= withAttribute NormalTok) >>~ pushContext "attribute"))
parseRules "attribute-pre-inline" =
(((pDetectSpaces >>= withAttribute NormalTok))
<|>
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment")
<|>
((pString False "null" >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'21'21'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pDetectChar False '[' >>= withAttribute KeywordTok) >>~ pushContext "list")
<|>
((pDetectChar False '{' >>= withAttribute KeywordTok) >>~ pushContext "hash")
<|>
((pDetectChar False '\'' >>= withAttribute NormalTok) >>~ pushContext "attribute-string-inline")
<|>
((pDetectChar False '"' >>= withAttribute NormalTok) >>~ pushContext "attribute-stringx-inline")
<|>
((pRegExpr regex_'26'5cS'2b >>= withAttribute DataTypeTok) >>~ pushContext "attribute-inline")
<|>
((pRegExpr regex_'5c'2a'5cS'2b >>= withAttribute DataTypeTok) >>~ pushContext "attribute-inline")
<|>
((pDetectChar False ',' >>= withAttribute KeywordTok) >>~ (popContext))
<|>
((lookAhead (pDetectChar False '}') >> (popContext) >> currentContext >>= parseRules))
<|>
((pRegExpr regex_'2e >>= withAttribute NormalTok) >>~ pushContext "attribute-inline"))
parseRules "list" =
(((pDetectSpaces >>= withAttribute NormalTok))
<|>
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment")
<|>
((pDetectChar False ']' >>= withAttribute KeywordTok) >>~ (popContext))
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'5b'5e'22'27'23'2d'5d'5b'5e'3a'23'5d'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre")
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'22'5b'5e'22'23'5d'2b'22'5cs'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre")
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'27'5b'5e'27'23'5d'2b'27'5cs'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre")
<|>
((pString False "null" >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'21'21'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pDetectChar False '[' >>= withAttribute KeywordTok) >>~ pushContext "list")
<|>
((pDetectChar False '{' >>= withAttribute KeywordTok) >>~ pushContext "hash")
<|>
((pRegExpr regex_'26'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pRegExpr regex_'5c'2a'5cS'2b >>= withAttribute DataTypeTok))
<|>
((pDetectChar False '\'' >>= withAttribute NormalTok) >>~ pushContext "string")
<|>
((pDetectChar False '"' >>= withAttribute NormalTok) >>~ pushContext "stringx")
<|>
((pDetectChar False ',' >>= withAttribute KeywordTok)))
parseRules "hash" =
(((pDetectSpaces >>= withAttribute NormalTok))
<|>
((pDetectChar False '#' >>= withAttribute CommentTok) >>~ pushContext "comment")
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'5b'5e'22'27'23'2d'5d'5b'5e'3a'23'5d'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre-inline")
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'22'5b'5e'22'23'5d'2b'22'5cs'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre-inline")
<|>
((pRegExpr regex_'5c'3f'3f'5cs'2a'27'5b'5e'27'23'5d'2b'27'5cs'2a'3a >>= withAttribute FunctionTok) >>~ pushContext "attribute-pre-inline")
<|>
((pDetectChar False '}' >>= withAttribute KeywordTok) >>~ (popContext)))
parseRules "attribute-string" =
(((pDetectIdentifier >>= withAttribute NormalTok))
<|>
((pDetectChar False '\'' >>= withAttribute NormalTok) >>~ pushContext "attribute-end"))
parseRules "attribute-stringx" =
(((pDetectIdentifier >>= withAttribute NormalTok))
<|>
((pDetectChar False '"' >>= withAttribute NormalTok) >>~ pushContext "attribute-end"))
parseRules "attribute-string-inline" =
(((pDetectIdentifier >>= withAttribute NormalTok))
<|>
((pDetectChar False '\'' >>= withAttribute NormalTok) >>~ pushContext "attribute-end-inline"))
parseRules "attribute-stringx-inline" =
(((pDetectIdentifier >>= withAttribute NormalTok))
<|>
((pDetectChar False '"' >>= withAttribute NormalTok) >>~ pushContext "attribute-end-inline"))
parseRules "attribute-end" =
pzero
parseRules "attribute-end-inline" =
(((pRegExpr regex_'5cs'2a >>= withAttribute NormalTok))
<|>
((lookAhead (pDetectChar False '}') >> (popContext >> popContext >> popContext) >> currentContext >>= parseRules))
<|>
((pRegExpr regex_'2c'5cs >>= withAttribute KeywordTok) >>~ (popContext >> popContext >> popContext)))
parseRules "string" =
(((pDetectIdentifier >>= withAttribute NormalTok))
<|>
((pDetectChar False '\'' >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "stringx" =
(((pDetectIdentifier >>= withAttribute NormalTok))
<|>
((pDetectChar False '"' >>= withAttribute NormalTok) >>~ (popContext)))
parseRules "comment" =
pzero
parseRules "" = parseRules "normal"
parseRules x = fail $ "Unknown context" ++ x