module HJS.Parser.Prim where
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import HJS.Parser.Lexer hiding (whiteSpace)
import Text.ParserCombinators.Parsec.Pos
data JSPState = JSPState {nlFlag::Bool}
newJSPState = JSPState { nlFlag = False }
clearNLFlag = updateState (\x -> x { nlFlag=False })
setNLFlag = updateState (\x -> x { nlFlag=True })
getNLFlag = do s <- getState; return $ nlFlag s
type JSParser a = GenParser (SourcePos,Token) JSPState a
lexeme p = do{ x <- p; clearNLFlag; whiteSpace; return x }
mytoken :: (Token -> Maybe a) -> JSParser a
mytoken test = token showTok posFromTok testTok
where
showTok (pos,t) = show t
posFromTok (pos,t) = pos
testTok (pos,t) = test t
anytok = mytoken (\tok -> Just tok )
nlPrior = do { s <- getNLFlag; tok <- mytoken (\tok -> if s then Just tok else Nothing ); putBack tok}
equal :: Token -> JSParser ()
equal test = mytoken (\tok -> if tok == test then Just () else Nothing)
rID :: String -> JSParser ()
rID name = lexeme $ mytoken (\tok -> case tok of
TokenRID a | a == name -> Just ()
_ -> Nothing)
regex = lexeme $ mytoken (\tok -> case tok of
TokenRegex s -> Just s
_ -> Nothing)
sLit = lexeme $ mytoken (\tok -> case tok of
TokenStringLit s -> Just s
_ -> Nothing)
iLit = lexeme $ mytoken (\tok -> case tok of
TokenInt i -> Just i
_ -> Nothing)
identifier :: JSParser String
identifier = lexeme $ mytoken (\tok -> case tok of
TokenIdent name -> Just name
other -> Nothing)
rOp :: String -> JSParser ()
rOp name = if elem name binaryOp then do { rop; whiteSpace; return () } else rop
where rop = lexeme $ mytoken (\tok -> case tok of
TokenROP a | a == name -> Just ()
_ -> Nothing)
otherOne "[" = Just "]"
otherOne "(" = Just ")"
otherOne "{" = Just "}"
otherOne _ = Nothing
nest :: JSParser String
nest = lexeme $ mytoken (\tok -> case tok of
TokenROP a -> (otherOne a)
_ -> Nothing)
whiteSpaceNotNL = try $ many $ do { equal TokenWhite }
whiteSpace = try $ many $ (do { equal TokenWhite } <|> do { (equal TokenNL); setNLFlag})
semi = try (do { rOp ";"; whiteSpace})
semiNL = try (rOp ";") <|> (equal TokenNL) <?> "semi or newline"
braces :: JSParser a -> JSParser a
braces p = do { r <- between (rOp "{") (rOp "}") p ; whiteSpace; return r }
commaSep p = p `sepBy` (do { rOp ","; whiteSpace })
putBack tok = do
st <- getInput;
pos <- getPosition;
setInput ((pos,tok):st)
autoSemi' = do { try semiNL
<|> do { rOp "}" ; putBack $ TokenROP "}" }
<|> eof; whiteSpace}
autoSemi = do { try (rOp ";")
<|> nlPrior
<|> do { rOp "}" ; putBack $ TokenROP "}" }
<|> eof}
t = do { autoSemi; rOp "}" }
nlBefore t ((_,TokenNL):ts) _ = nlBefore t ts True
nlBefore t ((_,TokenWhite):ts) flag = nlBefore t ts flag
nlBefore t (t':ts) flag = if t' == t then flag else nlBefore t ts False
nlBefore t [] flag = False
t2 = nlBefore ((newPos "" 2 1),TokenROP "+") (runLexer "1\n2+2") False