{- This module was generated from data in the Kate syntax highlighting file sed.xml, version 1.0,
   by  Bart Sas (bart.sas@gmail.com) -}

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)

-- | Full name of language.
syntaxName :: String
syntaxName = "sed"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.sed"

-- | Highlight source code using this syntax definition.
highlight :: String -> Either String [SourceLine]
highlight input =
  case runParser parseSource startingState "source" input of
    Left err     -> Left $ show err
    Right result -> Right result

-- | Parse an expression using appropriate local context.
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 "" = parseRules "BeginningOfLine"

parseRules x = fail $ "Unknown context" ++ x