{-# LANGUAGE FlexibleContexts #-}
module Language.ECMAScript3.Parser
(parse
, Parser
, expression
, statement
, program
, parseFromString
, parseFromFile
, parseScriptFromString
, parseJavaScriptFromFile
, parseScript
, parseExpression
, parseString
, ParsedStatement
, ParsedExpression
, parseSimpleExpr'
, parseBlockStmt
, parseStatement
, StatementParser
, ExpressionParser
, assignExpr
, parseObjectLit
) where
import Language.ECMAScript3.Lexer hiding (identifier)
import qualified Language.ECMAScript3.Lexer as Lexer
import Language.ECMAScript3.Parser.State
import Language.ECMAScript3.Parser.Type
import Language.ECMAScript3.Syntax hiding (pushLabel)
import Language.ECMAScript3.Syntax.Annotations
import Data.Default.Class
import Text.Parsec hiding (parse)
import Text.Parsec.Expr
import Control.Monad(liftM,liftM2)
import Control.Monad.Trans (MonadIO,liftIO)
import Numeric(readDec,readOct,readHex, readFloat)
import Data.Char
import Control.Monad.Identity
import Data.Maybe (isJust, isNothing, fromMaybe)
import Control.Monad.Error.Class
import Control.Applicative ((<$>), (<*>))
import Control.Exception (throwIO)
{-# DEPRECATED ParsedStatement, ParsedExpression, StatementParser,
ExpressionParser
"These type aliases will be hidden in the next version" #-}
{-# DEPRECATED parseSimpleExpr', parseBlockStmt, parseObjectLit
"These parsers will be hidden in the next version" #-}
{-# DEPRECATED assignExpr, parseExpression "Use 'expression' instead" #-}
{-# DEPRECATED parseStatement "Use 'statement' instead" #-}
{-# DEPRECATED parseScript "Use 'program' instead" #-}
{-# DEPRECATED parseScriptFromString, parseString "Use 'parseFromString' instead" #-}
{-# DEPRECATED parseJavaScriptFromFile "Use 'parseFromFile' instead" #-}
type ParsedStatement = Statement SourcePos
type ParsedExpression = Expression SourcePos
type StatementParser s = Parser s ParsedStatement
type ExpressionParser s = Parser s ParsedExpression
initialParserState :: ParserState
initialParserState :: ParserState
initialParserState = []
pushLabel :: String -> Parser s ()
pushLabel :: forall s. String -> Parser s ()
pushLabel String
lab = do ParserState
labs <- ParsecT s ParserState Identity ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
if String
lab String -> ParserState -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ParserState
labs
then String -> Parser s ()
forall a. String -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser s ()) -> String -> Parser s ()
forall a b. (a -> b) -> a -> b
$ String
"Duplicate label at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SourcePos -> String
forall a. Show a => a -> String
show SourcePos
pos
else ParserState -> Parser s ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (String
labString -> ParserState -> ParserState
forall a. a -> [a] -> [a]
:ParserState
labs)
popLabel :: Parser s ()
popLabel :: forall s. Parser s ()
popLabel = (ParserState -> ParserState) -> ParsecT s ParserState Identity ()
forall (m :: * -> *) u s. Monad m => (u -> u) -> ParsecT s u m ()
modifyState ParserState -> ParserState
forall {a}. [a] -> [a]
safeTail
where safeTail :: [a] -> [a]
safeTail [] = []
safeTail (a
_:[a]
xs) = [a]
xs
clearLabels :: ParserState -> ParserState
clearLabels :: ParserState -> ParserState
clearLabels ParserState
_ = []
withFreshLabelStack :: Parser s a -> Parser s a
withFreshLabelStack :: forall s a. Parser s a -> Parser s a
withFreshLabelStack Parser s a
p = do ParserState
oldState <- ParsecT s ParserState Identity ParserState
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
ParserState -> ParsecT s ParserState Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState (ParserState -> ParsecT s ParserState Identity ())
-> ParserState -> ParsecT s ParserState Identity ()
forall a b. (a -> b) -> a -> b
$ ParserState -> ParserState
clearLabels ParserState
oldState
a
a <- Parser s a
p
ParserState -> ParsecT s ParserState Identity ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
putState ParserState
oldState
a -> Parser s a
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
identifier :: Stream s Identity Char => Parser s (Id SourcePos)
identifier :: forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier =
(SourcePos -> String -> Id SourcePos)
-> ParsecT s ParserState Identity SourcePos
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity (Id SourcePos)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SourcePos -> String -> Id SourcePos
forall a. a -> String -> Id a
Id ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
Lexer.identifier
parseIfStmt:: Stream s Identity Char => StatementParser s
parseIfStmt :: forall s. Stream s Identity Char => StatementParser s
parseIfStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"if"
ParsedExpression
test <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseParenExpr ExpressionParser s -> String -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"parenthesized test-expression in if statement"
ParsedStatement
consequent <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement StatementParser s -> String -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"true-branch of if statement"
ParsecT s ParserState Identity String -> Parser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
((do String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"else"
ParsedStatement
alternate <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedStatement -> StatementParser s)
-> ParsedStatement -> StatementParser s
forall a b. (a -> b) -> a -> b
$ SourcePos
-> ParsedExpression
-> ParsedStatement
-> ParsedStatement
-> ParsedStatement
forall a.
a -> Expression a -> Statement a -> Statement a -> Statement a
IfStmt SourcePos
pos ParsedExpression
test ParsedStatement
consequent ParsedStatement
alternate)
StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedExpression -> ParsedStatement -> ParsedStatement
forall a. a -> Expression a -> Statement a -> Statement a
IfSingleStmt SourcePos
pos ParsedExpression
test ParsedStatement
consequent))
parseSwitchStmt :: Stream s Identity Char => StatementParser s
parseSwitchStmt :: forall s. Stream s Identity Char => StatementParser s
parseSwitchStmt =
let parseDefault :: ParsecT s ParserState Identity (CaseClause SourcePos)
parseDefault = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"default"
Parser s String
forall s. Stream s Identity Char => Parser s String
colon
[ParsedStatement]
statements <- StatementParser s
-> ParsecT s ParserState Identity [ParsedStatement]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
CaseClause SourcePos
-> ParsecT s ParserState Identity (CaseClause SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> [ParsedStatement] -> CaseClause SourcePos
forall a. a -> [Statement a] -> CaseClause a
CaseDefault SourcePos
pos [ParsedStatement]
statements)
parseCase :: ParsecT s ParserState Identity (CaseClause SourcePos)
parseCase = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"case"
ParsedExpression
condition <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseListExpr
Parser s String
forall s. Stream s Identity Char => Parser s String
colon
[ParsedStatement]
actions <- StatementParser s
-> ParsecT s ParserState Identity [ParsedStatement]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
CaseClause SourcePos
-> ParsecT s ParserState Identity (CaseClause SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
-> ParsedExpression -> [ParsedStatement] -> CaseClause SourcePos
forall a. a -> Expression a -> [Statement a] -> CaseClause a
CaseClause SourcePos
pos ParsedExpression
condition [ParsedStatement]
actions)
isCaseDefault :: CaseClause a -> Bool
isCaseDefault (CaseDefault a
_ [Statement a]
_) = Bool
True
isCaseDefault CaseClause a
_ = Bool
False
checkClauses :: [CaseClause a] -> m ()
checkClauses [CaseClause a]
cs = case (CaseClause a -> Bool) -> [CaseClause a] -> [CaseClause a]
forall a. (a -> Bool) -> [a] -> [a]
filter CaseClause a -> Bool
forall {a}. CaseClause a -> Bool
isCaseDefault [CaseClause a]
cs of
(CaseClause a
_:CaseClause a
c:[CaseClause a]
_) -> String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"duplicate default clause in switch statement at " String -> String -> String
forall a. [a] -> [a] -> [a]
++
a -> String
forall a. Show a => a -> String
show (CaseClause a -> a
forall b. CaseClause b -> b
forall (a :: * -> *) b. HasAnnotation a => a b -> b
getAnnotation CaseClause a
c)
[CaseClause a]
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
in do SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"switch"
ParsedExpression
test <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseParenExpr
[CaseClause SourcePos]
clauses <- Parser s [CaseClause SourcePos] -> Parser s [CaseClause SourcePos]
forall s a. Stream s Identity Char => Parser s a -> Parser s a
braces (Parser s [CaseClause SourcePos]
-> Parser s [CaseClause SourcePos])
-> Parser s [CaseClause SourcePos]
-> Parser s [CaseClause SourcePos]
forall a b. (a -> b) -> a -> b
$ ParsecT s ParserState Identity (CaseClause SourcePos)
-> Parser s [CaseClause SourcePos]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s ParserState Identity (CaseClause SourcePos)
-> Parser s [CaseClause SourcePos])
-> ParsecT s ParserState Identity (CaseClause SourcePos)
-> Parser s [CaseClause SourcePos]
forall a b. (a -> b) -> a -> b
$ ParsecT s ParserState Identity (CaseClause SourcePos)
parseDefault ParsecT s ParserState Identity (CaseClause SourcePos)
-> ParsecT s ParserState Identity (CaseClause SourcePos)
-> ParsecT s ParserState Identity (CaseClause SourcePos)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s ParserState Identity (CaseClause SourcePos)
parseCase
[CaseClause SourcePos] -> Parser s ()
forall {m :: * -> *} {a}.
(MonadFail m, Show a) =>
[CaseClause a] -> m ()
checkClauses [CaseClause SourcePos]
clauses
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
-> ParsedExpression -> [CaseClause SourcePos] -> ParsedStatement
forall a. a -> Expression a -> [CaseClause a] -> Statement a
SwitchStmt SourcePos
pos ParsedExpression
test [CaseClause SourcePos]
clauses)
parseWhileStmt:: Stream s Identity Char => StatementParser s
parseWhileStmt :: forall s. Stream s Identity Char => StatementParser s
parseWhileStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"while"
ParsedExpression
test <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseParenExpr ExpressionParser s -> String -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"parenthesized test-expression in while loop"
ParsedStatement
body <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedExpression -> ParsedStatement -> ParsedStatement
forall a. a -> Expression a -> Statement a -> Statement a
WhileStmt SourcePos
pos ParsedExpression
test ParsedStatement
body)
parseDoWhileStmt:: Stream s Identity Char => StatementParser s
parseDoWhileStmt :: forall s. Stream s Identity Char => StatementParser s
parseDoWhileStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"do"
ParsedStatement
body <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"while" Parser s () -> String -> Parser s ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"while at the end of a do block"
ParsedExpression
test <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseParenExpr ExpressionParser s -> String -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"parenthesized test-expression in do loop"
ParsecT s ParserState Identity String -> Parser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedStatement -> ParsedExpression -> ParsedStatement
forall a. a -> Statement a -> Expression a -> Statement a
DoWhileStmt SourcePos
pos ParsedStatement
body ParsedExpression
test)
parseContinueStmt:: Stream s Identity Char => StatementParser s
parseContinueStmt :: forall s. Stream s Identity Char => StatementParser s
parseContinueStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"continue"
SourcePos
pos' <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Maybe (Id SourcePos)
id <- if SourcePos -> Line
sourceLine SourcePos
pos Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos -> Line
sourceLine SourcePos
pos'
then (Id SourcePos -> Maybe (Id SourcePos))
-> ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Id SourcePos -> Maybe (Id SourcePos)
forall a. a -> Maybe a
Just ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier ParsecT s ParserState Identity (Maybe (Id SourcePos))
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe (Id SourcePos)
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Id SourcePos)
forall a. Maybe a
Nothing
else Maybe (Id SourcePos)
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Id SourcePos)
forall a. Maybe a
Nothing
ParsecT s ParserState Identity String -> Parser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedStatement -> StatementParser s)
-> ParsedStatement -> StatementParser s
forall a b. (a -> b) -> a -> b
$ SourcePos -> Maybe (Id SourcePos) -> ParsedStatement
forall a. a -> Maybe (Id a) -> Statement a
ContinueStmt SourcePos
pos Maybe (Id SourcePos)
id
parseBreakStmt:: Stream s Identity Char => StatementParser s
parseBreakStmt :: forall s. Stream s Identity Char => StatementParser s
parseBreakStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"break"
SourcePos
pos' <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Maybe (Id SourcePos)
id <- if SourcePos -> Line
sourceLine SourcePos
pos Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
== SourcePos -> Line
sourceLine SourcePos
pos'
then (Id SourcePos -> Maybe (Id SourcePos))
-> ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Id SourcePos -> Maybe (Id SourcePos)
forall a. a -> Maybe a
Just ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier ParsecT s ParserState Identity (Maybe (Id SourcePos))
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe (Id SourcePos)
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Id SourcePos)
forall a. Maybe a
Nothing
else Maybe (Id SourcePos)
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Id SourcePos)
forall a. Maybe a
Nothing
ParsecT s ParserState Identity String -> Parser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedStatement -> StatementParser s)
-> ParsedStatement -> StatementParser s
forall a b. (a -> b) -> a -> b
$ SourcePos -> Maybe (Id SourcePos) -> ParsedStatement
forall a. a -> Maybe (Id a) -> Statement a
BreakStmt SourcePos
pos Maybe (Id SourcePos)
id
parseBlockStmt:: Stream s Identity Char => StatementParser s
parseBlockStmt :: forall s. Stream s Identity Char => StatementParser s
parseBlockStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[ParsedStatement]
statements <- Parser s [ParsedStatement] -> Parser s [ParsedStatement]
forall s a. Stream s Identity Char => Parser s a -> Parser s a
braces (StatementParser s -> Parser s [ParsedStatement]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement)
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> [ParsedStatement] -> ParsedStatement
forall a. a -> [Statement a] -> Statement a
BlockStmt SourcePos
pos [ParsedStatement]
statements)
parseEmptyStmt:: Stream s Identity Char => StatementParser s
parseEmptyStmt :: forall s. Stream s Identity Char => StatementParser s
parseEmptyStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Parser s String
forall s. Stream s Identity Char => Parser s String
semi
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedStatement
forall a. a -> Statement a
EmptyStmt SourcePos
pos)
parseLabelledStmt:: Stream s Identity Char => StatementParser s
parseLabelledStmt :: forall s. Stream s Identity Char => StatementParser s
parseLabelledStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Id SourcePos
label <- ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity (Id SourcePos)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do Id SourcePos
label <- ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier
Parser s String
forall s. Stream s Identity Char => Parser s String
colon
Id SourcePos -> ParsecT s ParserState Identity (Id SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Id SourcePos
label)
String -> Parser s ()
forall s. String -> Parser s ()
pushLabel (String -> Parser s ()) -> String -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Id SourcePos -> String
forall a. Id a -> String
unId Id SourcePos
label
ParsedStatement
statement <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
Parser s ()
forall s. Parser s ()
popLabel
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> Id SourcePos -> ParsedStatement -> ParsedStatement
forall a. a -> Id a -> Statement a -> Statement a
LabelledStmt SourcePos
pos Id SourcePos
label ParsedStatement
statement)
parseExpressionStmt:: Stream s Identity Char => StatementParser s
parseExpressionStmt :: forall s. Stream s Identity Char => StatementParser s
parseExpressionStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
ParsedExpression
expr <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseExpression
ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedStatement -> StatementParser s)
-> ParsedStatement -> StatementParser s
forall a b. (a -> b) -> a -> b
$ SourcePos -> ParsedExpression -> ParsedStatement
forall a. a -> Expression a -> Statement a
ExprStmt SourcePos
pos ParsedExpression
expr
parseForInStmt:: Stream s Identity Char => StatementParser s
parseForInStmt :: forall s. Stream s Identity Char => StatementParser s
parseForInStmt =
let parseInit :: ParsecT s ParserState Identity (ForInInit SourcePos)
parseInit = (String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"var" Parser s ()
-> ParsecT s ParserState Identity (ForInInit SourcePos)
-> ParsecT s ParserState Identity (ForInInit SourcePos)
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Id SourcePos -> ForInInit SourcePos)
-> ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity (ForInInit SourcePos)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Id SourcePos -> ForInInit SourcePos
forall a. Id a -> ForInInit a
ForInVar ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier)
ParsecT s ParserState Identity (ForInInit SourcePos)
-> ParsecT s ParserState Identity (ForInInit SourcePos)
-> ParsecT s ParserState Identity (ForInInit SourcePos)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (LValue SourcePos -> ForInInit SourcePos)
-> ParsecT s ParserState Identity (LValue SourcePos)
-> ParsecT s ParserState Identity (ForInInit SourcePos)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM LValue SourcePos -> ForInInit SourcePos
forall a. LValue a -> ForInInit a
ForInLVal ParsecT s ParserState Identity (LValue SourcePos)
forall s. Stream s Identity Char => Parser s (LValue SourcePos)
lvalue
in do SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
(ForInInit SourcePos
init,ParsedExpression
expr) <- ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression))
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
forall a b. (a -> b) -> a -> b
$ do String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"for"
ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
forall s a. Stream s Identity Char => Parser s a -> Parser s a
parens (ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression))
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
forall a b. (a -> b) -> a -> b
$ do ForInInit SourcePos
init <- ParsecT s ParserState Identity (ForInInit SourcePos)
parseInit
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"in"
ParsedExpression
expr <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseExpression
(ForInInit SourcePos, ParsedExpression)
-> ParsecT
s ParserState Identity (ForInInit SourcePos, ParsedExpression)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForInInit SourcePos
init,ParsedExpression
expr)
ParsedStatement
body <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedStatement -> StatementParser s)
-> ParsedStatement -> StatementParser s
forall a b. (a -> b) -> a -> b
$ SourcePos
-> ForInInit SourcePos
-> ParsedExpression
-> ParsedStatement
-> ParsedStatement
forall a.
a -> ForInInit a -> Expression a -> Statement a -> Statement a
ForInStmt SourcePos
pos ForInInit SourcePos
init ParsedExpression
expr ParsedStatement
body
parseForStmt:: Stream s Identity Char => StatementParser s
parseForStmt :: forall s. Stream s Identity Char => StatementParser s
parseForStmt =
let parseInit :: ParsecT s ParserState Identity (ForInit SourcePos)
parseInit = (String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"var" Parser s ()
-> ParsecT s ParserState Identity (ForInit SourcePos)
-> ParsecT s ParserState Identity (ForInit SourcePos)
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([VarDecl SourcePos] -> ForInit SourcePos)
-> ParsecT s ParserState Identity [VarDecl SourcePos]
-> ParsecT s ParserState Identity (ForInit SourcePos)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [VarDecl SourcePos] -> ForInit SourcePos
forall a. [VarDecl a] -> ForInit a
VarInit (Parser s (VarDecl SourcePos)
forall s. Stream s Identity Char => Parser s (VarDecl SourcePos)
parseVarDecl Parser s (VarDecl SourcePos)
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity [VarDecl SourcePos]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
comma))
ParsecT s ParserState Identity (ForInit SourcePos)
-> ParsecT s ParserState Identity (ForInit SourcePos)
-> ParsecT s ParserState Identity (ForInit SourcePos)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsedExpression -> ForInit SourcePos)
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity (ForInit SourcePos)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ParsedExpression -> ForInit SourcePos
forall a. Expression a -> ForInit a
ExprInit ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseListExpr
ParsecT s ParserState Identity (ForInit SourcePos)
-> ParsecT s ParserState Identity (ForInit SourcePos)
-> ParsecT s ParserState Identity (ForInit SourcePos)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ForInit SourcePos
-> ParsecT s ParserState Identity (ForInit SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ForInit SourcePos
forall a. ForInit a
NoInit
in do SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"for"
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"("
ForInit SourcePos
init <- ParsecT s ParserState Identity (ForInit SourcePos)
parseInit
ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
Maybe ParsedExpression
test <- ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseExpression
ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
Maybe ParsedExpression
iter <- ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseExpression
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
")" Parser s () -> String -> Parser s ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"closing paren"
ParsedStatement
stmt <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedStatement -> StatementParser s)
-> ParsedStatement -> StatementParser s
forall a b. (a -> b) -> a -> b
$ SourcePos
-> ForInit SourcePos
-> Maybe ParsedExpression
-> Maybe ParsedExpression
-> ParsedStatement
-> ParsedStatement
forall a.
a
-> ForInit a
-> Maybe (Expression a)
-> Maybe (Expression a)
-> Statement a
-> Statement a
ForStmt SourcePos
pos ForInit SourcePos
init Maybe ParsedExpression
test Maybe ParsedExpression
iter ParsedStatement
stmt
parseTryStmt:: Stream s Identity Char => StatementParser s
parseTryStmt :: forall s. Stream s Identity Char => StatementParser s
parseTryStmt =
let parseCatchClause :: ParsecT s ParserState Identity (CatchClause SourcePos)
parseCatchClause = do SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"catch"
Id SourcePos
id <- Parser s (Id SourcePos) -> Parser s (Id SourcePos)
forall s a. Stream s Identity Char => Parser s a -> Parser s a
parens Parser s (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier
ParsedStatement
stmt <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
CatchClause SourcePos
-> ParsecT s ParserState Identity (CatchClause SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (CatchClause SourcePos
-> ParsecT s ParserState Identity (CatchClause SourcePos))
-> CatchClause SourcePos
-> ParsecT s ParserState Identity (CatchClause SourcePos)
forall a b. (a -> b) -> a -> b
$ SourcePos
-> Id SourcePos -> ParsedStatement -> CatchClause SourcePos
forall a. a -> Id a -> Statement a -> CatchClause a
CatchClause SourcePos
pos Id SourcePos
id ParsedStatement
stmt
in do String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"try"
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
ParsedStatement
guarded <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
Maybe (CatchClause SourcePos)
mCatch <- ParsecT s ParserState Identity (CatchClause SourcePos)
-> ParsecT s ParserState Identity (Maybe (CatchClause SourcePos))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s ParserState Identity (CatchClause SourcePos)
parseCatchClause
Maybe ParsedStatement
mFinally <- StatementParser s
-> ParsecT s ParserState Identity (Maybe ParsedStatement)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (StatementParser s
-> ParsecT s ParserState Identity (Maybe ParsedStatement))
-> StatementParser s
-> ParsecT s ParserState Identity (Maybe ParsedStatement)
forall a b. (a -> b) -> a -> b
$ String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"finally" Parser s () -> StatementParser s -> StatementParser s
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
if Maybe (CatchClause SourcePos) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (CatchClause SourcePos)
mCatch Bool -> Bool -> Bool
|| Maybe ParsedStatement -> Bool
forall a. Maybe a -> Bool
isJust Maybe ParsedStatement
mFinally
then ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedStatement -> StatementParser s)
-> ParsedStatement -> StatementParser s
forall a b. (a -> b) -> a -> b
$ SourcePos
-> ParsedStatement
-> Maybe (CatchClause SourcePos)
-> Maybe ParsedStatement
-> ParsedStatement
forall a.
a
-> Statement a
-> Maybe (CatchClause a)
-> Maybe (Statement a)
-> Statement a
TryStmt SourcePos
pos ParsedStatement
guarded Maybe (CatchClause SourcePos)
mCatch Maybe ParsedStatement
mFinally
else String -> StatementParser s
forall a. String -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> StatementParser s) -> String -> StatementParser s
forall a b. (a -> b) -> a -> b
$ String
"A try statement should have at least a catch\
\ or a finally block, at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SourcePos -> String
forall a. Show a => a -> String
show SourcePos
pos
parseThrowStmt:: Stream s Identity Char => StatementParser s
parseThrowStmt :: forall s. Stream s Identity Char => StatementParser s
parseThrowStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"throw"
ParsedExpression
expr <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseExpression
ParsecT s ParserState Identity String -> Parser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedExpression -> ParsedStatement
forall a. a -> Expression a -> Statement a
ThrowStmt SourcePos
pos ParsedExpression
expr)
parseReturnStmt:: Stream s Identity Char => StatementParser s
parseReturnStmt :: forall s. Stream s Identity Char => StatementParser s
parseReturnStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"return"
Maybe ParsedExpression
expr <- ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseListExpr
ParsecT s ParserState Identity String -> Parser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> Maybe ParsedExpression -> ParsedStatement
forall a. a -> Maybe (Expression a) -> Statement a
ReturnStmt SourcePos
pos Maybe ParsedExpression
expr)
parseWithStmt:: Stream s Identity Char => StatementParser s
parseWithStmt :: forall s. Stream s Identity Char => StatementParser s
parseWithStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"with"
ParsedExpression
context <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseParenExpr
ParsedStatement
stmt <- StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedExpression -> ParsedStatement -> ParsedStatement
forall a. a -> Expression a -> Statement a -> Statement a
WithStmt SourcePos
pos ParsedExpression
context ParsedStatement
stmt)
parseVarDecl :: Stream s Identity Char => Parser s (VarDecl SourcePos)
parseVarDecl :: forall s. Stream s Identity Char => Parser s (VarDecl SourcePos)
parseVarDecl = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Id SourcePos
id <- Parser s (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier
Maybe ParsedExpression
init <- (String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"=" Parser s ()
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsedExpression -> Maybe ParsedExpression)
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ParsedExpression -> Maybe ParsedExpression
forall a. a -> Maybe a
Just ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
assignExpr) ParsecT s ParserState Identity (Maybe ParsedExpression)
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Maybe ParsedExpression
-> ParsecT s ParserState Identity (Maybe ParsedExpression)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ParsedExpression
forall a. Maybe a
Nothing
VarDecl SourcePos -> Parser s (VarDecl SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
-> Id SourcePos -> Maybe ParsedExpression -> VarDecl SourcePos
forall a. a -> Id a -> Maybe (Expression a) -> VarDecl a
VarDecl SourcePos
pos Id SourcePos
id Maybe ParsedExpression
init)
parseVarDeclStmt:: Stream s Identity Char => StatementParser s
parseVarDeclStmt :: forall s. Stream s Identity Char => StatementParser s
parseVarDeclStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"var"
[VarDecl SourcePos]
decls <- Parser s (VarDecl SourcePos)
forall s. Stream s Identity Char => Parser s (VarDecl SourcePos)
parseVarDecl Parser s (VarDecl SourcePos)
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity [VarDecl SourcePos]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
comma
ParsecT s ParserState Identity String -> Parser s ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
semi
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> [VarDecl SourcePos] -> ParsedStatement
forall a. a -> [VarDecl a] -> Statement a
VarDeclStmt SourcePos
pos [VarDecl SourcePos]
decls)
parseFunctionStmt:: Stream s Identity Char => StatementParser s
parseFunctionStmt :: forall s. Stream s Identity Char => StatementParser s
parseFunctionStmt = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Id SourcePos
name <- ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity (Id SourcePos)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"function" Parser s ()
-> ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity (Id SourcePos)
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier)
[Id SourcePos]
args <- Parser s [Id SourcePos] -> Parser s [Id SourcePos]
forall s a. Stream s Identity Char => Parser s a -> Parser s a
parens (ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity String -> Parser s [Id SourcePos]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
comma)
BlockStmt SourcePos
_ [ParsedStatement]
body <- StatementParser s -> StatementParser s
forall s a. Parser s a -> Parser s a
withFreshLabelStack StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseBlockStmt StatementParser s -> String -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>
String
"function body in { ... }"
ParsedStatement -> StatementParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
-> Id SourcePos
-> [Id SourcePos]
-> [ParsedStatement]
-> ParsedStatement
forall a. a -> Id a -> [Id a] -> [Statement a] -> Statement a
FunctionStmt SourcePos
pos Id SourcePos
name [Id SourcePos]
args [ParsedStatement]
body)
parseStatement :: Stream s Identity Char => StatementParser s
parseStatement :: forall s. Stream s Identity Char => StatementParser s
parseStatement = StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseIfStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseSwitchStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseWhileStmt
StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseDoWhileStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseContinueStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseBreakStmt
StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseBlockStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseEmptyStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseForInStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseForStmt
StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseTryStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseThrowStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseReturnStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseWithStmt
StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseVarDeclStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseFunctionStmt
StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseLabelledStmt StatementParser s -> StatementParser s -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseExpressionStmt StatementParser s -> String -> StatementParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"statement"
statement :: Stream s Identity Char => Parser s (Statement SourcePos)
statement :: forall s. Stream s Identity Char => StatementParser s
statement = StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement
parseThisRef:: Stream s Identity Char => ExpressionParser s
parseThisRef :: forall s. Stream s Identity Char => ExpressionParser s
parseThisRef = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"this"
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedExpression
forall a. a -> Expression a
ThisRef SourcePos
pos)
parseNullLit:: Stream s Identity Char => ExpressionParser s
parseNullLit :: forall s. Stream s Identity Char => ExpressionParser s
parseNullLit = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"null"
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedExpression
forall a. a -> Expression a
NullLit SourcePos
pos)
parseBoolLit:: Stream s Identity Char => ExpressionParser s
parseBoolLit :: forall s. Stream s Identity Char => ExpressionParser s
parseBoolLit = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
let parseTrueLit :: ExpressionParser s
parseTrueLit = String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"true" Parser s () -> ExpressionParser s -> ExpressionParser s
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> Bool -> ParsedExpression
forall a. a -> Bool -> Expression a
BoolLit SourcePos
pos Bool
True)
parseFalseLit :: ExpressionParser s
parseFalseLit = String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"false" Parser s () -> ExpressionParser s -> ExpressionParser s
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> Bool -> ParsedExpression
forall a. a -> Bool -> Expression a
BoolLit SourcePos
pos Bool
False)
ExpressionParser s
parseTrueLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
parseFalseLit
parseVarRef:: Stream s Identity Char => ExpressionParser s
parseVarRef :: forall s. Stream s Identity Char => ExpressionParser s
parseVarRef = (SourcePos -> Id SourcePos -> ParsedExpression)
-> ParsecT s ParserState Identity SourcePos
-> ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity ParsedExpression
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SourcePos -> Id SourcePos -> ParsedExpression
forall a. a -> Id a -> Expression a
VarRef ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier
parseArrayLit:: Stream s Identity Char => ExpressionParser s
parseArrayLit :: forall s. Stream s Identity Char => ExpressionParser s
parseArrayLit = (SourcePos -> [ParsedExpression] -> ParsedExpression)
-> ParsecT s ParserState Identity SourcePos
-> ParsecT s ParserState Identity [ParsedExpression]
-> ParsecT s ParserState Identity ParsedExpression
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SourcePos -> [ParsedExpression] -> ParsedExpression
forall a. a -> [Expression a] -> Expression a
ArrayLit ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition (ParsecT s ParserState Identity [ParsedExpression]
-> ParsecT s ParserState Identity [ParsedExpression]
forall s a. Stream s Identity Char => Parser s a -> Parser s a
squares (ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
assignExpr ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity [ParsedExpression]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy` ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
comma))
parseFuncExpr :: Stream s Identity Char => ExpressionParser s
parseFuncExpr :: forall s. Stream s Identity Char => ExpressionParser s
parseFuncExpr = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"function"
Maybe (Id SourcePos)
name <- ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity (Maybe (Id SourcePos))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier
[Id SourcePos]
args <- Parser s [Id SourcePos] -> Parser s [Id SourcePos]
forall s a. Stream s Identity Char => Parser s a -> Parser s a
parens (ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity String -> Parser s [Id SourcePos]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
comma)
BlockStmt SourcePos
_ [ParsedStatement]
body <- Parser s ParsedStatement -> Parser s ParsedStatement
forall s a. Parser s a -> Parser s a
withFreshLabelStack Parser s ParsedStatement
forall s. Stream s Identity Char => StatementParser s
parseBlockStmt
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedExpression -> ExpressionParser s)
-> ParsedExpression -> ExpressionParser s
forall a b. (a -> b) -> a -> b
$ SourcePos
-> Maybe (Id SourcePos)
-> [Id SourcePos]
-> [ParsedStatement]
-> ParsedExpression
forall a.
a -> Maybe (Id a) -> [Id a] -> [Statement a] -> Expression a
FuncExpr SourcePos
pos Maybe (Id SourcePos)
name [Id SourcePos]
args [ParsedStatement]
body
escapeChars :: [(Char, Char)]
escapeChars =
[(Char
'\'',Char
'\''),(Char
'\"',Char
'\"'),(Char
'\\',Char
'\\'),(Char
'b',Char
'\b'),(Char
'f',Char
'\f'),(Char
'n',Char
'\n'),
(Char
'r',Char
'\r'),(Char
't',Char
'\t'),(Char
'v',Char
'\v'),(Char
'/',Char
'/'),(Char
' ',Char
' '),(Char
'0',Char
'\0')]
allEscapes:: String
allEscapes :: String
allEscapes = ((Char, Char) -> Char) -> [(Char, Char)] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char, Char) -> Char
forall a b. (a, b) -> a
fst [(Char, Char)]
escapeChars
parseEscapeChar :: Stream s Identity Char => Parser s Char
parseEscapeChar :: forall s. Stream s Identity Char => Parser s Char
parseEscapeChar = do
Char
c <- String -> Parser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
allEscapes
let (Just Char
c') = Char -> [(Char, Char)] -> Maybe Char
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Char
c [(Char, Char)]
escapeChars
Char -> Parser s Char
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c'
parseAsciiHexChar :: Stream s Identity Char => Parser s Char
parseAsciiHexChar :: forall s. Stream s Identity Char => Parser s Char
parseAsciiHexChar = do
Char -> Parser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'x'
Char
d1 <- Parser s Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
Char
d2 <- Parser s Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
Char -> Parser s Char
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Line -> Char
chr(Line -> Char) -> (String -> Line) -> String -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Line, String) -> Line
forall a b. (a, b) -> a
fst((Line, String) -> Line)
-> (String -> (Line, String)) -> String -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[(Line, String)] -> (Line, String)
forall a. HasCallStack => [a] -> a
head([(Line, String)] -> (Line, String))
-> (String -> [(Line, String)]) -> String -> (Line, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [(Line, String)]
forall a. (Eq a, Num a) => ReadS a
readHex) (Char
d1Char -> String -> String
forall a. a -> [a] -> [a]
:Char
d2Char -> String -> String
forall a. a -> [a] -> [a]
:String
""))
parseUnicodeHexChar :: Stream s Identity Char => Parser s Char
parseUnicodeHexChar :: forall s. Stream s Identity Char => Parser s Char
parseUnicodeHexChar = do
Char -> Parser s Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'u'
(String -> Char)
-> ParsecT s ParserState Identity String -> Parser s Char
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Line -> Char
chr(Line -> Char) -> (String -> Line) -> String -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Line, String) -> Line
forall a b. (a, b) -> a
fst((Line, String) -> Line)
-> (String -> (Line, String)) -> String -> Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[(Line, String)] -> (Line, String)
forall a. HasCallStack => [a] -> a
head([(Line, String)] -> (Line, String))
-> (String -> [(Line, String)]) -> String -> (Line, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> [(Line, String)]
forall a. (Eq a, Num a) => ReadS a
readHex)
([Parser s Char] -> ParsecT s ParserState Identity String
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Parser s Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit,Parser s Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit,Parser s Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit,Parser s Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit])
isWhitespace :: Char -> Bool
isWhitespace Char
ch = Char
ch Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
" \t"
parseStringLit' :: Char -> ParsecT s ParserState Identity String
parseStringLit' Char
endWith =
(Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
endWith ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT s ParserState Identity String
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"") ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(do ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s ParserState Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\'")
String
cs <- Char -> ParsecT s ParserState Identity String
parseStringLit' Char
endWith
String -> ParsecT s ParserState Identity String
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ParsecT s ParserState Identity String)
-> String -> ParsecT s ParserState Identity String
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs) ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(do Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
Char
c <- ParsecT s ParserState Identity Char
forall s. Stream s Identity Char => Parser s Char
parseEscapeChar ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s ParserState Identity Char
forall s. Stream s Identity Char => Parser s Char
parseAsciiHexChar ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s ParserState Identity Char
forall s. Stream s Identity Char => Parser s Char
parseUnicodeHexChar ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\r' ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\n'
String
cs <- Char -> ParsecT s ParserState Identity String
parseStringLit' Char
endWith
if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
then String -> ParsecT s ParserState Identity String
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isWhitespace String
cs)
else String -> ParsecT s ParserState Identity String
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs)) ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(Char -> String -> String)
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity String
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ParsecT s ParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParsecT s ParserState Identity String
parseStringLit' Char
endWith)
parseStringLit:: Stream s Identity Char => ExpressionParser s
parseStringLit :: forall s. Stream s Identity Char => ExpressionParser s
parseStringLit = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String
str <- Parser s String -> Parser s String
forall s a. Stream s Identity Char => Parser s a -> Parser s a
lexeme (Parser s String -> Parser s String)
-> Parser s String -> Parser s String
forall a b. (a -> b) -> a -> b
$ (Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT s ParserState Identity Char
-> (Char -> Parser s String) -> Parser s String
forall a b.
ParsecT s ParserState Identity a
-> (a -> ParsecT s ParserState Identity b)
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser s String
forall {s}.
Stream s Identity Char =>
Char -> ParsecT s ParserState Identity String
parseStringLit') Parser s String -> Parser s String -> Parser s String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"' ParsecT s ParserState Identity Char
-> (Char -> Parser s String) -> Parser s String
forall a b.
ParsecT s ParserState Identity a
-> (a -> ParsecT s ParserState Identity b)
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Parser s String
forall {s}.
Stream s Identity Char =>
Char -> ParsecT s ParserState Identity String
parseStringLit')
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedExpression -> ExpressionParser s)
-> ParsedExpression -> ExpressionParser s
forall a b. (a -> b) -> a -> b
$ SourcePos -> String -> ParsedExpression
forall a. a -> String -> Expression a
StringLit SourcePos
pos String
str
parseRegexpLit:: Stream s Identity Char => ExpressionParser s
parseRegexpLit :: forall s. Stream s Identity Char => ExpressionParser s
parseRegexpLit = do
let parseFlags :: ParsecT s u Identity ((Bool -> Bool -> t) -> t)
parseFlags = do
String
flags <- ParsecT s u Identity Char -> ParsecT s u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT s u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"mgi")
((Bool -> Bool -> t) -> t)
-> ParsecT s u Identity ((Bool -> Bool -> t) -> t)
forall a. a -> ParsecT s u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (((Bool -> Bool -> t) -> t)
-> ParsecT s u Identity ((Bool -> Bool -> t) -> t))
-> ((Bool -> Bool -> t) -> t)
-> ParsecT s u Identity ((Bool -> Bool -> t) -> t)
forall a b. (a -> b) -> a -> b
$ \Bool -> Bool -> t
f -> Bool -> Bool -> t
f (Char
'g' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
flags) (Char
'i' Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
flags)
let parseEscape :: Stream s Identity Char => Parser s Char
parseEscape :: forall s. Stream s Identity Char => Parser s Char
parseEscape = Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity Char
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
let parseChar :: Stream s Identity Char => Parser s Char
parseChar :: forall s. Stream s Identity Char => Parser s Char
parseChar = String -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"/"
let parseRe :: ParsecT s u Identity String
parseRe = (Char -> ParsecT s u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/' ParsecT s u Identity Char
-> ParsecT s u Identity String -> ParsecT s u Identity String
forall a b.
ParsecT s u Identity a
-> ParsecT s u Identity b -> ParsecT s u Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ParsecT s u Identity String
forall a. a -> ParsecT s u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"") ParsecT s u Identity String
-> ParsecT s u Identity String -> ParsecT s u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(do Char -> ParsecT s u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
Char
ch <- ParsecT s u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
String
rest <- ParsecT s u Identity String
parseRe
String -> ParsecT s u Identity String
forall a. a -> ParsecT s u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
chChar -> String -> String
forall a. a -> [a] -> [a]
:String
rest)) ParsecT s u Identity String
-> ParsecT s u Identity String -> ParsecT s u Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(Char -> String -> String)
-> ParsecT s u Identity Char
-> ParsecT s u Identity String
-> ParsecT s u Identity String
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ParsecT s u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT s u Identity String
parseRe
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity ())
-> ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'/'
String
pat <- ParsecT s ParserState Identity String
forall {u}. ParsecT s u Identity String
parseRe
(Bool -> Bool -> ParsedExpression) -> ParsedExpression
flags <- ParsecT
s
ParserState
Identity
((Bool -> Bool -> ParsedExpression) -> ParsedExpression)
forall {u} {t}. ParsecT s u Identity ((Bool -> Bool -> t) -> t)
parseFlags
ParsecT s ParserState Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedExpression -> ExpressionParser s)
-> ParsedExpression -> ExpressionParser s
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool -> ParsedExpression) -> ParsedExpression
flags (SourcePos -> String -> Bool -> Bool -> ParsedExpression
forall a. a -> String -> Bool -> Bool -> Expression a
RegexpLit SourcePos
pos String
pat)
parseObjectLit:: Stream s Identity Char => ExpressionParser s
parseObjectLit :: forall s. Stream s Identity Char => ExpressionParser s
parseObjectLit =
let parseProp :: ParsecT s ParserState Identity (Prop SourcePos, ParsedExpression)
parseProp = do
Prop SourcePos
name <- (ParsedExpression -> Prop SourcePos)
-> ExpressionParser s
-> ParsecT s ParserState Identity (Prop SourcePos)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\(StringLit SourcePos
p String
s) -> SourcePos -> String -> Prop SourcePos
forall a. a -> String -> Prop a
PropString SourcePos
p String
s) ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseStringLit
ParsecT s ParserState Identity (Prop SourcePos)
-> ParsecT s ParserState Identity (Prop SourcePos)
-> ParsecT s ParserState Identity (Prop SourcePos)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (SourcePos -> Id SourcePos -> Prop SourcePos)
-> ParsecT s ParserState Identity SourcePos
-> ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity (Prop SourcePos)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SourcePos -> Id SourcePos -> Prop SourcePos
forall a. a -> Id a -> Prop a
PropId ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier
ParsecT s ParserState Identity (Prop SourcePos)
-> ParsecT s ParserState Identity (Prop SourcePos)
-> ParsecT s ParserState Identity (Prop SourcePos)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (SourcePos -> Integer -> Prop SourcePos)
-> ParsecT s ParserState Identity SourcePos
-> ParsecT s ParserState Identity Integer
-> ParsecT s ParserState Identity (Prop SourcePos)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SourcePos -> Integer -> Prop SourcePos
forall a. a -> Integer -> Prop a
PropNum ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition (Parser s (Either Line Double)
forall s. Stream s Identity Char => Parser s (Either Line Double)
parseNumber Parser s (Either Line Double)
-> (Either Line Double -> ParsecT s ParserState Identity Integer)
-> ParsecT s ParserState Identity Integer
forall a b.
ParsecT s ParserState Identity a
-> (a -> ParsecT s ParserState Identity b)
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Line Double -> ParsecT s ParserState Identity Integer
forall {a} {s} {m :: * -> *} {t} {a} {b} {u}.
(Integral a, Stream s m t, Num a) =>
Either a b -> ParsecT s u m a
toInt)
Parser s String
forall s. Stream s Identity Char => Parser s String
colon
ParsedExpression
val <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
assignExpr
(Prop SourcePos, ParsedExpression)
-> ParsecT
s ParserState Identity (Prop SourcePos, ParsedExpression)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prop SourcePos
name,ParsedExpression
val)
toInt :: Either a b -> ParsecT s u m a
toInt Either a b
eid = case Either a b
eid of
Left a
i -> a -> ParsecT s u m a
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ParsecT s u m a) -> a -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
Right b
d-> String -> ParsecT s u m a
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected String
"Floating point number in property name"
in do SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
[(Prop SourcePos, ParsedExpression)]
props <- Parser s [(Prop SourcePos, ParsedExpression)]
-> Parser s [(Prop SourcePos, ParsedExpression)]
forall s a. Stream s Identity Char => Parser s a -> Parser s a
braces (ParsecT s ParserState Identity (Prop SourcePos, ParsedExpression)
parseProp ParsecT s ParserState Identity (Prop SourcePos, ParsedExpression)
-> Parser s String -> Parser s [(Prop SourcePos, ParsedExpression)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy` Parser s String
forall s. Stream s Identity Char => Parser s String
comma) Parser s [(Prop SourcePos, ParsedExpression)]
-> String -> Parser s [(Prop SourcePos, ParsedExpression)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"object literal"
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedExpression -> ExpressionParser s)
-> ParsedExpression -> ExpressionParser s
forall a b. (a -> b) -> a -> b
$ SourcePos
-> [(Prop SourcePos, ParsedExpression)] -> ParsedExpression
forall a. a -> [(Prop a, Expression a)] -> Expression a
ObjectLit SourcePos
pos [(Prop SourcePos, ParsedExpression)]
props
hex :: Stream s Identity Char => Parser s (Either Int Double)
hex :: forall s. Stream s Identity Char => Parser s (Either Line Double)
hex = do String
s <- Parser s String
forall s. Stream s Identity Char => Parser s String
hexIntLit
Line -> Either Line Double
forall a b. a -> Either a b
Left (Line -> Either Line Double)
-> ParsecT s ParserState Identity Line
-> Parser s (Either Line Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> [(Line, String)])
-> String -> ParsecT s ParserState Identity Line
forall a s. ReadS a -> String -> Parser s a
wrapReadS String -> [(Line, String)]
forall a. (Eq a, Num a) => ReadS a
Numeric.readHex String
s
decimal :: Stream s Identity Char => Parser s (Either Int Double)
decimal :: forall s. Stream s Identity Char => Parser s (Either Line Double)
decimal = do (String
s, Bool
i) <- Parser s (String, Bool)
forall s. Stream s Identity Char => Parser s (String, Bool)
decLit
if Bool
i then Line -> Either Line Double
forall a b. a -> Either a b
Left (Line -> Either Line Double)
-> ParsecT s ParserState Identity Line
-> Parser s (Either Line Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> [(Line, String)])
-> String -> ParsecT s ParserState Identity Line
forall a s. ReadS a -> String -> Parser s a
wrapReadS String -> [(Line, String)]
forall a. (Eq a, Num a) => ReadS a
readDec String
s
else Double -> Either Line Double
forall a b. b -> Either a b
Right (Double -> Either Line Double)
-> ParsecT s ParserState Identity Double
-> Parser s (Either Line Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadS Double -> String -> ParsecT s ParserState Identity Double
forall a s. ReadS a -> String -> Parser s a
wrapReadS ReadS Double
forall a. RealFrac a => ReadS a
readFloat String
s
wrapReadS :: ReadS a -> String -> Parser s a
wrapReadS :: forall a s. ReadS a -> String -> Parser s a
wrapReadS ReadS a
r String
s = case ReadS a
r String
s of
[(a
a, String
"")] -> a -> Parser s a
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
[(a, String)]
_ -> String -> Parser s a
forall a. String -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Bad parse: could not convert a string to a Haskell value"
parseNumber:: Stream s Identity Char => Parser s (Either Int Double)
parseNumber :: forall s. Stream s Identity Char => Parser s (Either Line Double)
parseNumber = Parser s (Either Line Double)
forall s. Stream s Identity Char => Parser s (Either Line Double)
hex Parser s (Either Line Double)
-> Parser s (Either Line Double) -> Parser s (Either Line Double)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser s (Either Line Double)
forall s. Stream s Identity Char => Parser s (Either Line Double)
decimal
parseNumLit:: Stream s Identity Char => ExpressionParser s
parseNumLit :: forall s. Stream s Identity Char => ExpressionParser s
parseNumLit = do SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Either Line Double
eid <- Parser s (Either Line Double) -> Parser s (Either Line Double)
forall s a. Stream s Identity Char => Parser s a -> Parser s a
lexeme (Parser s (Either Line Double) -> Parser s (Either Line Double))
-> Parser s (Either Line Double) -> Parser s (Either Line Double)
forall a b. (a -> b) -> a -> b
$ Parser s (Either Line Double)
forall s. Stream s Identity Char => Parser s (Either Line Double)
parseNumber
ParsecT s ParserState Identity Char
-> ParsecT s ParserState Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy ParsecT s ParserState Identity Char
forall s. Stream s Identity Char => Parser s Char
identifierStart ParsecT s ParserState Identity ()
-> String -> ParsecT s ParserState Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"whitespace"
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedExpression -> ExpressionParser s)
-> ParsedExpression -> ExpressionParser s
forall a b. (a -> b) -> a -> b
$ case Either Line Double
eid of
Left Line
i -> SourcePos -> Line -> ParsedExpression
forall a. a -> Line -> Expression a
IntLit SourcePos
pos Line
i
Right Double
d-> SourcePos -> Double -> ParsedExpression
forall a. a -> Double -> Expression a
NumLit SourcePos
pos Double
d
withPos :: (SourcePos -> t -> b) -> ParsecT s u m t -> ParsecT s u m b
withPos SourcePos -> t -> b
cstr ParsecT s u m t
p = do { SourcePos
pos <- ParsecT s u m SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition; t
e <- ParsecT s u m t
p; b -> ParsecT s u m b
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ParsecT s u m b) -> b -> ParsecT s u m b
forall a b. (a -> b) -> a -> b
$ SourcePos -> t -> b
cstr SourcePos
pos t
e }
dotRef :: ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
dotRef ParsedExpression
e = (String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"." Parser s ()
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (SourcePos -> Id SourcePos -> ParsedExpression)
-> ParsecT s ParserState Identity (Id SourcePos)
-> ParsecT s ParserState Identity ParsedExpression
forall {m :: * -> *} {t} {b} {s} {u}.
Monad m =>
(SourcePos -> t -> b) -> ParsecT s u m t -> ParsecT s u m b
withPos SourcePos -> Id SourcePos -> ParsedExpression
cstr ParsecT s ParserState Identity (Id SourcePos)
forall s. Stream s Identity Char => Parser s (Id SourcePos)
identifier) ParsecT s ParserState Identity ParsedExpression
-> String -> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"property.ref"
where cstr :: SourcePos -> Id SourcePos -> ParsedExpression
cstr SourcePos
pos = SourcePos -> ParsedExpression -> Id SourcePos -> ParsedExpression
forall a. a -> Expression a -> Id a -> Expression a
DotRef SourcePos
pos ParsedExpression
e
funcApp :: ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
funcApp ParsedExpression
e = ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s a. Stream s Identity Char => Parser s a -> Parser s a
parens ((SourcePos -> [ParsedExpression] -> ParsedExpression)
-> ParsecT s ParserState Identity [ParsedExpression]
-> ParsecT s ParserState Identity ParsedExpression
forall {m :: * -> *} {t} {b} {s} {u}.
Monad m =>
(SourcePos -> t -> b) -> ParsecT s u m t -> ParsecT s u m b
withPos SourcePos -> [ParsedExpression] -> ParsedExpression
cstr (ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
assignExpr ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity [ParsedExpression]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
comma))
ParsecT s ParserState Identity ParsedExpression
-> String -> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>String
"(function application)"
where cstr :: SourcePos -> [ParsedExpression] -> ParsedExpression
cstr SourcePos
pos = SourcePos
-> ParsedExpression -> [ParsedExpression] -> ParsedExpression
forall a. a -> Expression a -> [Expression a] -> Expression a
CallExpr SourcePos
pos ParsedExpression
e
bracketRef :: ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
bracketRef ParsedExpression
e = ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s a. Stream s Identity Char => Parser s a -> Parser s a
brackets ((SourcePos -> ParsedExpression -> ParsedExpression)
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall {m :: * -> *} {t} {b} {s} {u}.
Monad m =>
(SourcePos -> t -> b) -> ParsecT s u m t -> ParsecT s u m b
withPos SourcePos -> ParsedExpression -> ParsedExpression
cstr ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseExpression) ParsecT s ParserState Identity ParsedExpression
-> String -> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"[property-ref]"
where cstr :: SourcePos -> ParsedExpression -> ParsedExpression
cstr SourcePos
pos = SourcePos
-> ParsedExpression -> ParsedExpression -> ParsedExpression
forall a. a -> Expression a -> Expression a -> Expression a
BracketRef SourcePos
pos ParsedExpression
e
parseParenExpr:: Stream s Identity Char => ExpressionParser s
parseParenExpr :: forall s. Stream s Identity Char => ExpressionParser s
parseParenExpr = Parser s ParsedExpression -> Parser s ParsedExpression
forall s a. Stream s Identity Char => Parser s a -> Parser s a
parens Parser s ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseListExpr
parseExprForNew :: Stream s Identity Char => ExpressionParser s
parseExprForNew :: forall s. Stream s Identity Char => ExpressionParser s
parseExprForNew = ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseThisRef ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseNullLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseBoolLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseStringLit
ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseArrayLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseParenExpr ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseNewExpr ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseNumLit
ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseRegexpLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseObjectLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseVarRef
parseSimpleExpr' :: Stream s Identity Char => ExpressionParser s
parseSimpleExpr' :: forall s. Stream s Identity Char => ExpressionParser s
parseSimpleExpr' = ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseThisRef ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseNullLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseBoolLit
ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseStringLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseArrayLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseParenExpr
ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseFuncExpr ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseNumLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseRegexpLit ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseObjectLit
ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseVarRef
parseNewExpr :: Stream s Identity Char => ExpressionParser s
parseNewExpr :: forall s. Stream s Identity Char => ExpressionParser s
parseNewExpr =
(do SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"new"
ParsedExpression
constructor <- Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s.
Stream s Identity Char =>
Maybe ParsedExpression -> ExpressionParser s
parseSimpleExprForNew Maybe ParsedExpression
forall a. Maybe a
Nothing
[ParsedExpression]
arguments <- ParsecT s ParserState Identity [ParsedExpression]
-> ParsecT s ParserState Identity [ParsedExpression]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s ParserState Identity [ParsedExpression]
-> ParsecT s ParserState Identity [ParsedExpression]
forall s a. Stream s Identity Char => Parser s a -> Parser s a
parens (ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
assignExpr ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity [ParsedExpression]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
comma)) ParsecT s ParserState Identity [ParsedExpression]
-> ParsecT s ParserState Identity [ParsedExpression]
-> ParsecT s ParserState Identity [ParsedExpression]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> [ParsedExpression]
-> ParsecT s ParserState Identity [ParsedExpression]
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return []
ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
-> ParsedExpression -> [ParsedExpression] -> ParsedExpression
forall a. a -> Expression a -> [Expression a] -> Expression a
NewExpr SourcePos
pos ParsedExpression
constructor [ParsedExpression]
arguments)) ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseSimpleExpr'
parseSimpleExpr :: Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
parseSimpleExpr (Just ParsedExpression
e) = ((ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
dotRef ParsedExpression
e ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
funcApp ParsedExpression
e ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
bracketRef ParsedExpression
e) ParsecT s ParserState Identity ParsedExpression
-> (ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression)
-> ParsecT s ParserState Identity ParsedExpression
forall a b.
ParsecT s ParserState Identity a
-> (a -> ParsecT s ParserState Identity b)
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
parseSimpleExpr (Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression)
-> (ParsedExpression -> Maybe ParsedExpression)
-> ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedExpression -> Maybe ParsedExpression
forall a. a -> Maybe a
Just)
ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedExpression
e
parseSimpleExpr Maybe ParsedExpression
Nothing = do
ParsedExpression
e <- ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseNewExpr ParsecT s ParserState Identity ParsedExpression
-> String -> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"expression (3)"
Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
parseSimpleExpr (ParsedExpression -> Maybe ParsedExpression
forall a. a -> Maybe a
Just ParsedExpression
e)
parseSimpleExprForNew :: Stream s Identity Char
=>(Maybe ParsedExpression) -> ExpressionParser s
parseSimpleExprForNew :: forall s.
Stream s Identity Char =>
Maybe ParsedExpression -> ExpressionParser s
parseSimpleExprForNew (Just ParsedExpression
e) = ((ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
dotRef ParsedExpression
e ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
bracketRef ParsedExpression
e) ParsecT s ParserState Identity ParsedExpression
-> (ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression)
-> ParsecT s ParserState Identity ParsedExpression
forall a b.
ParsecT s ParserState Identity a
-> (a -> ParsecT s ParserState Identity b)
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s.
Stream s Identity Char =>
Maybe ParsedExpression -> ExpressionParser s
parseSimpleExprForNew (Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression)
-> (ParsedExpression -> Maybe ParsedExpression)
-> ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedExpression -> Maybe ParsedExpression
forall a. a -> Maybe a
Just)
ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedExpression
e
parseSimpleExprForNew Maybe ParsedExpression
Nothing = do
ParsedExpression
e <- ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parseNewExpr ParsecT s ParserState Identity ParsedExpression
-> String -> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"expression (3)"
Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s.
Stream s Identity Char =>
Maybe ParsedExpression -> ExpressionParser s
parseSimpleExprForNew (ParsedExpression -> Maybe ParsedExpression
forall a. a -> Maybe a
Just ParsedExpression
e)
makeInfixExpr :: String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
str InfixOp
constr = ParsecT
s
ParserState
Identity
(ParsedExpression -> ParsedExpression -> ParsedExpression)
-> Assoc -> Operator s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m (a -> a -> a) -> Assoc -> Operator s u m a
Infix ParsecT
s
ParserState
Identity
(ParsedExpression -> ParsedExpression -> ParsedExpression)
forall s.
Stream s Identity Char =>
Parser s (ParsedExpression -> ParsedExpression -> ParsedExpression)
parser Assoc
AssocLeft where
parser:: Stream s Identity Char
=> Parser s (Expression SourcePos -> Expression SourcePos -> Expression SourcePos)
parser :: forall s.
Stream s Identity Char =>
Parser s (ParsedExpression -> ParsedExpression -> ParsedExpression)
parser = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
str
(ParsedExpression -> ParsedExpression -> ParsedExpression)
-> Parser
s (ParsedExpression -> ParsedExpression -> ParsedExpression)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
-> InfixOp
-> ParsedExpression
-> ParsedExpression
-> ParsedExpression
forall a.
a -> InfixOp -> Expression a -> Expression a -> Expression a
InfixExpr SourcePos
pos InfixOp
constr)
parsePrefixedExpr :: Stream s Identity Char => ExpressionParser s
parsePrefixedExpr :: forall s. Stream s Identity Char => ExpressionParser s
parsePrefixedExpr = do
SourcePos
pos <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
Maybe PrefixOp
op <- ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity (Maybe PrefixOp)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity (Maybe PrefixOp))
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity (Maybe PrefixOp)
forall a b. (a -> b) -> a -> b
$ (String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"!" Parser s ()
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrefixOp -> ParsecT s ParserState Identity PrefixOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PrefixOp
PrefixLNot) ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"~" Parser s ()
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrefixOp -> ParsecT s ParserState Identity PrefixOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PrefixOp
PrefixBNot) ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(Parser s () -> Parser s ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser s () -> Parser s ()
forall s a. Stream s Identity Char => Parser s a -> Parser s a
lexeme (Parser s () -> Parser s ()) -> Parser s () -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT s ParserState Identity Char -> Parser s () -> Parser s ()
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s ParserState Identity Char -> Parser s ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-')) Parser s ()
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
PrefixOp -> ParsecT s ParserState Identity PrefixOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PrefixOp
PrefixMinus) ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(Parser s () -> Parser s ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser s () -> Parser s ()
forall s a. Stream s Identity Char => Parser s a -> Parser s a
lexeme (Parser s () -> Parser s ()) -> Parser s () -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT s ParserState Identity Char -> Parser s () -> Parser s ()
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s ParserState Identity Char -> Parser s ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT s ParserState Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+')) Parser s ()
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
PrefixOp -> ParsecT s ParserState Identity PrefixOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PrefixOp
PrefixPlus) ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"typeof" Parser s ()
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrefixOp -> ParsecT s ParserState Identity PrefixOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PrefixOp
PrefixTypeof) ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"void" Parser s ()
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrefixOp -> ParsecT s ParserState Identity PrefixOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PrefixOp
PrefixVoid) ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reserved String
"delete" Parser s ()
-> ParsecT s ParserState Identity PrefixOp
-> ParsecT s ParserState Identity PrefixOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrefixOp -> ParsecT s ParserState Identity PrefixOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return PrefixOp
PrefixDelete)
case Maybe PrefixOp
op of
Maybe PrefixOp
Nothing -> ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
unaryAssignExpr
Just PrefixOp
op -> do
ParsedExpression
innerExpr <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parsePrefixedExpr
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> PrefixOp -> ParsedExpression -> ParsedExpression
forall a. a -> PrefixOp -> Expression a -> Expression a
PrefixExpr SourcePos
pos PrefixOp
op ParsedExpression
innerExpr)
exprTable:: Stream s Identity Char => [[Operator s ParserState Identity ParsedExpression]]
exprTable :: forall s.
Stream s Identity Char =>
[[Operator s ParserState Identity ParsedExpression]]
exprTable =
[ [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"*" InfixOp
OpMul
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"/" InfixOp
OpDiv
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"%" InfixOp
OpMod
]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"+" InfixOp
OpAdd
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"-" InfixOp
OpSub
]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"<<" InfixOp
OpLShift
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
">>" InfixOp
OpSpRShift
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
">>>" InfixOp
OpZfRShift
]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"<" InfixOp
OpLT
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"<=" InfixOp
OpLEq
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
">" InfixOp
OpGT
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
">=" InfixOp
OpGEq
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"instanceof" InfixOp
OpInstanceof
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"in" InfixOp
OpIn
]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"==" InfixOp
OpEq
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"!=" InfixOp
OpNEq
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"===" InfixOp
OpStrictEq
, String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"!==" InfixOp
OpStrictNEq
]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"&" InfixOp
OpBAnd ]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"^" InfixOp
OpBXor ]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"|" InfixOp
OpBOr ]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"&&" InfixOp
OpLAnd ]
, [ String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
forall {s}.
Stream s Identity Char =>
String
-> InfixOp -> Operator s ParserState Identity ParsedExpression
makeInfixExpr String
"||" InfixOp
OpLOr ]
]
parseExpression' :: Stream s Identity Char => ExpressionParser s
parseExpression' :: forall s. Stream s Identity Char => ExpressionParser s
parseExpression' =
OperatorTable s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser OperatorTable s ParserState Identity ParsedExpression
forall s.
Stream s Identity Char =>
[[Operator s ParserState Identity ParsedExpression]]
exprTable ParsecT s ParserState Identity ParsedExpression
forall s. Stream s Identity Char => ExpressionParser s
parsePrefixedExpr ParsecT s ParserState Identity ParsedExpression
-> String -> ParsecT s ParserState Identity ParsedExpression
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"simple expression"
asLValue :: Stream s Identity Char
=> SourcePos
-> Expression SourcePos
-> Parser s (LValue SourcePos)
asLValue :: forall s.
Stream s Identity Char =>
SourcePos -> ParsedExpression -> Parser s (LValue SourcePos)
asLValue SourcePos
p' ParsedExpression
e = case ParsedExpression
e of
VarRef SourcePos
p (Id SourcePos
_ String
x) -> LValue SourcePos -> Parser s (LValue SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> String -> LValue SourcePos
forall a. a -> String -> LValue a
LVar SourcePos
p String
x)
DotRef SourcePos
p ParsedExpression
e (Id SourcePos
_ String
x) -> LValue SourcePos -> Parser s (LValue SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos -> ParsedExpression -> String -> LValue SourcePos
forall a. a -> Expression a -> String -> LValue a
LDot SourcePos
p ParsedExpression
e String
x)
BracketRef SourcePos
p ParsedExpression
e1 ParsedExpression
e2 -> LValue SourcePos -> Parser s (LValue SourcePos)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
-> ParsedExpression -> ParsedExpression -> LValue SourcePos
forall a. a -> Expression a -> Expression a -> LValue a
LBracket SourcePos
p ParsedExpression
e1 ParsedExpression
e2)
ParsedExpression
otherwise -> String -> Parser s (LValue SourcePos)
forall a. String -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser s (LValue SourcePos))
-> String -> Parser s (LValue SourcePos)
forall a b. (a -> b) -> a -> b
$ String
"expected a left-value at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SourcePos -> String
forall a. Show a => a -> String
show SourcePos
p'
lvalue :: Stream s Identity Char => Parser s (LValue SourcePos)
lvalue :: forall s. Stream s Identity Char => Parser s (LValue SourcePos)
lvalue = do
SourcePos
p <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
ParsedExpression
e <- Maybe ParsedExpression
-> ParsecT s ParserState Identity ParsedExpression
forall s.
Stream s Identity Char =>
Maybe ParsedExpression -> ExpressionParser s
parseSimpleExpr Maybe ParsedExpression
forall a. Maybe a
Nothing
SourcePos -> ParsedExpression -> Parser s (LValue SourcePos)
forall s.
Stream s Identity Char =>
SourcePos -> ParsedExpression -> Parser s (LValue SourcePos)
asLValue SourcePos
p ParsedExpression
e
unaryAssignExpr :: Stream s Identity Char => ExpressionParser s
unaryAssignExpr :: forall s. Stream s Identity Char => ExpressionParser s
unaryAssignExpr = do
SourcePos
p <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
let prefixInc :: ExpressionParser s
prefixInc = do
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"++"
(LValue SourcePos -> ParsedExpression)
-> ParsecT s ParserState Identity (LValue SourcePos)
-> ExpressionParser s
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SourcePos -> UnaryAssignOp -> LValue SourcePos -> ParsedExpression
forall a. a -> UnaryAssignOp -> LValue a -> Expression a
UnaryAssignExpr SourcePos
p UnaryAssignOp
PrefixInc) ParsecT s ParserState Identity (LValue SourcePos)
forall s. Stream s Identity Char => Parser s (LValue SourcePos)
lvalue
let prefixDec :: ExpressionParser s
prefixDec = do
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"--"
(LValue SourcePos -> ParsedExpression)
-> ParsecT s ParserState Identity (LValue SourcePos)
-> ExpressionParser s
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SourcePos -> UnaryAssignOp -> LValue SourcePos -> ParsedExpression
forall a. a -> UnaryAssignOp -> LValue a -> Expression a
UnaryAssignExpr SourcePos
p UnaryAssignOp
PrefixDec) ParsecT s ParserState Identity (LValue SourcePos)
forall s. Stream s Identity Char => Parser s (LValue SourcePos)
lvalue
let postfixInc :: ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
postfixInc ParsedExpression
e = do
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"++"
(LValue SourcePos -> ParsedExpression)
-> ParsecT s ParserState Identity (LValue SourcePos)
-> ParsecT s ParserState Identity ParsedExpression
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SourcePos -> UnaryAssignOp -> LValue SourcePos -> ParsedExpression
forall a. a -> UnaryAssignOp -> LValue a -> Expression a
UnaryAssignExpr SourcePos
p UnaryAssignOp
PostfixInc) (SourcePos
-> ParsedExpression
-> ParsecT s ParserState Identity (LValue SourcePos)
forall s.
Stream s Identity Char =>
SourcePos -> ParsedExpression -> Parser s (LValue SourcePos)
asLValue SourcePos
p ParsedExpression
e)
let postfixDec :: ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
postfixDec ParsedExpression
e = do
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"--"
(LValue SourcePos -> ParsedExpression)
-> ParsecT s ParserState Identity (LValue SourcePos)
-> ParsecT s ParserState Identity ParsedExpression
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (SourcePos -> UnaryAssignOp -> LValue SourcePos -> ParsedExpression
forall a. a -> UnaryAssignOp -> LValue a -> Expression a
UnaryAssignExpr SourcePos
p UnaryAssignOp
PostfixDec) (SourcePos
-> ParsedExpression
-> ParsecT s ParserState Identity (LValue SourcePos)
forall s.
Stream s Identity Char =>
SourcePos -> ParsedExpression -> Parser s (LValue SourcePos)
asLValue SourcePos
p ParsedExpression
e)
let other :: ExpressionParser s
other = do
ParsedExpression
e <- Maybe ParsedExpression -> ExpressionParser s
forall s.
Stream s Identity Char =>
Maybe ParsedExpression -> ExpressionParser s
parseSimpleExpr Maybe ParsedExpression
forall a. Maybe a
Nothing
ParsedExpression -> ExpressionParser s
forall {s}.
Stream s Identity Char =>
ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
postfixInc ParsedExpression
e ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedExpression -> ExpressionParser s
forall {s}.
Stream s Identity Char =>
ParsedExpression -> ParsecT s ParserState Identity ParsedExpression
postfixDec ParsedExpression
e ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedExpression
e
ExpressionParser s
prefixInc ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
prefixDec ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ExpressionParser s
other
parseTernaryExpr':: Stream s Identity Char
=> Parser s (ParsedExpression,ParsedExpression)
parseTernaryExpr' :: forall s.
Stream s Identity Char =>
Parser s (ParsedExpression, ParsedExpression)
parseTernaryExpr' = do
String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"?"
ParsedExpression
l <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
assignExpr
Parser s String
forall s. Stream s Identity Char => Parser s String
colon
ParsedExpression
r <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
assignExpr
(ParsedExpression, ParsedExpression)
-> Parser s (ParsedExpression, ParsedExpression)
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedExpression
l,ParsedExpression
r)
parseTernaryExpr:: Stream s Identity Char => ExpressionParser s
parseTernaryExpr :: forall s. Stream s Identity Char => ExpressionParser s
parseTernaryExpr = do
ParsedExpression
e <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseExpression'
Maybe (ParsedExpression, ParsedExpression)
e' <- ParsecT s ParserState Identity (ParsedExpression, ParsedExpression)
-> ParsecT
s ParserState Identity (Maybe (ParsedExpression, ParsedExpression))
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe ParsecT s ParserState Identity (ParsedExpression, ParsedExpression)
forall s.
Stream s Identity Char =>
Parser s (ParsedExpression, ParsedExpression)
parseTernaryExpr'
case Maybe (ParsedExpression, ParsedExpression)
e' of
Maybe (ParsedExpression, ParsedExpression)
Nothing -> ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedExpression
e
Just (ParsedExpression
l,ParsedExpression
r) -> do SourcePos
p <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedExpression -> ExpressionParser s)
-> ParsedExpression -> ExpressionParser s
forall a b. (a -> b) -> a -> b
$ SourcePos
-> ParsedExpression
-> ParsedExpression
-> ParsedExpression
-> ParsedExpression
forall a.
a -> Expression a -> Expression a -> Expression a -> Expression a
CondExpr SourcePos
p ParsedExpression
e ParsedExpression
l ParsedExpression
r
assignOp :: Stream s Identity Char => Parser s AssignOp
assignOp :: forall s. Stream s Identity Char => Parser s AssignOp
assignOp = (String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssign)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"+=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignAdd)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"-=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignSub)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"*=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignMul)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"/=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignDiv)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"%=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignMod)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"<<=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignLShift)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
">>=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignSpRShift)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
">>>=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignZfRShift)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"&=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignBAnd)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"^=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignBXor)
ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>(String -> Parser s ()
forall s. Stream s Identity Char => String -> Parser s ()
reservedOp String
"|=" Parser s ()
-> ParsecT s ParserState Identity AssignOp
-> ParsecT s ParserState Identity AssignOp
forall a b.
ParsecT s ParserState Identity a
-> ParsecT s ParserState Identity b
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AssignOp -> ParsecT s ParserState Identity AssignOp
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AssignOp
OpAssignBOr)
assignExpr :: Stream s Identity Char => ExpressionParser s
assignExpr :: forall s. Stream s Identity Char => ExpressionParser s
assignExpr = do
SourcePos
p <- ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
ParsedExpression
lhs <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseTernaryExpr
let assign :: ExpressionParser s
assign = do
AssignOp
op <- Parser s AssignOp
forall s. Stream s Identity Char => Parser s AssignOp
assignOp
LValue SourcePos
lhs <- SourcePos -> ParsedExpression -> Parser s (LValue SourcePos)
forall s.
Stream s Identity Char =>
SourcePos -> ParsedExpression -> Parser s (LValue SourcePos)
asLValue SourcePos
p ParsedExpression
lhs
ParsedExpression
rhs <- ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
assignExpr
ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (SourcePos
-> AssignOp
-> LValue SourcePos
-> ParsedExpression
-> ParsedExpression
forall a. a -> AssignOp -> LValue a -> Expression a -> Expression a
AssignExpr SourcePos
p AssignOp
op LValue SourcePos
lhs ParsedExpression
rhs)
ExpressionParser s
assign ExpressionParser s -> ExpressionParser s -> ExpressionParser s
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedExpression
lhs
parseExpression:: Stream s Identity Char => ExpressionParser s
parseExpression :: forall s. Stream s Identity Char => ExpressionParser s
parseExpression = ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseListExpr
expression :: Stream s Identity Char => Parser s (Expression SourcePos)
expression :: forall s. Stream s Identity Char => ExpressionParser s
expression = ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
parseExpression
parseListExpr :: Stream s Identity Char => ExpressionParser s
parseListExpr :: forall s. Stream s Identity Char => ExpressionParser s
parseListExpr = ExpressionParser s
forall s. Stream s Identity Char => ExpressionParser s
assignExpr ExpressionParser s
-> ParsecT s ParserState Identity String
-> ParsecT s ParserState Identity [ParsedExpression]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` ParsecT s ParserState Identity String
forall s. Stream s Identity Char => Parser s String
comma ParsecT s ParserState Identity [ParsedExpression]
-> ([ParsedExpression] -> ExpressionParser s) -> ExpressionParser s
forall a b.
ParsecT s ParserState Identity a
-> (a -> ParsecT s ParserState Identity b)
-> ParsecT s ParserState Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[ParsedExpression]
exprs ->
case [ParsedExpression]
exprs of
[ParsedExpression
expr] -> ParsedExpression -> ExpressionParser s
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedExpression
expr
[ParsedExpression]
es -> (SourcePos -> [ParsedExpression] -> ParsedExpression)
-> ParsecT s ParserState Identity SourcePos
-> ParsecT s ParserState Identity [ParsedExpression]
-> ExpressionParser s
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SourcePos -> [ParsedExpression] -> ParsedExpression
forall a. a -> [Expression a] -> Expression a
ListExpr ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition ([ParsedExpression]
-> ParsecT s ParserState Identity [ParsedExpression]
forall a. a -> ParsecT s ParserState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParsedExpression]
es)
parseScript:: Stream s Identity Char => Parser s (JavaScript SourcePos)
parseScript :: forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
parseScript = do
Parser s ()
forall s. Stream s Identity Char => Parser s ()
whiteSpace
(SourcePos -> [ParsedStatement] -> JavaScript SourcePos)
-> ParsecT s ParserState Identity SourcePos
-> ParsecT s ParserState Identity [ParsedStatement]
-> Parser s (JavaScript SourcePos)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 SourcePos -> [ParsedStatement] -> JavaScript SourcePos
forall a. a -> [Statement a] -> JavaScript a
Script ParsecT s ParserState Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition (StatementParser s
forall s. Stream s Identity Char => StatementParser s
parseStatement StatementParser s
-> Parser s () -> ParsecT s ParserState Identity [ParsedStatement]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` Parser s ()
forall s. Stream s Identity Char => Parser s ()
whiteSpace)
program :: Stream s Identity Char => Parser s (JavaScript SourcePos)
program :: forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
program = Parser s (JavaScript SourcePos)
forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
parseScript
parse :: Stream s Identity Char
=> Parser s a
-> SourceName
-> s
-> Either ParseError a
parse :: forall s a.
Stream s Identity Char =>
Parser s a -> String -> s -> Either ParseError a
parse Parser s a
p = Parser s a -> ParserState -> String -> s -> Either ParseError a
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parser s a
p ParserState
initialParserState
parseFromString :: String
-> Either ParseError (JavaScript SourcePos)
parseFromString :: String -> Either ParseError (JavaScript SourcePos)
parseFromString = Parser String (JavaScript SourcePos)
-> String -> String -> Either ParseError (JavaScript SourcePos)
forall s a.
Stream s Identity Char =>
Parser s a -> String -> s -> Either ParseError a
parse Parser String (JavaScript SourcePos)
forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
program String
""
parseFromFile :: (MonadIO m, MonadError String m) => String
-> m (JavaScript SourcePos)
parseFromFile :: forall (m :: * -> *).
(MonadIO m, MonadError String m) =>
String -> m (JavaScript SourcePos)
parseFromFile String
fname =
IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO String
readFile String
fname) m String
-> (String -> m (JavaScript SourcePos)) -> m (JavaScript SourcePos)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
source ->
case Parser String (JavaScript SourcePos)
-> String -> String -> Either ParseError (JavaScript SourcePos)
forall s a.
Stream s Identity Char =>
Parser s a -> String -> s -> Either ParseError a
parse Parser String (JavaScript SourcePos)
forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
program String
fname String
source of
Left ParseError
err -> String -> m (JavaScript SourcePos)
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (JavaScript SourcePos))
-> String -> m (JavaScript SourcePos)
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
Right JavaScript SourcePos
js -> JavaScript SourcePos -> m (JavaScript SourcePos)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return JavaScript SourcePos
js
parseJavaScriptFromFile :: MonadIO m => String
-> m [Statement SourcePos]
parseJavaScriptFromFile :: forall (m :: * -> *). MonadIO m => String -> m [ParsedStatement]
parseJavaScriptFromFile String
filename = do
String
chars <- IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFile String
filename
case Parser String (JavaScript SourcePos)
-> String -> String -> Either ParseError (JavaScript SourcePos)
forall s a.
Stream s Identity Char =>
Parser s a -> String -> s -> Either ParseError a
parse Parser String (JavaScript SourcePos)
forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
parseScript String
filename String
chars of
Left ParseError
err -> IO [ParsedStatement] -> m [ParsedStatement]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ParsedStatement] -> m [ParsedStatement])
-> IO [ParsedStatement] -> m [ParsedStatement]
forall a b. (a -> b) -> a -> b
$ IOError -> IO [ParsedStatement]
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO [ParsedStatement])
-> IOError -> IO [ParsedStatement]
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
Right (Script SourcePos
_ [ParsedStatement]
stmts) -> [ParsedStatement] -> m [ParsedStatement]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParsedStatement]
stmts
parseScriptFromString :: String
-> String
-> Either ParseError (JavaScript SourcePos)
parseScriptFromString :: String -> String -> Either ParseError (JavaScript SourcePos)
parseScriptFromString = Parser String (JavaScript SourcePos)
-> String -> String -> Either ParseError (JavaScript SourcePos)
forall s a.
Stream s Identity Char =>
Parser s a -> String -> s -> Either ParseError a
parse Parser String (JavaScript SourcePos)
forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
parseScript
parseString :: String
-> [Statement SourcePos]
parseString :: String -> [ParsedStatement]
parseString String
str = case Parser String (JavaScript SourcePos)
-> String -> String -> Either ParseError (JavaScript SourcePos)
forall s a.
Stream s Identity Char =>
Parser s a -> String -> s -> Either ParseError a
parse Parser String (JavaScript SourcePos)
forall s. Stream s Identity Char => Parser s (JavaScript SourcePos)
parseScript String
"" String
str of
Left ParseError
err -> String -> [ParsedStatement]
forall a. HasCallStack => String -> a
error (ParseError -> String
forall a. Show a => a -> String
show ParseError
err)
Right (Script SourcePos
_ [ParsedStatement]
stmts) -> [ParsedStatement]
stmts