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

module Text.Highlighting.Kate.Syntax.Lex
          (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 = "Lex/Flex"

-- | Filename extensions for this language.
syntaxExtensions :: String
syntaxExtensions = "*.l;*.lex;*.flex"

-- | 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 = "Lex/Flex" }
  context <- currentContext <|> (pushContext "Pre Start" >> currentContext)
  result <- parseRules context
  optional $ eof >> pEndLine
  updateState $ \st -> st { synStLanguage = oldLang }
  return result

startingState = SyntaxState {synStContexts = fromList [("Lex/Flex",["Pre Start"])], synStLanguage = "Lex/Flex", 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 ()
    "Definitions" -> return ()
    "Rules" -> return ()
    "User Code" -> return ()
    "Percent Command" -> (popContext) >> pEndLine
    "Comment" -> return ()
    "Definition RegExpr" -> (popContext) >> pEndLine
    "Rule RegExpr" -> (popContext) >> pEndLine
    "RegExpr (" -> return ()
    "RegExpr [" -> return ()
    "RegExpr {" -> return ()
    "RegExpr Q" -> return ()
    "RegExpr Base" -> return ()
    "Start Conditions Scope" -> return ()
    "Action" -> (popContext) >> pEndLine
    "Detect C" -> return ()
    "Indented C" -> (popContext) >> pEndLine
    "Lex C Bloc" -> return ()
    "Lex Rule C Bloc" -> return ()
    "Normal C Bloc" -> return ()
    "Action C" -> (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_'2e = compileRegex "."
regex_'5bA'2dZa'2dz'5f'5d'5cw'2a'5cs'2b = compileRegex "[A-Za-z_]\\w*\\s+"
regex_'5cS = compileRegex "\\S"
regex_'2e'2a = compileRegex ".*"
regex_'5c'7b'24 = compileRegex "\\{$"
regex_'5cs'2b = compileRegex "\\s+"
regex_'5c'5c'2e = compileRegex "\\\\."
regex_'5cs'2a'5c'7d = compileRegex "\\s*\\}"
regex_'5cs'2a = compileRegex "\\s*"
regex_'5c'7c'5cs'2a'24 = compileRegex "\\|\\s*$"
regex_'5cs = compileRegex "\\s"

defaultAttributes = [("Pre Start",NormalTok),("Definitions",NormalTok),("Rules",NormalTok),("User Code",NormalTok),("Percent Command",KeywordTok),("Comment",CommentTok),("Definition RegExpr",StringTok),("Rule RegExpr",StringTok),("RegExpr (",StringTok),("RegExpr [",StringTok),("RegExpr {",StringTok),("RegExpr Q",StringTok),("RegExpr Base",StringTok),("Start Conditions Scope",NormalTok),("Action",NormalTok),("Detect C",NormalTok),("Indented C",NormalTok),("Lex C Bloc",NormalTok),("Lex Rule C Bloc",NormalTok),("Normal C Bloc",NormalTok),("Action C",NormalTok)]

parseRules "Pre Start" =
  ((lookAhead (pRegExpr regex_'2e) >> pushContext "Definitions" >> currentContext >>= parseRules))

parseRules "Definitions" =
  (((parseRules "Detect C"))
   <|>
   ((pDetect2Chars False '%' '%' >>= withAttribute BaseNTok) >>~ pushContext "Rules")
   <|>
   ((pDetectChar False '%' >>= withAttribute KeywordTok) >>~ pushContext "Percent Command")
   <|>
   ((pColumn 0 >> pDetect2Chars False '/' '*' >>= withAttribute CommentTok) >>~ pushContext "Comment")
   <|>
   ((pColumn 0 >> pRegExpr regex_'5bA'2dZa'2dz'5f'5d'5cw'2a'5cs'2b >>= withAttribute DataTypeTok) >>~ pushContext "Definition RegExpr"))

parseRules "Rules" =
  (((parseRules "Detect C"))
   <|>
   ((pDetect2Chars False '%' '%' >>= withAttribute BaseNTok) >>~ pushContext "User Code")
   <|>
   (pushContext "Rule RegExpr" >> currentContext >>= parseRules))

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

parseRules "Percent Command" =
  pzero

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

parseRules "Definition RegExpr" =
  (((parseRules "RegExpr Base"))
   <|>
   ((pRegExpr regex_'5cS >>= withAttribute StringTok))
   <|>
   ((pRegExpr regex_'2e'2a >>= withAttribute AlertTok)))

parseRules "Rule RegExpr" =
  (((pRegExpr regex_'5c'7b'24 >>= withAttribute BaseNTok) >>~ pushContext "Start Conditions Scope")
   <|>
   ((parseRules "RegExpr Base"))
   <|>
   ((pRegExpr regex_'5cS >>= withAttribute StringTok))
   <|>
   ((pRegExpr regex_'5cs'2b >>= withAttribute NormalTok) >>~ pushContext "Action"))

parseRules "RegExpr (" =
  (((parseRules "RegExpr Base"))
   <|>
   ((pDetectChar False ')' >>= withAttribute StringTok) >>~ (popContext))
   <|>
   ((pRegExpr regex_'2e >>= withAttribute StringTok)))

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

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

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

parseRules "RegExpr Base" =
  (((pRegExpr regex_'5c'5c'2e >>= withAttribute StringTok))
   <|>
   ((pDetectChar False '(' >>= withAttribute StringTok) >>~ pushContext "RegExpr (")
   <|>
   ((pDetectChar False '[' >>= withAttribute StringTok) >>~ pushContext "RegExpr [")
   <|>
   ((pDetectChar False '{' >>= withAttribute StringTok) >>~ pushContext "RegExpr {")
   <|>
   ((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext "RegExpr Q"))

parseRules "Start Conditions Scope" =
  (((pRegExpr regex_'5cs'2a'5c'7d >>= withAttribute BaseNTok) >>~ (popContext))
   <|>
   ((pRegExpr regex_'5cs'2a >>= withAttribute NormalTok) >>~ pushContext "Rule RegExpr")
   <|>
   (pushContext "Rule RegExpr" >> currentContext >>= parseRules))

parseRules "Action" =
  (((pRegExpr regex_'5c'7c'5cs'2a'24 >>= withAttribute KeywordTok))
   <|>
   ((pDetect2Chars False '%' '{' >>= withAttribute BaseNTok) >>~ pushContext "Lex Rule C Bloc")
   <|>
   (pushContext "Action C" >> currentContext >>= parseRules))

parseRules "Detect C" =
  (((pColumn 0 >> pRegExpr regex_'5cs >>= withAttribute NormalTok) >>~ pushContext "Indented C")
   <|>
   ((pColumn 0 >> pDetect2Chars False '%' '{' >>= withAttribute BaseNTok) >>~ pushContext "Lex C Bloc"))

parseRules "Indented C" =
  ((Text.Highlighting.Kate.Syntax.Cpp.parseExpression))

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

parseRules "Lex Rule C Bloc" =
  (((pDetect2Chars False '%' '}' >>= withAttribute BaseNTok) >>~ (popContext))
   <|>
   ((Text.Highlighting.Kate.Syntax.Cpp.parseExpression)))

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

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

parseRules "" = parseRules "Pre Start"

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