Prim.hs

module Language.JavaScript.Prim where

import Control.Monad (guard, void)

import Text.Parsec ((<|>),
                    SourcePos,
                    eof, many)
import Text.Parsec.Prim (getState, lookAhead, modifyState)
import Text.Parsec.Token (GenLanguageDef(..))
import Text.ParserCombinators.Parsec.Prim (GenParser)
import qualified Text.ParserCombinators.Parsec.Prim as Parsec (token)

import Language.JavaScript.AST
import Language.JavaScript.Lexer hiding (token, lineTerminator, punctuator)

data JSPState
  = JSPState
    { jspStateNLFlag :: Bool }

getNLFlag :: JSParser Bool
getNLFlag = do { s <- getState; return $ jspStateNLFlag s }
setNLFlag :: JSParser ()
setNLFlag = modifyState $ \s -> s { jspStateNLFlag = True }
unsetNLFlag :: JSParser ()
unsetNLFlag = modifyState $ \s -> s { jspStateNLFlag = False }

newJSPState :: JSPState
newJSPState = JSPState {
  jspStateNLFlag = False }

type JSParser a = GenParser (SourcePos, InputElement) JSPState a

lexeme :: JSParser a -> JSParser a
lexeme p =
  do { x <- p; unsetNLFlag; void $ many lineTerminator; return x }

mytoken :: (InputElement -> Maybe a) -> JSParser a
mytoken test =
  Parsec.token showTok posFromTok testTok
  where
    showTok (pos, t)    = show t
    posFromTok (pos, t) = pos
    testTok (pos, t)    = test t

equal :: InputElement -> JSParser ()
equal test = mytoken (\tok -> if tok == test then Just () else Nothing)

lineTerminator :: JSParser ()
lineTerminator =
  do { equal InputElementLineTerminator; setNLFlag }

noLineTerminatorHere :: JSParser ()
noLineTerminatorHere =
  do { nl <- getNLFlag; guard (not nl) }

priorNL :: JSParser ()
priorNL =
  do { nl <- getNLFlag; guard nl }

autoSemi :: JSParser ()
autoSemi =
  punctuator ";" <|>
  priorNL <|>
  void (lookAhead $ punctuator "}") <|>
  eof

identName :: String -> JSParser ()
identName s = lexeme $ equal $ InputElementIdentName $ IdentName s

getIdentName :: JSParser IdentName
getIdentName = lexeme $ mytoken get
  where
    get (InputElementIdentName i) = Just i
    get _ = Nothing

getIdent :: JSParser Ident
getIdent = lexeme $ mytoken get
  where
    get (InputElementIdentName i@(IdentName n)) =
      if n `elem` reservedNames javaScript
      then Nothing
      else Just $ Ident i
    get _ = Nothing

punctuator :: String -> JSParser ()
punctuator p = lexeme $ equal $ InputElementPunctuator $ Punctuator p

getLiteral :: JSParser Literal
getLiteral = lexeme $ mytoken get
  where
    get (InputElementLiteral l) = Just l
    get (InputElementIdentName (IdentName "null")) = Just $ LiteralNull NullLit
    get (InputElementIdentName (IdentName "true")) = Just $ LiteralBool $ BoolLit True
    get (InputElementIdentName (IdentName "false")) = Just $ LiteralBool $ BoolLit False
    get _ = Nothing

getNumLit :: JSParser NumLit
getNumLit = lexeme $ mytoken get
  where
    get (InputElementLiteral (LiteralNum n)) = Just n
    get _ = Nothing

getStringLit :: JSParser StringLit
getStringLit = lexeme $ mytoken get
  where
    get (InputElementLiteral (LiteralString s)) = Just s
    get _ = Nothing