module Text.Highlighting.Kate.Syntax.Json ( 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)
import qualified Data.Set as Set
syntaxName :: String
syntaxName = "JSON"
syntaxExtensions :: String
syntaxExtensions = "*.json"
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 = "JSON" }
context <- currentContext <|> (pushContext "Normal" >> 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 [("JSON",["Normal"])], synStLanguage = "JSON", synStCurrentLine = "", synStCharsParsedInLine = 0, synStPrevChar = '\n', synStCaseSensitive = True, synStKeywordCaseSensitive = True, synStCaptures = []}
parseSourceLine = manyTill parseExpressionInternal pEndLine
pEndLine = do
newline <|> (eof >> return '\n')
context <- currentContext
case context of
"Normal" -> return ()
"Pair" -> return ()
"String_Key" -> return ()
"Value" -> return ()
"String_Value" -> return ()
"Array" -> return ()
_ -> return ()
lineContents <- lookAhead wholeLine
updateState $ \st -> st { synStCurrentLine = lineContents, synStCharsParsedInLine = 0, synStPrevChar = '\n' }
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 = [("Style_Decimal","dv"),("Style_Float","fl"),("Style_String_Key","dt"),("Style_String_Value","st"),("Style_String_Key_Char","dt"),("Style_String_Value_Char","st"),("Style_Keyword","dv"),("Style_Error","er")]
parseExpressionInternal = do
context <- currentContext
parseRules context <|> (pDefault >>= withAttribute (fromMaybe "" $ lookup context defaultAttributes))
list_Constants = Set.fromList $ words $ "null true false"
regex_'5c'5c'28'3f'3a'5b'22'5c'5c'2fbfnrt'5d'7cu'5b0'2d9a'2dfA'2df'5d'7b4'7d'29 = compileRegex "\\\\(?:[\"\\\\/bfnrt]|u[0-9a-fA-f]{4})"
regex_'2d'3f'28'3f'3a'5b0'2d9'5d'7c'5b1'2d9'5d'5b0'2d9'5d'2b'29'5c'2e'5b0'2d9'5d'2b'28'3f'3a'5beE'5d'5b'2b'2d'5d'3f'5b0'2d9'5d'2b'29'3f = compileRegex "-?(?:[0-9]|[1-9][0-9]+)\\.[0-9]+(?:[eE][+-]?[0-9]+)?"
regex_'2d'3f'28'3f'3a'5b0'2d9'5d'7c'5b1'2d9'5d'5b0'2d9'5d'2b'29'28'3f'3a'5beE'5d'5b'2b'2d'5d'3f'5b0'2d9'5d'2b'29'3f = compileRegex "-?(?:[0-9]|[1-9][0-9]+)(?:[eE][+-]?[0-9]+)?"
defaultAttributes = [("Normal","Style_Error"),("Pair","Style_Error"),("String_Key","Style_String_Key"),("Value","Style_Error"),("String_Value","Style_String_Value"),("Array","Style_Error")]
parseRules "Normal" =
do (attr, result) <- ((pDetectChar False '{' >>= withAttribute "Style_Seperator_Pair") >>~ pushContext "Pair")
return (attr, result)
parseRules "Pair" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "Style_String_Key") >>~ pushContext "String_Key")
<|>
((pDetectChar False ':' >>= withAttribute "Style_Seperator_Pair") >>~ pushContext "Value")
<|>
((pDetectChar False '}' >>= withAttribute "Style_Seperator_Pair") >>~ (popContext >> return ()))
<|>
((pDetectChar False ',' >>= withAttribute "Style_Seperator_Pair"))
<|>
((pDetectSpaces >>= withAttribute "Style_Normal")))
return (attr, result)
parseRules "String_Key" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "Style_String_Key") >>~ (popContext >> return ()))
<|>
((pRegExpr regex_'5c'5c'28'3f'3a'5b'22'5c'5c'2fbfnrt'5d'7cu'5b0'2d9a'2dfA'2df'5d'7b4'7d'29 >>= withAttribute "Style_String_Key_Char")))
return (attr, result)
parseRules "Value" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "Style_String_Value") >>~ pushContext "String_Value")
<|>
((pDetectChar False '{' >>= withAttribute "Style_Seperator_Pair") >>~ pushContext "Pair")
<|>
((pDetectChar False '[' >>= withAttribute "Style_Seperator_Array") >>~ pushContext "Array")
<|>
((lookAhead (pDetectChar False '}') >> return ([],"") ) >>~ (popContext >> return ()))
<|>
((lookAhead (pDetectChar False ',') >> return ([],"") ) >>~ (popContext >> return ()))
<|>
((pDetectSpaces >>= withAttribute "Style_Normal"))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_Constants >>= withAttribute "Style_Keyword"))
<|>
((pRegExpr regex_'2d'3f'28'3f'3a'5b0'2d9'5d'7c'5b1'2d9'5d'5b0'2d9'5d'2b'29'5c'2e'5b0'2d9'5d'2b'28'3f'3a'5beE'5d'5b'2b'2d'5d'3f'5b0'2d9'5d'2b'29'3f >>= withAttribute "Style_Float"))
<|>
((pRegExpr regex_'2d'3f'28'3f'3a'5b0'2d9'5d'7c'5b1'2d9'5d'5b0'2d9'5d'2b'29'28'3f'3a'5beE'5d'5b'2b'2d'5d'3f'5b0'2d9'5d'2b'29'3f >>= withAttribute "Style_Decimal")))
return (attr, result)
parseRules "String_Value" =
do (attr, result) <- (((pDetectChar False '"' >>= withAttribute "Style_String_Value") >>~ (popContext >> return ()))
<|>
((pRegExpr regex_'5c'5c'28'3f'3a'5b'22'5c'5c'2fbfnrt'5d'7cu'5b0'2d9a'2dfA'2df'5d'7b4'7d'29 >>= withAttribute "Style_String_Value_Char")))
return (attr, result)
parseRules "Array" =
do (attr, result) <- (((pDetectChar False ',' >>= withAttribute "Style_Seperator_Array"))
<|>
((pDetectChar False ']' >>= withAttribute "Style_Seperator_Array") >>~ (popContext >> return ()))
<|>
((pDetectChar False '{' >>= withAttribute "Style_Seperator_Pair") >>~ pushContext "Pair")
<|>
((pDetectChar False '"' >>= withAttribute "Style_String_Value") >>~ pushContext "String_Value")
<|>
((pDetectSpaces >>= withAttribute "Style_Normal"))
<|>
((pKeyword " \n\t.():!+,-<=>%&*/;?[]^{|}~\\" list_Constants >>= withAttribute "Style_Keyword"))
<|>
((pRegExpr regex_'2d'3f'28'3f'3a'5b0'2d9'5d'7c'5b1'2d9'5d'5b0'2d9'5d'2b'29'5c'2e'5b0'2d9'5d'2b'28'3f'3a'5beE'5d'5b'2b'2d'5d'3f'5b0'2d9'5d'2b'29'3f >>= withAttribute "Style_Float"))
<|>
((pRegExpr regex_'2d'3f'28'3f'3a'5b0'2d9'5d'7c'5b1'2d9'5d'5b0'2d9'5d'2b'29'28'3f'3a'5beE'5d'5b'2b'2d'5d'3f'5b0'2d9'5d'2b'29'3f >>= withAttribute "Style_Decimal")))
return (attr, result)
parseRules x = fail $ "Unknown context" ++ x