@@ -0,0 +1,169 @@
1+-----------------------------------------------------------------------------
2+--
3+-- Module : Language.PureScript.Parser.JS
4+-- Copyright : (c) Phil Freeman 2013
5+-- License : MIT
6+--
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
9+-- Portability :
10+--
11+-- |
12+--
13+-----------------------------------------------------------------------------
14+
15+module Language.PureScript.Parser.JS (
16+ parseJS
17+) where
18+
19+import Language.PureScript.Values
20+import Language.PureScript.Names
21+import Language.PureScript.CodeGen.JS.AST
22+import qualified Language.PureScript.Parser.Common as C
23+import Control.Applicative
24+import Data.Functor.Identity
25+import qualified Text.Parsec as P
26+import qualified Text.Parsec.Token as P
27+import qualified Text.Parsec.Expr as P
28+
29+booleanLiteral :: P.Parsec String u Bool
30+booleanLiteral = (C.reserved "true" >> return True) P.<|> (C.reserved "false" >> return False)
31+
32+parseNumericLiteral :: P.Parsec String u JS
33+parseNumericLiteral = JSNumericLiteral <$> C.integerOrFloat
34+
35+parseStringLiteral :: P.Parsec String u JS
36+parseStringLiteral = JSStringLiteral <$> C.stringLiteral
37+
38+parseBooleanLiteral :: P.Parsec String u JS
39+parseBooleanLiteral = JSBooleanLiteral <$> booleanLiteral
40+
41+parseArrayLiteral :: P.Parsec String u JS
42+parseArrayLiteral = JSArrayLiteral <$> P.squares C.tokenParser (P.commaSep C.tokenParser parseJS)
43+
44+parseObjectLiteral :: P.Parsec String u JS
45+parseObjectLiteral = JSObjectLiteral <$> P.braces C.tokenParser (P.commaSep C.tokenParser parseIdentifierAndValue)
46+
47+parseIdentifierAndValue :: P.Parsec String u (String, JS)
48+parseIdentifierAndValue = (,) <$> (C.identifier <* C.colon)
49+ <*> parseJS
50+
51+parseFunction :: P.Parsec String u JS
52+parseFunction = do
53+ C.reserved "function"
54+ name <- P.optionMaybe (Ident <$> C.identifier)
55+ args <- P.parens C.tokenParser $ P.commaSep C.tokenParser (Ident <$> C.identifier)
56+ body <- parseJS
57+ return $ JSFunction name args body
58+
59+parseBlock :: P.Parsec String u JS
60+parseBlock = JSBlock <$> P.braces C.tokenParser (P.many parseJS)
61+
62+parseVar :: P.Parsec String u JS
63+parseVar = JSVar <$> Ident <$> C.identifier
64+
65+parseJSAtom :: P.Parsec String u JS
66+parseJSAtom = P.choice
67+ [ P.try parseNumericLiteral
68+ , P.try parseStringLiteral
69+ , P.try parseBooleanLiteral
70+ , parseArrayLiteral
71+ , P.try parseObjectLiteral
72+ , parseFunction
73+ , parseBlock
74+ , P.try parseVar
75+ , parseVariableIntroduction
76+ , P.try parseAssignment
77+ , parseWhile
78+ , parseIf
79+ , parseReturn
80+ , P.parens C.tokenParser parseJS ]
81+
82+parseAccessor :: JS -> P.Parsec String u JS
83+parseAccessor js = P.try $ flip JSAccessor js <$> (C.dot *> P.notFollowedBy C.opLetter *> C.identifier)
84+
85+parseIndexer :: JS -> P.Parsec String u JS
86+parseIndexer js = P.try $ flip JSIndexer js <$> (P.squares C.tokenParser parseJS)
87+
88+parseConditional :: JS -> P.Parsec String u JS
89+parseConditional js = P.try $ do
90+ C.lexeme $ P.char '?'
91+ tr <- parseJS
92+ C.lexeme $ P.char ':'
93+ fa <- parseJS
94+ return $ JSConditional js tr fa
95+
96+binary :: BinaryOperator -> String -> P.Assoc -> P.Operator String u Identity JS
97+binary op s f = P.Infix (P.try $ C.reservedOp s >> return (JSBinary op)) f
98+
99+unary :: UnaryOperator -> String -> P.Operator String u Identity JS
100+unary op s = P.Prefix (P.try $ C.reservedOp s >> return (JSUnary op))
101+
102+parseJS :: P.Parsec String u JS
103+parseJS =
104+ (P.buildExpressionParser operators
105+ . C.buildPostfixParser postfixTable2
106+ $ indexersAndAccessors) P.<?> "javascript"
107+ where
108+ indexersAndAccessors = C.buildPostfixParser postfixTable1 parseJSAtom
109+ postfixTable1 = [ parseAccessor, parseIndexer, parseConditional ]
110+ postfixTable2 = [ \v -> P.try $ JSApp v <$> (P.parens C.tokenParser (P.commaSep C.tokenParser parseJS)) ]
111+ operators = [ [ binary LessThan "<" P.AssocLeft]
112+ , [ binary LessThanOrEqualTo "<=" P.AssocLeft]
113+ , [ binary GreaterThan ">" P.AssocLeft]
114+ , [ binary GreaterThanOrEqualTo ">=" P.AssocLeft]
115+ , [ unary Not "!" ]
116+ , [ unary BitwiseNot "~" ]
117+ , [ unary Negate "-" ]
118+ , [ unary Positive "+" ]
119+ , [ binary Multiply "*" P.AssocLeft]
120+ , [ binary Divide "/" P.AssocLeft]
121+ , [ binary Modulus "%" P.AssocLeft]
122+ , [ binary Concat "+" P.AssocLeft]
123+ , [ binary Add "+" P.AssocLeft]
124+ , [ binary Subtract "-" P.AssocLeft]
125+ , [ binary ShiftLeft "<<" P.AssocLeft]
126+ , [ binary ShiftRight ">>" P.AssocLeft]
127+ , [ binary ZeroFillShiftRight ">>>" P.AssocLeft]
128+ , [ binary EqualTo "===" P.AssocLeft]
129+ , [ binary NotEqualTo "!==" P.AssocLeft]
130+ , [ binary BitwiseAnd "&" P.AssocLeft]
131+ , [ binary BitwiseXor "^" P.AssocLeft]
132+ , [ binary BitwiseOr "|" P.AssocLeft]
133+ , [ binary And "&&" P.AssocRight]
134+ , [ binary Or "||" P.AssocRight]
135+ ]
136+
137+parseVariableIntroduction :: P.Parsec String u JS
138+parseVariableIntroduction = do
139+ C.reserved "var"
140+ name <- Ident <$> P.identifier C.tokenParser
141+ value <- P.optionMaybe $ do
142+ C.lexeme $ P.char '='
143+ value <- parseJS
144+ C.semi
145+ return value
146+ return $ JSVariableIntroduction name value
147+
148+parseAssignment :: P.Parsec String u JS
149+parseAssignment = do
150+ tgt <- parseAssignmentTarget
151+ C.lexeme $ P.char '='
152+ value <- parseJS
153+ C.semi
154+ return $ JSAssignment tgt value
155+
156+parseAssignmentTarget :: P.Parsec String u JSAssignment
157+parseAssignmentTarget = C.buildPostfixParser [] (JSAssignVariable <$> Ident <$> P.identifier C.tokenParser)
158+
159+parseWhile :: P.Parsec String u JS
160+parseWhile = JSWhile <$> (C.reserved "while" *> P.parens C.tokenParser parseJS)
161+ <*> parseJS
162+
163+parseIf :: P.Parsec String u JS
164+parseIf = JSIfElse <$> (C.reserved "if" *> P.parens C.tokenParser parseJS)
165+ <*> parseJS
166+ <*> P.optionMaybe (C.reserved "else" >> parseJS)
167+
168+parseReturn :: P.Parsec String u JS
169+parseReturn = JSReturn <$> (C.reserved "return" *> parseJS <* C.semi)