module Text.Highlighting.Kate.Syntax.Dtd
(highlight, parseExpression, syntaxName, syntaxExtensions)
where
import Text.Highlighting.Kate.Types
import Text.Highlighting.Kate.Common
import qualified Text.Highlighting.Kate.Syntax.Alert
import Text.ParserCombinators.Parsec hiding (State)
import Control.Monad.State
import Data.Char (isSpace)
import qualified Data.Set as Set
syntaxName :: String
syntaxName = "DTD"
syntaxExtensions :: String
syntaxExtensions = "*.dtd"
highlight :: String -> [SourceLine]
highlight input = evalState (mapM parseSourceLine $ lines input) startingState
parseSourceLine :: String -> State SyntaxState SourceLine
parseSourceLine = mkParseSourceLine parseExpression
parseExpression :: KateParser Token
parseExpression = do
(lang,cont) <- currentContext
result <- parseRules (lang,cont)
optional $ do eof
updateState $ \st -> st{ synStPrevChar = '\n' }
pEndLine
return result
startingState = SyntaxState {synStContexts = [("DTD","Normal")], synStLineNumber = 0, synStPrevChar = '\n', synStPrevNonspace = False, synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}
pEndLine = do
updateState $ \st -> st{ synStPrevNonspace = False }
context <- currentContext
contexts <- synStContexts `fmap` getState
if length contexts >= 2
then case context of
("DTD","Normal") -> return ()
("DTD","Comment") -> return ()
("DTD","PI") -> return ()
("DTD","Declaration") -> return ()
("DTD","String") -> return ()
("DTD","InlineComment") -> (popContext) >> pEndLine
_ -> return ()
else 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)
list_Category = Set.fromList $ words $ "EMPTY ANY CDATA ID IDREF IDREFS NMTOKEN NMTOKENS ENTITY ENTITIES NOTATION PUBLIC SYSTEM NDATA"
list_Keywords = Set.fromList $ words $ "#PCDATA #REQUIRED #IMPLIED #FIXED"
regex_'28'2d'7cO'29'5cs'28'2d'7cO'29 = compileRegex "(-|O)\\s(-|O)"
regex_'28'25'7c'26'29'28'23'5b0'2d9'5d'2b'7c'23'5bxX'5d'5b0'2d9A'2dFa'2df'5d'2b'7c'5b'5c'2d'5cw'5cd'5c'2e'3a'5f'5d'2b'29'3b = compileRegex "(%|&)(#[0-9]+|#[xX][0-9A-Fa-f]+|[\\-\\w\\d\\.:_]+);"
regex_'25'5cs = compileRegex "%\\s"
regex_'5cb'5b'5c'2d'5cw'5cd'5c'2e'3a'5f'5d'2b'5cb = compileRegex "\\b[\\-\\w\\d\\.:_]+\\b"
regex_'25'5b'5c'2d'5cw'5cd'5c'2e'3a'5f'5d'2b'3b = compileRegex "%[\\-\\w\\d\\.:_]+;"
parseRules ("DTD","Normal") =
(((pDetectSpaces >>= withAttribute NormalTok))
<|>
((pString False "<!--" >>= withAttribute CommentTok) >>~ pushContext ("DTD","Comment"))
<|>
((pString False "<?xml" >>= withAttribute KeywordTok) >>~ pushContext ("DTD","PI"))
<|>
((pString False "<!ELEMENT" >>= withAttribute DataTypeTok) >>~ pushContext ("DTD","Declaration"))
<|>
((pString False "<!ATTLIST" >>= withAttribute DataTypeTok) >>~ pushContext ("DTD","Declaration"))
<|>
((pString False "<!NOTATION" >>= withAttribute DataTypeTok) >>~ pushContext ("DTD","Declaration"))
<|>
((pString False "<!ENTITY" >>= withAttribute DataTypeTok) >>~ pushContext ("DTD","Declaration"))
<|>
((pDetectIdentifier >>= withAttribute NormalTok))
<|>
(currentContext >>= \x -> guard (x == ("DTD","Normal")) >> pDefault >>= withAttribute NormalTok))
parseRules ("DTD","Comment") =
(((pDetectSpaces >>= withAttribute CommentTok))
<|>
((pString False "-->" >>= withAttribute CommentTok) >>~ (popContext))
<|>
((Text.Highlighting.Kate.Syntax.Alert.parseExpression >>= ((withAttribute CommentTok) . snd)))
<|>
((pDetectIdentifier >>= withAttribute CommentTok))
<|>
(currentContext >>= \x -> guard (x == ("DTD","Comment")) >> pDefault >>= withAttribute CommentTok))
parseRules ("DTD","PI") =
(((pDetect2Chars False '?' '>' >>= withAttribute KeywordTok) >>~ (popContext))
<|>
(currentContext >>= \x -> guard (x == ("DTD","PI")) >> pDefault >>= withAttribute NormalTok))
parseRules ("DTD","Declaration") =
(((pString False "<!--" >>= withAttribute CommentTok) >>~ pushContext ("DTD","Comment"))
<|>
((pDetect2Chars False '-' '-' >>= withAttribute CommentTok) >>~ pushContext ("DTD","InlineComment"))
<|>
((pDetectChar False '>' >>= withAttribute DataTypeTok) >>~ (popContext))
<|>
((pDetectChar False '"' >>= withAttribute StringTok) >>~ pushContext ("DTD","String"))
<|>
((pRegExpr regex_'28'2d'7cO'29'5cs'28'2d'7cO'29 >>= withAttribute DataTypeTok))
<|>
((pAnyChar "(|)," >>= withAttribute DecValTok))
<|>
((pRegExpr regex_'28'25'7c'26'29'28'23'5b0'2d9'5d'2b'7c'23'5bxX'5d'5b0'2d9A'2dFa'2df'5d'2b'7c'5b'5c'2d'5cw'5cd'5c'2e'3a'5f'5d'2b'29'3b >>= withAttribute DecValTok))
<|>
((pAnyChar "?*+-&" >>= withAttribute FloatTok))
<|>
((pRegExpr regex_'25'5cs >>= withAttribute DecValTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_Category >>= withAttribute KeywordTok))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_Keywords >>= withAttribute KeywordTok))
<|>
((pRegExpr regex_'5cb'5b'5c'2d'5cw'5cd'5c'2e'3a'5f'5d'2b'5cb >>= withAttribute FunctionTok))
<|>
(currentContext >>= \x -> guard (x == ("DTD","Declaration")) >> pDefault >>= withAttribute NormalTok))
parseRules ("DTD","String") =
(((pDetectSpaces >>= withAttribute StringTok))
<|>
((pDetectChar False '"' >>= withAttribute StringTok) >>~ (popContext))
<|>
((pRegExpr regex_'25'5b'5c'2d'5cw'5cd'5c'2e'3a'5f'5d'2b'3b >>= withAttribute DecValTok))
<|>
(currentContext >>= \x -> guard (x == ("DTD","String")) >> pDefault >>= withAttribute StringTok))
parseRules ("DTD","InlineComment") =
(((pDetectSpaces >>= withAttribute CommentTok))
<|>
((pDetect2Chars False '-' '-' >>= withAttribute CommentTok) >>~ (popContext))
<|>
((Text.Highlighting.Kate.Syntax.Alert.parseExpression >>= ((withAttribute CommentTok) . snd)))
<|>
((pDetectIdentifier >>= withAttribute CommentTok))
<|>
(currentContext >>= \x -> guard (x == ("DTD","InlineComment")) >> pDefault >>= withAttribute CommentTok))
parseRules ("Alerts", _) = Text.Highlighting.Kate.Syntax.Alert.parseExpression
parseRules x = parseRules ("DTD","Normal") <|> fail ("Unknown context" ++ show x)