module Text.Highlighting.Kate.Syntax.Sed ( 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 = "sed"
syntaxExtensions :: String
syntaxExtensions = "*.sed"
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 = "sed" }
context <- currentContext <|> (pushContext "BeginningOfLine" >> 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 [("sed",["BeginningOfLine"])], synStLanguage = "sed", 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
"BeginningOfLine" -> return () >> pHandleEndLine
"FirstAddressRegex" -> pushContext "Error" >> pHandleEndLine
"AfterFirstAddress" -> pushContext "BeginningOfLine" >> pHandleEndLine
"AfterFirstAddress2" -> pushContext "BeginningOfLine" >> pHandleEndLine
"SecondAddress" -> pushContext "Error" >> pHandleEndLine
"SecondAddressRegex" -> pushContext "Error" >> pHandleEndLine
"AfterSecondAddress" -> pushContext "Error" >> pHandleEndLine
"Step" -> pushContext "Error" >> pHandleEndLine
"Command" -> pushContext "Error" >> pHandleEndLine
"SCommand" -> pushContext "Error" >> pHandleEndLine
"SRegex" -> pushContext "Error" >> pHandleEndLine
"SReplacement" -> pushContext "Error" >> pHandleEndLine
"SFlags" -> pushContext "BeginningOfLine" >> pHandleEndLine
"WFlag" -> pushContext "BeginningOfLine" >> pHandleEndLine
"YCommand" -> pushContext "Error" >> pHandleEndLine
"YSourceList" -> pushContext "Error" >> pHandleEndLine
"YDestList" -> pushContext "Error" >> pHandleEndLine
"AICCommand" -> pushContext "Error" >> pHandleEndLine
"LiteralText" -> pushContext "BeginningOfLine" >> pHandleEndLine
"BTCommand" -> pushContext "BeginningOfLine" >> pHandleEndLine
"WRCommand" -> pushContext "Error" >> pHandleEndLine
"LCommand" -> pushContext "BeginningOfLine" >> pHandleEndLine
"QCommand" -> pushContext "BeginningOfLine" >> pHandleEndLine
"Label" -> pushContext "Error" >> pHandleEndLine
"AfterCommand" -> pushContext "BeginningOfLine" >> pHandleEndLine
"Regex" -> pushContext "Error" >> pHandleEndLine
"Comment" -> pushContext "BeginningOfLine" >> pHandleEndLine
"Error" -> pushContext "BeginningOfLine" >> 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 = [("Regex","st"),("Regex Escape","ch"),("Replacement","st"),("Repl Escape","ch"),("Char List","st"),("Char List Escape","ch"),("Separator","st"),("Line Number","dv"),("Step","dv"),("Last Line","ot"),("Negation","ot"),("Command","kw"),("Label","fu"),("Flag","dt"),("Repl Number","dv"),("Exit Code","dv"),("Filename","bn"),("Wrap Length","dv"),("Line Continue","ot"),("Literal Text","ot"),("Literal Escape","ot"),("Comment","co"),("Error","er")]
parseExpressionInternal = do
context <- currentContext
parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ lookup context defaultAttributes))
regex_'28'2f'29 = compileRegex "(/)"
regex_'5c'5c'28'5cS'29 = compileRegex "\\\\(\\S)"
regex_'5cS = compileRegex "\\S"
regex_'28'5cS'29 = compileRegex "(\\S)"
regex_'5c'5c'5b0'2d9LlUuE'5c'5c'26'5d = compileRegex "\\\\[0-9LlUuE\\\\&]"
regex_'5cS'2b = compileRegex "\\S+"
regex_'5cw'2b = compileRegex "\\w+"
defaultAttributes = [("BeginningOfLine","Normal"),("FirstAddressRegex","Regex"),("AfterFirstAddress","Normal"),("AfterFirstAddress2","Normal"),("SecondAddress","Normal"),("SecondAddressRegex","Regex"),("AfterSecondAddress","Normal"),("Step","Normal"),("Command","Normal"),("SCommand","Normal"),("SRegex","Regex"),("SReplacement","Replacement"),("SFlags","Normal"),("WFlag","Normal"),("YCommand","Normal"),("YSourceList","Char List"),("YDestList","Char List"),("AICCommand","Normal"),("LiteralText","Literal Text"),("BTCommand","Normal"),("WRCommand","Normal"),("LCommand","Normal"),("QCommand","Normal"),("Label","Normal"),("AfterCommand","Normal"),("Regex","Regex"),("Comment","Comment"),("Error","Error")]
parseRules "BeginningOfLine" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pDetectChar False '#' >>= withAttribute "Comment") >>~ pushContext "Comment")
<|>
((pRegExpr regex_'28'2f'29 >>= withAttribute "Separator") >>~ pushContext "FirstAddressRegex")
<|>
((pRegExpr regex_'5c'5c'28'5cS'29 >>= withAttribute "Separator") >>~ pushContext "FirstAddressRegex")
<|>
((pInt >>= withAttribute "Line Number") >>~ pushContext "AfterFirstAddress")
<|>
((pDetectChar False '$' >>= withAttribute "Last Line") >>~ pushContext "AfterFirstAddress")
<|>
((pDetectChar False '}' >>= withAttribute "Brace") >>~ pushContext "AfterCommand")
<|>
((pDetectChar False ':' >>= withAttribute "Label") >>~ pushContext "Label")
<|>
((pDetectChar False '!' >>= withAttribute "Negation") >>~ pushContext "Command")
<|>
((parseRules "Command"))
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "FirstAddressRegex" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Regex"))
<|>
((pRegExprDynamic "\\\\%1" >>= withAttribute "Regex Escape"))
<|>
((pRegExprDynamic "%1" >>= withAttribute "Separator") >>~ pushContext "AfterFirstAddress")
<|>
((parseRules "Regex")))
return (attr, result)
parseRules "AfterFirstAddress" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pDetectChar False '!' >>= withAttribute "Negation") >>~ pushContext "Command")
<|>
((parseRules "AfterFirstAddress2"))
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "AfterFirstAddress2" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pDetectChar False ',' >>= withAttribute "Normal") >>~ pushContext "SecondAddress")
<|>
((pDetectChar False '~' >>= withAttribute "Normal") >>~ pushContext "Step")
<|>
((parseRules "Command"))
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "SecondAddress" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pRegExpr regex_'28'2f'29 >>= withAttribute "Separator") >>~ pushContext "SecondAddressRegex")
<|>
((pRegExpr regex_'5c'5c'28'5cS'29 >>= withAttribute "Separator") >>~ pushContext "SecondAddressRegex")
<|>
((pInt >>= withAttribute "Line Number") >>~ pushContext "AfterSecondAddress")
<|>
((pDetectChar False '$' >>= withAttribute "Last Line") >>~ pushContext "AfterSecondAddress")
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "SecondAddressRegex" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Regex"))
<|>
((pRegExprDynamic "\\\\%1" >>= withAttribute "Regex Escape"))
<|>
((pRegExprDynamic "%1" >>= withAttribute "Separator") >>~ pushContext "AfterSecondAddress")
<|>
((parseRules "Regex")))
return (attr, result)
parseRules "AfterSecondAddress" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pDetectChar False '!' >>= withAttribute "Negation") >>~ pushContext "Command")
<|>
((parseRules "Command"))
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "Step" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pInt >>= withAttribute "Step") >>~ pushContext "Command")
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "Command" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pDetectChar False 's' >>= withAttribute "Command") >>~ pushContext "SCommand")
<|>
((pDetectChar False 'y' >>= withAttribute "Command") >>~ pushContext "YCommand")
<|>
((pAnyChar "dpnDNPhHgGxFvz=" >>= withAttribute "Command") >>~ pushContext "AfterCommand")
<|>
((pAnyChar "aic" >>= withAttribute "Command") >>~ pushContext "AICCommand")
<|>
((pAnyChar "bTt" >>= withAttribute "Command") >>~ pushContext "BTCommand")
<|>
((pAnyChar "WwrR" >>= withAttribute "Command") >>~ pushContext "WRCommand")
<|>
((pAnyChar "lL" >>= withAttribute "Command") >>~ pushContext "LCommand")
<|>
((pAnyChar "qQ" >>= withAttribute "Command") >>~ pushContext "QCommand")
<|>
((pDetectChar False '{' >>= withAttribute "Brace") >>~ pushContext "BeginningOfLine")
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "SCommand" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pRegExpr regex_'28'5cS'29 >>= withAttribute "Separator") >>~ pushContext "SRegex"))
return (attr, result)
parseRules "SRegex" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Regex"))
<|>
((pRegExprDynamic "\\\\%1" >>= withAttribute "Regex Escape"))
<|>
((pRegExprDynamic "(%1)" >>= withAttribute "Separator") >>~ pushContext "SReplacement")
<|>
((parseRules "Regex")))
return (attr, result)
parseRules "SReplacement" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Replacement"))
<|>
((pRegExprDynamic "\\\\%1" >>= withAttribute "Repl Escape"))
<|>
((pRegExprDynamic "%1" >>= withAttribute "Separator") >>~ pushContext "SFlags")
<|>
((pRegExpr regex_'5c'5c'5b0'2d9LlUuE'5c'5c'26'5d >>= withAttribute "Repl Escape"))
<|>
((pDetectChar False '&' >>= withAttribute "Repl Escape")))
return (attr, result)
parseRules "SFlags" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pAnyChar "gpeIiMm" >>= withAttribute "Flag"))
<|>
((pDetectChar False 'w' >>= withAttribute "Flag") >>~ pushContext "WFlag")
<|>
((pInt >>= withAttribute "Repl Number"))
<|>
((parseRules "AfterCommand")))
return (attr, result)
parseRules "WFlag" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pRegExpr regex_'5cS'2b >>= withAttribute "Filename") >>~ pushContext "SFlags"))
return (attr, result)
parseRules "YCommand" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pRegExpr regex_'28'5cS'29 >>= withAttribute "Separator") >>~ pushContext "YSourceList"))
return (attr, result)
parseRules "YSourceList" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Char List"))
<|>
((pRegExprDynamic "\\\\%1" >>= withAttribute "Char List Escape"))
<|>
((pRegExprDynamic "(%1)" >>= withAttribute "Separator") >>~ pushContext "YDestList")
<|>
((pDetect2Chars False '\\' 'n' >>= withAttribute "Char List Escape"))
<|>
((pDetect2Chars False '\\' '\\' >>= withAttribute "Char List Escape")))
return (attr, result)
parseRules "YDestList" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Char List"))
<|>
((pRegExprDynamic "\\\\%1" >>= withAttribute "Char List Escape"))
<|>
((pRegExprDynamic "%1" >>= withAttribute "Separator") >>~ pushContext "AfterCommand")
<|>
((pDetect2Chars False '\\' 'n' >>= withAttribute "Char List Escape"))
<|>
((pDetect2Chars False '\\' '\\' >>= withAttribute "Char List Escape")))
return (attr, result)
parseRules "AICCommand" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pLineContinue >>= withAttribute "Line Continue") >>~ pushContext "LiteralText")
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "LiteralText" =
do (attr, result) <- (((pDetect2Chars False '\\' '\\' >>= withAttribute "Literal Escape") >>~ pushContext "LiteralText")
<|>
((pLineContinue >>= withAttribute "Line Continue") >>~ pushContext "LiteralText")
<|>
((pDetectChar False '\\' >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "BTCommand" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pRegExpr regex_'5cw'2b >>= withAttribute "Label") >>~ pushContext "AfterCommand")
<|>
((parseRules "AfterCommand")))
return (attr, result)
parseRules "WRCommand" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pRegExpr regex_'5cS'2b >>= withAttribute "Filename") >>~ pushContext "AfterCommand"))
return (attr, result)
parseRules "LCommand" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pInt >>= withAttribute "Wrap Length") >>~ pushContext "AfterCommand")
<|>
((parseRules "AfterCommand")))
return (attr, result)
parseRules "QCommand" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pInt >>= withAttribute "Exit Code") >>~ pushContext "AfterCommand")
<|>
((parseRules "AfterCommand")))
return (attr, result)
parseRules "Label" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pRegExpr regex_'5cw'2b >>= withAttribute "Label") >>~ pushContext "AfterCommand")
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "AfterCommand" =
do (attr, result) <- (((pDetectSpaces >>= withAttribute "Normal"))
<|>
((pDetectChar False ';' >>= withAttribute "Normal") >>~ pushContext "BeginningOfLine")
<|>
((pDetectChar False '}' >>= withAttribute "Brace") >>~ pushContext "AfterCommand")
<|>
((pDetectChar False '#' >>= withAttribute "Comment") >>~ pushContext "Comment")
<|>
((pRegExpr regex_'5cS >>= withAttribute "Error") >>~ pushContext "Error"))
return (attr, result)
parseRules "Regex" =
do (attr, result) <- (((pDetect2Chars False '\\' '(' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' ')' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '+' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '?' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '|' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '{' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '}' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '[' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' ']' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '.' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '*' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '\\' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '^' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '$' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' 'n' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' 't' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '0' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '1' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '2' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '3' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '4' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '5' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '6' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '7' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '8' >>= withAttribute "Regex Escape"))
<|>
((pDetect2Chars False '\\' '9' >>= withAttribute "Regex Escape"))
<|>
((pDetectChar False '*' >>= withAttribute "Regex Escape"))
<|>
((pDetectChar False '.' >>= withAttribute "Regex Escape"))
<|>
((pDetectChar False '^' >>= withAttribute "Regex Escape"))
<|>
((pDetectChar False '$' >>= withAttribute "Regex Escape"))
<|>
((pDetectChar False '[' >>= withAttribute "Regex Escape"))
<|>
((pDetectChar False ']' >>= withAttribute "Regex Escape")))
return (attr, result)
parseRules "Comment" =
pzero
parseRules "Error" =
pzero
parseRules x = fail $ "Unknown context" ++ x