module Language.JavaScript.Parser.ParserMonad
( P
, execParser
, execParserKeepComments
, runParser
, thenP
, returnP
, alexSetInput
, alexGetInput
, setLocation
, getLocation
, getInput
, setInput
, getLastToken
, setLastToken
, ParseError (..)
, ParseState (..)
, initialState
, addComment
, getComments
, spanError
, AlexInput
, Byte
) where
import Control.Applicative ((<$>))
import Control.Monad.Error as Error
import Control.Monad.State.Class
import Control.Monad.State.Strict as State
import Language.JavaScript.Parser.ParseError (ParseError (..))
import Language.JavaScript.Parser.SrcLocation (AlexPosn (..), alexStartPos, alexSpanEmpty, Span (..))
import Language.JavaScript.Parser.Token (Token (..))
import Prelude hiding (span)
import Data.Word (Word8)
internalError :: String -> P a
internalError = throwError . StrError
spanError :: Span a => a -> String -> P b
spanError x str = throwError $ StrError $ show ([show (getSpan x), str])
type Byte = Word8
type AlexInput = (AlexPosn,
Char,
[Byte],
String)
data ParseState = ParseState {
alex_pos :: !AlexPosn,
alex_inp :: String,
alex_chr :: !Char,
alex_bytes :: [Byte],
alex_scd :: !Int
, previousToken :: !Token
, comments :: [Token]
}
initialState :: String -> ParseState
initialState inp
= ParseState
{ alex_pos = alexStartPos
, alex_inp = inp
, alex_chr = '\n'
, alex_bytes = []
, alex_scd = 0
, previousToken = initToken
, comments = []
}
initToken :: Token
initToken = CommentToken alexSpanEmpty ""
type P a = StateT ParseState (Either ParseError) a
execParser :: P a -> ParseState -> Either ParseError a
execParser = evalStateT
execParserKeepComments :: P a -> ParseState -> Either ParseError (a, [Token])
execParserKeepComments parser state =
evalStateT (parser >>= \x -> getComments >>= \c -> return (x, c)) state
runParser :: P a -> ParseState -> Either ParseError (a, ParseState)
runParser = runStateT
returnP :: a -> P a
returnP = return
thenP :: P a -> (a -> P b) -> P b
thenP = (>>=)
alexGetInput :: P AlexInput
alexGetInput
= do
pos <- gets alex_pos
c <- gets alex_chr
bs <- gets alex_bytes
inp <- gets alex_inp
return (pos,c,bs,inp)
alexSetInput :: AlexInput -> P ()
alexSetInput (pos,c,bs,inp)
= modify $ \s -> s{alex_pos=pos,alex_chr=c,alex_bytes=bs,alex_inp=inp}
setLocation :: AlexPosn -> P ()
setLocation loc = modify $ \s -> s { alex_pos = loc }
getLocation :: P AlexPosn
getLocation = gets alex_pos
getInput :: P String
getInput = gets alex_inp
setInput :: String -> P ()
setInput inp = modify $ \s -> s { alex_inp = inp }
getLastToken :: P Token
getLastToken = gets previousToken
setLastToken :: Token -> P ()
setLastToken tok = modify $ \s -> s { previousToken = tok }
addComment :: Token -> P ()
addComment c = do
oldComments <- gets comments
modify $ \s -> s { comments = c : oldComments }
getComments :: P [Token]
getComments = reverse <$> gets comments