@@ -1,6 +1,5 @@
11module Generate.JavaScript where
22
3−import Control.Applicative ((<$>))
43import Control.Arrow ((***))
54import qualified Data.List as List
65import qualified Data.Map as Map
@@ -13,13 +12,15 @@ import SourceSyntax.Location
1312import qualified Transform.SortDefinitions as SD
1413import Language.ECMAScript3.Syntax
1514import Language.ECMAScript3.PrettyPrint
16−import Parse.Helpers (makeSafe, iParse)
15+import Parse.Helpers (jsReserveds)
1716
18−import Parse.Expression
19−
20−testExpr str = case iParse expr "" str of
21− Right e -> prettyPrint (expression (e :: LExpr () ()))
22− Left err -> error (show err)
17+makeSafe :: String -> String
18+makeSafe = dereserve . deprime
19+ where
20+ deprime = map (\c -> if c == '\'' then '$' else c)
21+ dereserve x = case Set.member x jsReserveds of
22+ False -> x
23+ True -> "$" ++ x
2324
2425split = go []
2526 where
@@ -62,7 +63,7 @@ literal lit =
6263 Chr c -> string [c]
6364 Str s -> ref "_str" <| string s
6465 IntNum n -> IntLit () n
65−-- FloatNum n -> NumLit () (float2Double n) -- wrong!!!
66+ FloatNum n -> NumLit () n
6667 Boolean b -> BoolLit () b
6768
6869expression :: LExpr () () -> Expression ()
@@ -73,10 +74,10 @@ expression (L span expr) =
7374 Range lo hi -> get "_L.range" `call` [expression lo, expression hi]
7475
7576 Access e x -> DotRef () (expression e) (var x)
76− Remove e x -> get "_N.remove" `call` [ref x, expression e]
77− Insert e x v -> get "_N.insert" `call` [ref x, expression v, expression e]
77+ Remove e x -> get "_N.remove" `call` [string x, expression e]
78+ Insert e x v -> get "_N.insert" `call` [string x, expression v, expression e]
7879 Modify e fs ->
79− let modify (f,v) = ArrayLit () [ref f, expression e]
80+ let modify (f,v) = ArrayLit () [string f, expression v]
8081 in get "_N.replace" `call` [ArrayLit () (map modify fs), expression e]
8182
8283 Record fields -> ObjectLit () $ (PropId () (var "_"), hidden) : visible
@@ -183,7 +184,7 @@ definition def =
183184 vars = getVars patterns
184185 getVars patterns =
185186 case patterns of
186− PVar x : rest -> (x:) <$> getVars rest
187+ PVar x : rest -> (x:) `fmap` getVars rest
187188 [] -> Just []
188189 _ -> Nothing
189190
@@ -236,13 +237,13 @@ clause span variable (Clause value vars mtch) =
236237 [] -> name
237238 is -> drop (last is + 1) name
238239
239−jsModule :: MetadataModule () () -> [Statement ()]
240−jsModule modul = setup ("Elm" : names modul) ++
241− [ assign ("Elm" : names modul) (function ["elm"] programStmts) ]
240+jsModule :: MetadataModule () () -> String -- [Statement ()]
241+jsModule modul = show . prettyPrint $ setup (Just "Elm") (names modul) ++
242+ [ assign ("Elm" : names modul) (function ["elm"] programStmts) ]
242243 where
243244 thisModule = dotSep ("elm" : names modul)
244245 programStmts =
245− concat [ setup ("elm" : names modul)
246+ concat [ setup (Just "elm") (names modul)
246247 , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]
247248 , [ internalImports (List.intercalate "." (names modul)) ]
248249 , concatMap jsImport (imports modul)
@@ -260,20 +261,21 @@ jsModule modul = setup ("Elm" : names modul) ++
260261 entry x = (PropId () (var x), ref x)
261262
262263 assign path expr =
263− ExprStmt () $
264− flip (AssignExpr () OpAssign) expr $
265264 case path of
266− [x] -> LVar () x
267− _ -> LDot () (dotSep (init path)) (last path)
265+ [x] -> VarDeclStmt () [ varDecl x expr ]
266+ _ -> ExprStmt () $
267+ AssignExpr () OpAssign (LDot () (dotSep (init path)) (last path)) expr
268268
269− jsImport (modul,_) = setup path ++ [ assign path (dotSep path <| ref "elm") ]
269+ jsImport (modul,_) = setup Nothing path ++ [ assign path (dotSep ("Elm" : path) <| ref "elm") ]
270270 where
271271 path = split modul
272272
273− setup path = map create paths
273+ setup namespace path = map create paths
274274 where
275275 create name = assign name (InfixExpr () OpLOr (dotSep name) (ObjectLit () []))
276− paths = drop 2 . init $ List.inits path
276+ paths = case namespace of
277+ Nothing -> tail . init $ List.inits path
278+ Just nmspc -> drop 2 . init . List.inits $ nmspc : path
277279
278280 addId js = InfixExpr () OpAdd (string (js++"_")) (get "elm.id")
279281
@@ -328,7 +330,7 @@ binop span op e1 e2 =
328330
329331 opDict = Map.fromList (infixOps ++ specialOps)
330332
331− specialOp str func = ("Basic." ++ str, func)
333+ specialOp str func = ("Basics." ++ str, func)
332334 infixOp str op = specialOp str (InfixExpr () op)
333335
334336 infixOps =