{- This module was generated from data in the Kate syntax
   highlighting file yacc.xml, version 1.03, by Jan Villat (jan.villat@net2000.ch) -}

module Text.Highlighting.Kate.Syntax.Yacc
          (highlight, parseExpression, syntaxName, syntaxExtensions)
where
import Text.Highlighting.Kate.Types
import Text.Highlighting.Kate.Common
import qualified Text.Highlighting.Kate.Syntax.Cpp
import Text.ParserCombinators.Parsec hiding (State)
import Data.Map (fromList)
import Control.Monad.State
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)

-- | Full name of language.
syntaxName :: String
syntaxName = "Yacc/Bison"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.y;*.yy"

-- | Highlight source code using this syntax definition.
highlight :: String -> [SourceLine]
highlight input = evalState (mapM parseSourceLine $ lines input) startingState

parseSourceLine :: String -> State SyntaxState SourceLine
parseSourceLine = mkParseSourceLine parseExpressionInternal pEndLine

-- | Parse an expression using appropriate local context.
parseExpression :: KateParser Token
parseExpression = do
  st <- getState
  let oldLang = synStLanguage st
  setState $ st { synStLanguage = "Yacc/Bison" }
  context <- currentContext <|> (pushContext "Pre Start" >> currentContext)
  result <- parseRules context
  optional $ eof >> pEndLine
  updateState $ \st -> st { synStLanguage = oldLang }
  return result

startingState = SyntaxState {synStContexts = fromList [("Yacc/Bison",["Pre Start"])], synStLanguage = "Yacc/Bison", synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}

pEndLine = do
  updateState $ \st -> st{ synStPrevNonspace = False }
  context <- currentContext
  case context of
    "Pre Start" -> return ()
    "C Declarations" -> return ()
    "Declarations" -> return ()
    "Union Start" -> return ()
    "Union In" -> return ()
    "Union InIn" -> return ()
    "Rules" -> return ()
    "Rule In" -> return ()
    "User Code" -> return ()
    "Percent Command" -> (popContext) >> pEndLine
    "Percent Command In" -> (popContext >> popContext) >> pEndLine
    "PC type" -> (popContext >> popContext >> popContext) >> pEndLine
    "Comment" -> return ()
    "CommentStar" -> return ()
    "CommentSlash" -> return ()
    "StringOrChar" -> return ()
    "String" -> (popContext) >> pEndLine
    "Char" -> (popContext) >> pEndLine
    "Normal C Bloc" -> return ()
    "Dol" -> return ()
    "DolEnd" -> return ()
    _ -> 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_'2e = compileRegex "."
regex_'5cW = compileRegex "\\W"
regex_'5b'5e'5c'5c'5d'24 = compileRegex "[^\\\\]$"
regex_'5c'5c'2e = compileRegex "\\\\."
regex_'3c'5b'5e'3e'5d'2b'3e = compileRegex "<[^>]+>"
regex_'5cd'2b = compileRegex "\\d+"

defaultAttributes = [("Pre Start",NormalTok),("C Declarations",NormalTok),("Declarations",NormalTok),("Union Start",NormalTok),("Union In",NormalTok),("Union InIn",NormalTok),("Rules",StringTok),("Rule In",NormalTok),("User Code",NormalTok),("Percent Command",KeywordTok),("Percent Command In",NormalTok),("PC type",DataTypeTok),("Comment",CommentTok),("CommentStar",CommentTok),("CommentSlash",CommentTok),("StringOrChar",NormalTok),("String",StringTok),("Char",CharTok),("Normal C Bloc",NormalTok),("Dol",NormalTok),("DolEnd",NormalTok)]

parseRules "Pre Start" =
  (((parseRules "Comment"))
   <|>
   ((pDetectSpaces >>= withAttribute NormalTok))
   <|>
   ((pColumn 0 >> pDetect2Chars False '%' '{' >>= withAttribute BaseNTok) >>~ pushContext "C Declarations")
   <|>
   ((lookAhead (pRegExpr regex_'2e) >> pushContext "Declarations" >> currentContext >>= parseRules)))

parseRules "C Declarations" =
  (((parseRules "Comment"))
   <|>
   ((pColumn 0 >> pDetect2Chars False '%' '}' >>= withAttribute BaseNTok) >>~ (popContext))
   <|>
   ((Text.Highlighting.Kate.Syntax.Cpp.parseExpression)))

parseRules "Declarations" =
  (((parseRules "Comment"))
   <|>
   ((pString False "%union" >>= withAttribute KeywordTok) >>~ pushContext "Union Start")
   <|>
   ((pDetect2Chars False '%' '%' >>= withAttribute BaseNTok) >>~ pushContext "Rules")
   <|>
   ((pColumn 0 >> pDetect2Chars False '%' '{' >>= withAttribute BaseNTok) >>~ pushContext "C Declarations")
   <|>
   ((pDetectChar False '%' >>= withAttribute KeywordTok) >>~ pushContext "Percent Command"))

parseRules "Union Start" =
  (((parseRules "Comment"))
   <|>
   ((pDetectSpaces >>= withAttribute NormalTok))
   <|>
   ((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "Union In")
   <|>
   ((pRegExpr regex_'2e >>= withAttribute AlertTok) >>~ (popContext)))

parseRules "Union In" =
  (((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "Union InIn")
   <|>
   ((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext >> popContext))
   <|>
   ((Text.Highlighting.Kate.Syntax.Cpp.parseExpression)))

parseRules "Union InIn" =
  (((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "Union InIn")
   <|>
   ((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((Text.Highlighting.Kate.Syntax.Cpp.parseExpression)))

parseRules "Rules" =
  (((parseRules "Comment"))
   <|>
   ((pDetect2Chars False '%' '%' >>= withAttribute BaseNTok) >>~ pushContext "User Code")
   <|>
   ((pDetectChar False ':' >>= withAttribute NormalTok) >>~ pushContext "Rule In"))

parseRules "Rule In" =
  (((parseRules "Comment"))
   <|>
   ((pDetectChar False ';' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "Normal C Bloc")
   <|>
   ((pDetectChar False '|' >>= withAttribute NormalTok))
   <|>
   ((parseRules "StringOrChar")))

parseRules "User Code" =
  ((Text.Highlighting.Kate.Syntax.Cpp.parseExpression))

parseRules "Percent Command" =
  (((parseRules "Comment"))
   <|>
   ((lookAhead (pRegExpr regex_'5cW) >> pushContext "Percent Command In" >> currentContext >>= parseRules)))

parseRules "Percent Command In" =
  (((parseRules "StringOrChar"))
   <|>
   ((pDetectChar False '<' >>= withAttribute DataTypeTok) >>~ pushContext "PC type"))

parseRules "PC type" =
  ((pDetectChar False '>' >>= withAttribute DataTypeTok) >>~ (popContext))

parseRules "Comment" =
  (((pDetect2Chars False '/' '*' >>= withAttribute CommentTok) >>~ pushContext "CommentStar")
   <|>
   ((pDetect2Chars False '/' '/' >>= withAttribute CommentTok) >>~ pushContext "CommentSlash"))

parseRules "CommentStar" =
  ((pDetect2Chars False '*' '/' >>= withAttribute CommentTok) >>~ (popContext))

parseRules "CommentSlash" =
  ((pRegExpr regex_'5b'5e'5c'5c'5d'24 >>= withAttribute CommentTok) >>~ (popContext))

parseRules "StringOrChar" =
  (((pDetectChar False '\'' >>= withAttribute CharTok) >>~ pushContext "Char")
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext "String"))

parseRules "String" =
  (((pRegExpr regex_'5c'5c'2e >>= withAttribute StringTok))
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext)))

parseRules "Char" =
  (((pRegExpr regex_'5c'5c'2e >>= withAttribute StringTok))
   <|>
   ((pDetectChar False '\'' >>= withAttribute CharTok) >>~ (popContext)))

parseRules "Normal C Bloc" =
  (((pDetectChar False '{' >>= withAttribute NormalTok) >>~ pushContext "Normal C Bloc")
   <|>
   ((pDetectChar False '}' >>= withAttribute NormalTok) >>~ (popContext))
   <|>
   ((Text.Highlighting.Kate.Syntax.Cpp.parseExpression))
   <|>
   ((pDetectChar False '$' >>= withAttribute KeywordTok) >>~ pushContext "Dol"))

parseRules "Dol" =
  (((pRegExpr regex_'3c'5b'5e'3e'5d'2b'3e >>= withAttribute DataTypeTok) >>~ pushContext "DolEnd")
   <|>
   (pushContext "DolEnd" >> currentContext >>= parseRules))

parseRules "DolEnd" =
  (((pRegExpr regex_'5cd'2b >>= withAttribute KeywordTok) >>~ (popContext >> popContext))
   <|>
   ((pDetectChar False '$' >>= withAttribute KeywordTok) >>~ (popContext >> popContext)))

parseRules "" = parseRules "Pre Start"

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