@@ -19,10 +19,14 @@ showErr :: String -> String
1919showErr err = mainEquals $ "text(monospace(" ++ msg ++ "))"
2020 where msg = show . concatMap (++"<br>") . lines $ err
2121
22+indent = concatMap f
23+ where f '\n' = "\n "
24+ f c = [c]
25+
2226parens s = "(" ++ s ++ ")"
2327braces s = "{" ++ s ++ "}"
2428jsList ss = "["++ intercalate "," ss ++"]"
25−jsFunc args body = "function(" ++ args ++ "){" ++ body ++ "}"
29+jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"
2630assign x e = "\nvar " ++ x ++ "=" ++ e ++ ";"
2731ret e = "\nreturn "++ e ++";"
2832iff a b c = a ++ "?" ++ b ++ ":" ++ c
@@ -31,7 +35,7 @@ mainEquals s = globalAssign "ElmCode.main" (jsFunc "" (ret s))
3135globalAssign m s = "\n" ++ m ++ "=" ++ s ++ ";"
3236
3337tryBlock escapees names e =
34− concat [ "\ntry{\n" ++ e ++ "\n\n} catch (e) {"
38+ concat [ "\ntry{\n" ++ e ++ "\n} catch (e) {"
3539 , "ElmCode.main=function() {"
3640 , "var msg = ('<br/><h2>Your browser may not be supported. " ++
3741 "Are you using a modern browser?</h2>' +" ++
@@ -91,8 +95,8 @@ jsImport' (modul, Importing vs) =
9195jsImport' (modul, Hiding vs) =
9296 concat [ assign "hiddenVars" . jsList $ map (\v -> "'" ++ v ++ "'") vs
9397 , "\nfor(var i in " ++ modul ++ "){"
94− , "\nif (hiddenVars.indexOf(i) >= 0) continue;"
95− , globalAssign "this[i]" $ modul ++ "[i]"
98+ , indent $ "\nif (hiddenVars.indexOf(i) >= 0) continue;"
99+ , indent $ globalAssign "this[i]" $ modul ++ "[i]"
96100 , "}" ]
97101
98102stmtsToJS :: [Statement] -> String
@@ -107,7 +111,7 @@ stmtsToJS stmts = concatMap stmtToJS (sortBy cmpStmt stmts)
107111stmtToJS :: Statement -> String
108112stmtToJS (Def name [] e) = assign name (toJS e)
109113stmtToJS (Def name (a:as) e) = "\nfunction " ++ name ++ parens a ++
110− braces (ret . toJS $ foldr Lambda e as) ++ ";"
114+ braces (indent . ret . toJS $ foldr Lambda e as) ++ ";"
111115stmtToJS (Datatype _ _ tcs) = concatMap (stmtToJS . toDef) tcs
112116 where toDef (name,args) = Def name vars $ Data (derename name) (map Var vars)
113117 where vars = map (('a':) . show) [1..length args]
@@ -167,36 +171,31 @@ jsDefs defs = concat `liftM` mapM toDef (sortBy f defs)
167171 toDef (Definition x [] e) = assign x `liftM` toJS' e
168172 toDef (Definition f (a:as) e) = do
169173 out <- toJS' $ foldr Lambda e as
170− return $ "\nfunction " ++ f ++ parens a ++ braces (ret out) ++ ";"
174+ return $ "\nfunction " ++ f ++ parens a ++ braces (indent $ ret out) ++ ";"
171175
172176caseToJS e ps = do
173177 match <- caseToMatch ps
174− var <- liftM (\n -> "case" ++ show n) guid
175− matches <- matchToJS var match
176178 e' <- toJS' e
177− return $ concat [ "function(", var, "){"
178− , case match of { Match name _ _ -> assign name var ; _ -> "" }
179− , matches
180− , "}", parens e' ]
181−
182−matchToJS v (Match name clauses def) = do
179+ (match',stmt) <- case (match,e) of
180+ (Match name _ _, Var x) -> return (matchSubst [(name,x)] match, "")
181+ (Match name _ _, _ ) -> return (match, assign name e')
182+ _ -> liftM (\n -> (match, e')) guid
183+ matches <- matchToJS match'
184+ return $ concat [ "function(){", stmt, matches, "}()" ]
185+
186+matchToJS (Match name clauses def) = do
183187 cases <- concat `liftM` mapM (clauseToJS name) clauses
184− finally <- matchToJS v def
185− return $ concat [ "\nswitch(", name, "[0]){", cases, "\n}", finally ]
186−matchToJS _ Fail = return "\nthrow \"Non-exhaustive pattern match in case\";"
187−matchToJS _ Break = return "break;"
188−matchToJS _ (Other e) = ret `liftM` toJS' e
189−matchToJS v (Seq ms) = concat `liftM` mapM (matchToJS v) ms
188+ finally <- matchToJS def
189+ return $ concat [ "\nswitch(", name, "[0]){", indent cases, "\n}", finally ]
190+matchToJS Fail = return "\nthrow \"Non-exhaustive pattern match in case\";"
191+matchToJS Break = return "break;"
192+matchToJS (Other e) = ret `liftM` toJS' e
193+matchToJS (Seq ms) = concat `liftM` mapM matchToJS ms
190194
191195clauseToJS var (Clause name vars e) = do
192− s <- matchToJS var e
193− return $ concat [ "\ncase ", show name, ":"
194− , defs
195− , s ]
196− where toDef v n = v ++ "=" ++ var ++ "[" ++ show n ++ "]"
197− defs = case vars of [] -> ""
198− _ -> ("\nvar "++) . (++";") . intercalate "," $
199− zipWith toDef vars [ 1 .. length vars ]
196+ let vars' = map (\n -> var ++ "[" ++ show n ++ "]") [ 1 .. length vars ]
197+ s <- matchToJS $ matchSubst (zip vars vars') e
198+ return $ concat [ "\ncase ", show name, ":", s ]
200199
201200jsNil = "[\"Nil\"]"
202201jsCons e1 e2 = jsList [ show "Cons", e1, e2 ]