module Text.Highlighting.Kate.Syntax.Gettext ( highlight, parseExpression, syntaxName, syntaxExtensions ) where
import Text.Highlighting.Kate.Definitions
import Text.Highlighting.Kate.Common
import Text.ParserCombinators.Parsec
import Control.Monad (when)
import Data.Map (fromList)
import Data.Maybe (fromMaybe, maybeToList)
syntaxName :: String
syntaxName = "GNU Gettext"
syntaxExtensions :: String
syntaxExtensions = "*.po;*.pot"
highlight :: String -> Either String [SourceLine]
highlight input =
case runParser parseSource startingState "source" input of
Left err -> Left $ show err
Right result -> Right result
parseExpression :: GenParser Char SyntaxState LabeledSource
parseExpression = do
st <- getState
let oldLang = synStLanguage st
setState $ st { synStLanguage = "GNU Gettext" }
context <- currentContext <|> (pushContext "Normal" >> currentContext)
result <- parseRules context
updateState $ \st -> st { synStLanguage = oldLang }
return result
parseSource = do
lineContents <- lookAhead wholeLine
updateState $ \st -> st { synStCurrentLine = lineContents }
result <- manyTill parseSourceLine eof
return $ map normalizeHighlighting result
startingState = SyntaxState {synStContexts = fromList [("GNU Gettext",["Normal"])], synStLanguage = "GNU Gettext", synStCurrentLine = "", synStCharsParsedInLine = 0, synStPrevChar = '\n', synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}
parseSourceLine = manyTill parseExpressionInternal pEndLine
pEndLine = do
lookAhead $ newline <|> (eof >> return '\n')
context <- currentContext
case context of
"Normal" -> return () >> pHandleEndLine
"TranslatorComment" -> (popContext) >> pEndLine
"AutomaticComment" -> (popContext) >> pEndLine
"References" -> (popContext) >> pEndLine
"Flags" -> (popContext) >> pEndLine
"StringDiffNewComment" -> (popContext) >> pEndLine
"StringDiffOldComment" -> (popContext) >> pEndLine
"String" -> return () >> pHandleEndLine
"StringTag" -> return () >> pHandleEndLine
"StringWrap" -> return () >> pHandleEndLine
"StringDiffNew" -> return () >> pHandleEndLine
"StringDiffOld" -> return () >> pHandleEndLine
"StringWrapSub" -> return () >> pHandleEndLine
"Previous" -> (popContext) >> pEndLine
"StringPrevious" -> return () >> pHandleEndLine
"StringTagPrevious" -> return () >> pHandleEndLine
"StringDiffNewPrevious" -> return () >> pHandleEndLine
"StringDiffOldPrevious" -> return () >> pHandleEndLine
"StringWrapPrevious" -> return () >> pHandleEndLine
"StringWrapSubPrevious" -> return () >> pHandleEndLine
_ -> pHandleEndLine
withAttribute attr txt = do
when (null txt) $ fail "Parser matched no text"
let labs = attr : maybeToList (lookup attr styles)
st <- getState
let oldCharsParsed = synStCharsParsedInLine st
let prevchar = if null txt then '\n' else last txt
updateState $ \st -> st { synStCharsParsedInLine = oldCharsParsed + length txt, synStPrevChar = prevchar }
return (labs, txt)
styles = [("Keyword","kw"),("KeywordPrevious","kw"),("String","st"),("StringPrevious","st"),("Translator Comment","co"),("Automatic Comment","co"),("Reference","co"),("Flag","co"),("FlagFuzzy","co"),("Char","ch"),("CharPrevious","ch"),("Entity","st"),("EntityPrevious","st"),("StringTag","st"),("StringTagPrevious","st"),("Index","dv"),("IndexPrevious","dv"),("StringDiffNewWrap","st"),("StringDiffOldWrap","st"),("StringDiffNew","st"),("StringDiffOld","st"),("StringDiffNewWrapComment","st"),("StringDiffOldWrapComment","st"),("StringDiffNewComment","st"),("StringDiffOldComment","st"),("StringDiffNewWrapPrevious","st"),("StringDiffOldWrapPrevious","st"),("StringDiffNewPrevious","st"),("StringDiffOldPrevious","st")]
parseExpressionInternal = do
context <- currentContext
parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ lookup context defaultAttributes))
regex_'28msgid'5fplural'7cmsgid'7cmsgstr'7cmsgctxt'29 = compileRegex "(msgid_plural|msgid|msgstr|msgctxt)"
regex_'5c'5c'2e = compileRegex "\\\\."
regex_'5c'5b'5cd'2b'5c'5d = compileRegex "\\[\\d+\\]"
regex_'26'28'5ba'2dzA'2dZ0'2d9'5f'2e'2d'5d'2b'7c'23'5b0'2d9'5d'2b'29'3b = compileRegex "&([a-zA-Z0-9_.-]+|#[0-9]+);"
regex_'2e = compileRegex "."
regex_'28msgctxt'7cmsgid'5fplural'7cmsgid'7cmsgstr'29 = compileRegex "(msgctxt|msgid_plural|msgid|msgstr)"
regex_'5b'5e'23'5d = compileRegex "[^#]"
regex_'28'23'5c'7c'29'3f_'2a'22 = compileRegex "(#\\|)? *\""
defaultAttributes = [("Normal","Normal Text"),("TranslatorComment","Translator Comment"),("AutomaticComment","Automatic Comment"),("References","Reference"),("Flags","Flag"),("StringDiffNewComment","StringDiffNewComment"),("StringDiffOldComment","StringDiffOldComment"),("String","String"),("StringTag","StringTag"),("StringWrap",""),("StringDiffNew","StringDiffNew"),("StringDiffOld","StringDiffOld"),("StringWrapSub",""),("Previous","Normal Text"),("StringPrevious","StringPrevious"),("StringTagPrevious","StringTagPrevious"),("StringDiffNewPrevious","StringDiffNewPrevious"),("StringDiffOldPrevious","StringDiffOldPrevious"),("StringWrapPrevious",""),("StringWrapSubPrevious","")]
parseRules "Normal" =
do (attr, result) <- (((pColumn 0 >> pRegExpr regex_'28msgid'5fplural'7cmsgid'7cmsgstr'7cmsgctxt'29 >>= withAttribute "Keyword"))
<|>
((pFirstNonSpace >> pString False "#." >>= withAttribute "Automatic Comment") >>~ pushContext "AutomaticComment")
<|>
((pFirstNonSpace >> pString False "#:" >>= withAttribute "Reference") >>~ pushContext "References")
<|>
((pFirstNonSpace >> pString False "#," >>= withAttribute "Flag") >>~ pushContext "Flags")
<|>
((pFirstNonSpace >> pString False "#|" >>= withAttribute "StringPrevious") >>~ pushContext "Previous")
<|>
((pFirstNonSpace >> pString False "#" >>= withAttribute "Translator Comment") >>~ pushContext "TranslatorComment")
<|>
((pRegExpr regex_'5c'5c'2e >>= withAttribute "Char"))
<|>
((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "String")
<|>
((pRegExpr regex_'5c'5b'5cd'2b'5c'5d >>= withAttribute "Index")))
return (attr, result)
parseRules "TranslatorComment" =
do (attr, result) <- (((pString False "{+" >>= withAttribute "StringDiffNewWrapComment") >>~ pushContext "StringDiffNewComment")
<|>
((pString False "{-" >>= withAttribute "StringDiffOldWrapComment") >>~ pushContext "StringDiffOldComment"))
return (attr, result)
parseRules "AutomaticComment" =
do (attr, result) <- (((pString False "{+" >>= withAttribute "StringDiffNewWrapComment") >>~ pushContext "StringDiffNewComment")
<|>
((pString False "{-" >>= withAttribute "StringDiffOldWrapComment") >>~ pushContext "StringDiffOldComment"))
return (attr, result)
parseRules "References" =
do (attr, result) <- (((pString False "{+" >>= withAttribute "StringDiffNewWrapComment") >>~ pushContext "StringDiffNewComment")
<|>
((pString False "{-" >>= withAttribute "StringDiffOldWrapComment") >>~ pushContext "StringDiffOldComment"))
return (attr, result)
parseRules "Flags" =
do (attr, result) <- (((pString False "fuzzy" >>= withAttribute "FlagFuzzy"))
<|>
((pString False "{+" >>= withAttribute "StringDiffNewWrapComment") >>~ pushContext "StringDiffNewComment")
<|>
((pString False "{-" >>= withAttribute "StringDiffOldWrapComment") >>~ pushContext "StringDiffOldComment"))
return (attr, result)
parseRules "StringDiffNewComment" =
do (attr, result) <- ((pString False "+}" >>= withAttribute "StringDiffNewWrapComment") >>~ (popContext))
return (attr, result)
parseRules "StringDiffOldComment" =
do (attr, result) <- ((pString False "-}" >>= withAttribute "StringDiffOldWrapComment") >>~ (popContext))
return (attr, result)
parseRules "String" =
do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "Char"))
<|>
((pRegExpr regex_'26'28'5ba'2dzA'2dZ0'2d9'5f'2e'2d'5d'2b'7c'23'5b0'2d9'5d'2b'29'3b >>= withAttribute "Entity"))
<|>
((pString False "{+" >>= withAttribute "StringDiffNewWrap") >>~ pushContext "StringDiffNew")
<|>
((pString False "{-" >>= withAttribute "StringDiffOldWrap") >>~ pushContext "StringDiffOld")
<|>
((pDetectChar False '<' >>= withAttribute "StringTag") >>~ pushContext "StringTag")
<|>
((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "StringWrap"))
return (attr, result)
parseRules "StringTag" =
do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "Char"))
<|>
((pString False "{+" >>= withAttribute "StringDiffNewWrap") >>~ pushContext "StringDiffNew")
<|>
((pString False "{-" >>= withAttribute "StringDiffOldWrap") >>~ pushContext "StringDiffOld")
<|>
((pDetectChar False '>' >>= withAttribute "StringTag") >>~ (popContext))
<|>
((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "StringWrapSub"))
return (attr, result)
parseRules "StringWrap" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "String") >>~ (popContext))
<|>
((lookAhead (pRegExpr regex_'2e) >> return ([],"") ) >>~ (popContext >> popContext)))
return (attr, result)
parseRules "StringDiffNew" =
do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "Char"))
<|>
((pString False "+}" >>= withAttribute "StringDiffNewWrap") >>~ (popContext))
<|>
((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "StringWrapSub"))
return (attr, result)
parseRules "StringDiffOld" =
do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "Char"))
<|>
((pString False "-}" >>= withAttribute "StringDiffOldWrap") >>~ (popContext))
<|>
((pDetectChar False '"' >>= withAttribute "String") >>~ pushContext "StringWrapSub"))
return (attr, result)
parseRules "StringWrapSub" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "String") >>~ (popContext))
<|>
((lookAhead (pRegExpr regex_'2e) >> return ([],"") ) >>~ (popContext >> popContext >> popContext)))
return (attr, result)
parseRules "Previous" =
do (attr, result) <- (((pRegExpr regex_'28msgctxt'7cmsgid'5fplural'7cmsgid'7cmsgstr'29 >>= withAttribute "KeywordPrevious"))
<|>
((pRegExpr regex_'5c'5c'2e >>= withAttribute "CharPrevious"))
<|>
((pDetectChar False '"' >>= withAttribute "StringPrevious") >>~ pushContext "StringPrevious")
<|>
((pRegExpr regex_'5c'5b'5cd'2b'5c'5d >>= withAttribute "IndexPrevious")))
return (attr, result)
parseRules "StringPrevious" =
do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "CharPrevious"))
<|>
((pRegExpr regex_'26'28'5ba'2dzA'2dZ0'2d9'5f'2e'2d'5d'2b'7c'23'5b0'2d9'5d'2b'29'3b >>= withAttribute "EntityPrevious"))
<|>
((pString False "{+" >>= withAttribute "StringDiffNewWrapPrevious") >>~ pushContext "StringDiffNewPrevious")
<|>
((pString False "{-" >>= withAttribute "StringDiffOldWrapPrevious") >>~ pushContext "StringDiffOldPrevious")
<|>
((pDetectChar False '<' >>= withAttribute "StringTagPrevious") >>~ pushContext "StringTagPrevious")
<|>
((pDetectChar False '"' >>= withAttribute "StringPrevious") >>~ pushContext "StringWrapPrevious"))
return (attr, result)
parseRules "StringTagPrevious" =
do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "Char"))
<|>
((pString False "{+" >>= withAttribute "StringDiffNewWrapPrevious") >>~ pushContext "StringDiffNewPrevious")
<|>
((pString False "{-" >>= withAttribute "StringDiffOldWrapPrevious") >>~ pushContext "StringDiffOldPrevious")
<|>
((pDetectChar False '>' >>= withAttribute "StringTagPrevious") >>~ (popContext))
<|>
((pDetectChar False '"' >>= withAttribute "StringPrevious") >>~ pushContext "StringWrapSubPrevious"))
return (attr, result)
parseRules "StringDiffNewPrevious" =
do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "CharPrevious"))
<|>
((pString False "+}" >>= withAttribute "StringDiffNewWrapPrevious") >>~ (popContext))
<|>
((pDetectChar False '"' >>= withAttribute "StringPrevious") >>~ pushContext "StringWrapSubPrevious"))
return (attr, result)
parseRules "StringDiffOldPrevious" =
do (attr, result) <- (((pRegExpr regex_'5c'5c'2e >>= withAttribute "CharPrevious"))
<|>
((pString False "-}" >>= withAttribute "StringDiffOldWrapPrevious") >>~ (popContext))
<|>
((pDetectChar False '"' >>= withAttribute "StringPrevious") >>~ pushContext "StringWrapSubPrevious"))
return (attr, result)
parseRules "StringWrapPrevious" =
do (attr, result) <- (((pFirstNonSpace >> lookAhead (pRegExpr regex_'5b'5e'23'5d) >> return ([],"") ) >>~ (popContext >> popContext))
<|>
((pRegExpr regex_'28'23'5c'7c'29'3f_'2a'22 >>= withAttribute "StringPrevious") >>~ (popContext))
<|>
((lookAhead (pRegExpr regex_'2e) >> return ([],"") ) >>~ (popContext >> popContext)))
return (attr, result)
parseRules "StringWrapSubPrevious" =
do (attr, result) <- (((pFirstNonSpace >> lookAhead (pRegExpr regex_'5b'5e'23'5d) >> return ([],"") ) >>~ (popContext >> popContext >> popContext))
<|>
((pRegExpr regex_'28'23'5c'7c'29'3f_'2a'22 >>= withAttribute "StringPrevious") >>~ (popContext))
<|>
((lookAhead (pRegExpr regex_'2e) >> return ([],"") ) >>~ (popContext >> popContext >> popContext)))
return (attr, result)
parseRules x = fail $ "Unknown context" ++ x