@@ -19,13 +19,27 @@ import Rename (deprime)
1919import Types.Types ( Type(RecordT) )
2020
2121showErr :: String -> String
22−showErr err = mainEquals $ "Elm.Graphics.text(Elm.Text.monospace(" ++ msg ++ "))"
22+showErr err = "Elm.Graphics.text(Elm.Text.monospace(" ++ msg ++ "))"
2323 where msg = show . concatMap (++"<br>") . lines $ err
2424
2525indent = concatMap f
2626 where f '\n' = "\n "
2727 f c = [c]
2828
29+internalImports =
30+ [ ("_Utils", "Elm.Native.Utils(elm)"),
31+ ("_insert", "_Utils.insert"),
32+ ("_remove", "_Utils.remove"),
33+ ("_replace", "_Utils.replace"),
34+ ("_eq", "_Utils.eq"),
35+ ("_compare", "_Utils.compare"),
36+ ("_range", "Elm.Native.List(elm).range"),
37+ ("_append", "Elm.Native.List(elm).append"),
38+ ("_caseError", "Elm.Native.Error(elm).Case"),
39+ ("_ifError", "Elm.Native.Error(elm).If"),
40+ ("_str", "Elm.Native.JavaScript(elm).toString")
41+ ]
42+
2943parens s = "(" ++ s ++ ")"
3044brackets s = "{" ++ s ++ "}"
3145jsList ss = "["++ intercalate "," ss ++"]"
@@ -41,24 +55,26 @@ quoted s = "'" ++ concatMap f s ++ "'"
4155 f '\\' = "\\\\"
4256 f c = [c]
4357
44−mainEquals s = globalAssign "Elm.main" (jsFunc "" (ret (s ++ ".main")))
4558globalAssign n e = "\n" ++ assign' n e ++ ";"
4659assign' n e = n ++ " = " ++ e
4760
4861jsModule (Module names exports imports stmts) =
49− setup ++ parens (jsFunc "" program ++ "()") ++ mainEquals modName
62+ setup ++ globalAssign ("Elm." ++ modName) (jsFunc "elm" program)
5063 where
51− modNames = if null names then ["Elm", "Main"] else "Elm" : names
64+ modNames = if null names then ["Main"] else names
5265 modName = intercalate "." modNames
5366 includes = concatMap jsImport imports
5467 body = stmtsToJS stmts
5568 export = getExports exports stmts
5669 exps = if null exports then ["main"] else exports
5770 defs = assign "$op" "{}"
58− program = defs ++ includes ++ body ++ globalAssign modName export
71+ program = usefulFuncs ++ defs ++ includes ++ body ++
72+ ret ("elm." ++ modName ++ " = " ++ export)
5973 setup = concatMap (\n -> globalAssign n $ n ++ " || {}") .
60− map (intercalate ".") . drop 2 . inits $
74+ map (intercalate ".") . tail . inits $
6175 take (length modNames - 1) modNames
76+ usefulFuncs =
77+ "var " ++ intercalate ", " (map (uncurry assign) internalImports) ++ ";"
6278
6379getExports names stmts = brackets . ("\n "++) $
6480 intercalate ",\n " (op : map fnPair fns)
@@ -85,11 +101,11 @@ getExports names stmts = brackets . ("\n "++) $
85101
86102jsImport (modul, how) =
87103 case how of
88− As name -> assign name ("Elm." ++ modul)
104+ As name -> assign name ("Elm." ++ modul ++ parens "elm")
89105 Importing vs ->
90− assign modul ("Elm." ++ modul) ++ concatMap def vs
106+ "\nElm." ++ modul ++ parens "elm" ++ ";" ++ concatMap def vs
91107 where
92− imprt asgn v = asgn v ("Elm." ++ modul ++ "." ++ v)
108+ imprt asgn v = asgn v ("elm." ++ modul ++ "." ++ v)
93109 def (o:p) =
94110 if isOp o then imprt globalAssign ("$op['" ++ o:p ++ "']")
95111 else imprt assign (deprime (o:p))
@@ -137,13 +153,13 @@ instance ToJS Statement where
137153 ImportEvent js base elm _ ->
138154 do v <- toJS' base
139155 return $ concat [ "\nvar " ++ elm ++ "=Elm.Signal.constant(" ++ v ++ ");"
140− , "\nValue.addListener(document, '" ++ js
141− , "', function(e) { Dispatcher.notify(" ++ elm
156+ , "\ndocument.addEventListener('", js
157+ , "_' + elm.id, function(e) { elm.notify(", elm
142158 , ".id, e.value); });" ]
143159 ExportEvent js elm _ ->
144160 return $ concat [ "\nlift(function(v) { "
145161 , "var e = document.createEvent('Event');"
146− , "e.initEvent('", js, "', true, true);"
162+ , "e.initEvent('", js, "_' + elm.id, true, true);"
147163 , "e.value = v;"
148164 , "document.dispatchEvent(e); return v; })(", elm, ");" ]
149165 TypeAnnotation _ _ -> return ""
@@ -163,9 +179,9 @@ toJS' (C txt span expr) =
163179 Case e cases -> caseToJS span e cases
164180 _ -> toJS expr
165181
166−remove x e = "elmRecordRemove('" ++ x ++ "', " ++ e ++ ")"
167−addField x v e = "elmRecordInsert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"
168−setField fs e = "elmRecordReplace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"
182+remove x e = "_remove('" ++ x ++ "', " ++ e ++ ")"
183+addField x v e = "_insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"
184+setField fs e = "_replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"
169185 where f (x,v) = "['" ++ x ++ "'," ++ v ++ "]"
170186access x e = parens e ++ "." ++ x
171187makeRecord kvs = record `liftM` collect kvs
@@ -185,11 +201,11 @@ makeRecord kvs = record `liftM` collect kvs
185201instance ToJS Expr where
186202 toJS expr =
187203 case expr of
188− IntNum n -> return $ show n ++ "|0"
204+ IntNum n -> return $ show n
189205 FloatNum n -> return $ show n
190206 Var x -> return $ x
191207 Chr c -> return $ quoted [c]
192− Str s -> return $ "Value.str" ++ parens (quoted s)
208+ Str s -> return $ "_str" ++ parens (quoted s)
193209 Boolean b -> return $ if b then "true" else "false"
194210 Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi
195211 Access e x -> access x `liftM` toJS' e
@@ -238,7 +254,7 @@ formatMarkdown = concatMap f
238254multiIfToJS span ps =
239255 case last ps of
240256 (C _ _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)
241− _ -> format ("Elm.Error.If" ++ parens (quoted (show span))) ps
257+ _ -> format ("_ifError" ++ parens (quoted (show span))) ps
242258 where
243259 format base ps =
244260 foldr (\c e -> parens $ c ++ " : " ++ e) base `liftM` mapM f ps
@@ -263,7 +279,7 @@ caseToJS span e ps = do
263279 return (matchSubst [(name,x)] match, Nothing)
264280 (Match name _ _, _) ->
265281 return (match, Just (name ++ " = " ++ e'))
266− _ -> return (match, Nothing) -- Just e'
282+ _ -> return (match, Nothing)
267283 matches <- matchToJS span match'
268284 return $ case stmt of
269285 Nothing -> matches
@@ -276,7 +292,7 @@ matchToJS span match =
276292 do cases <- intercalate " : " `liftM` mapM (clauseToJS span name) clauses
277293 finally <- matchToJS span def
278294 return (sqnc cases finally)
279− Fail -> return ("Elm.Error.Case" ++ parens (quoted (show span)))
295+ Fail -> return ("_caseError" ++ parens (quoted (show span)))
280296 Break -> return "null"
281297 Other e -> toJS' e
282298 Seq ms -> foldr1 sqnc `liftM` mapM (matchToJS span) (dropEnd [] ms)
@@ -294,7 +310,8 @@ clauseToJS span var (Clause name vars e) = do
294310
295311jsNil = "{ctor:'Nil'}"
296312jsCons e1 e2 = "{ctor:'Cons',_0:" ++ e1 ++ ",_1:" ++ e2 ++ "}"
297−jsRange e1 e2 = "Elm.Native.List.range" ++ parens (e1 ++ "," ++ e2)
313+jsRange e1 e2 = "_range" ++ parens (e1 ++ "," ++ e2)
314+jsCompare e1 e2 op = parens ("_compare(" ++ e1 ++ "," ++ e2 ++ ").ctor " ++ op)
298315
299316binop (o:p) e1 e2
300317 | isAlpha o || '_' == o = (o:p) ++ parens e1 ++ parens e2
@@ -302,23 +319,19 @@ binop (o:p) e1 e2
302319 let ops = ["+","-","*","/","&&","||"] in
303320 case o:p of
304321 "::" -> jsCons e1 e2
305− "++" -> append e1 e2
322+ "++" -> "_append" ++ parens (e1 ++ "," ++ e2)
306323 "$" -> e1 ++ parens e2
307324 "." -> jsFunc "x" . ret $ e1 ++ parens (e2 ++ parens "x")
308325 "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"
309− "==" -> "eq(" ++ e1 ++ "," ++ e2 ++ ")"
310− "/=" -> "not(eq(" ++ e1 ++ "," ++ e2 ++ "))"
311− "<" -> "(compare(" ++ e1 ++ ")(" ++ e2 ++ ").ctor === 'LT')"
312− ">" -> "(compare(" ++ e1 ++ ")(" ++ e2 ++ ").ctor === 'GT')"
313− "<=" -> "function() { var ord = compare(" ++ e1 ++ ")(" ++
314− e2 ++ ").ctor; return ord==='LT' || ord==='EQ'; }()"
315− ">=" -> "function() { var ord = compare(" ++ e1 ++ ")(" ++
316− e2 ++ ").ctor; return ord==='GT' || ord==='EQ'; }()"
326+ "==" -> "_eq(" ++ e1 ++ "," ++ e2 ++ ")"
327+ "/=" -> "!_eq(" ++ e1 ++ "," ++ e2 ++ ")"
328+ "<" -> jsCompare e1 e2 "=== 'LT'"
329+ ">" -> jsCompare e1 e2 "=== 'GT'"
330+ "<=" -> jsCompare e1 e2 "!== 'GT'"
331+ ">=" -> jsCompare e1 e2 "!== 'LT'"
317332 "<~" -> "lift" ++ parens e1 ++ parens e2
318333 "~" -> "lift2(function(f){return function(x){return f(x);};})" ++
319334 parens e1 ++ parens e2
320335 _ | elem (o:p) ops -> parens (e1 ++ (o:p) ++ e2)
321336 | otherwise -> concat [ "$op['", o:p, "']"
322− , parens e1, parens e2 ]
323−
324−append e1 e2 = "Value.append" ++ parens (e1 ++ "," ++ e2)
337+ , parens e1, parens e2 ]