@@ -5,7 +5,7 @@ import Control.Arrow ((***))
55import qualified Data.List as List
66import qualified Data.Map as Map
77import qualified Data.Set as Set
8−import Data.Either (partitionEithers)
8+import qualified Text.Pandoc as Pan
99
1010import Generate.Cases
1111import SourceSyntax.Everything
@@ -21,6 +21,13 @@ testExpr str = case iParse expr "" str of
2121 Right e -> prettyPrint (expression (e :: LExpr () ()))
2222 Left err -> error (show err)
2323
24+split = go []
25+ where
26+ go vars str =
27+ case break (=='.') str of
28+ (x,'.':rest) -> go (vars ++ [x]) rest
29+ (x,[]) -> vars ++ [x]
30+
2431var name = Id () (makeSafe name)
2532ref name = VarRef () (var name)
2633prop name = PropId () (var name)
@@ -30,21 +37,22 @@ call = CallExpr ()
3037string = StringLit ()
3138
3239dotSep (x:xs) = foldl (DotRef ()) (ref x) (map var xs)
40+get = dotSep . split
3341
3442varDecl x expr =
3543 VarDecl () (var x) (Just expr)
3644
3745include alias moduleName =
38− varDecl alias (dotSep moduleName <| ref "elm")
46+ varDecl alias (get moduleName <| ref "elm")
3947
4048internalImports name =
4149 VarDeclStmt ()
42− [ varDecl "N" (dotSep ["Elm","Native"])
43− , include "_N" ["N","Utils"]
44− , include "_L" ["N","List"]
45− , include "_E" ["N","Error"]
46− , include "_J" ["N","JavaScript"]
47− , varDecl "_str" (dotSep ["_J","toString"])
50+ [ varDecl "N" (get "Elm.Native")
51+ , include "_N" "N.Utils"
52+ , include "_L" "N.List"
53+ , include "_E" "N.Error"
54+ , include "_J" "N.JavaScript"
55+ , varDecl "_str" (get "_J.toString")
4856 , varDecl "$moduleName" (string name)
4957 ]
5058
@@ -61,14 +69,14 @@ expression (L span expr) =
6169 case expr of
6270 Var x -> ref x
6371 Literal lit -> literal lit
64− Range lo hi -> dotSep ["_L","range"] `call` [expression lo, expression hi]
72+ Range lo hi -> get "_L.range" `call` [expression lo, expression hi]
6573
6674 Access e x -> DotRef () (expression e) (var x)
67− Remove e x -> dotSep ["_N","remove"] `call` [ref x, expression e]
68− Insert e x v -> dotSep ["_N","insert"] `call` [ref x, expression v, expression e]
75+ Remove e x -> get "_N.remove" `call` [ref x, expression e]
76+ Insert e x v -> get "_N.insert" `call` [ref x, expression v, expression e]
6977 Modify e fs ->
7078 let modify (f,v) = ArrayLit () [ref f, expression e]
71− in dotSep ["_N","replace"] `call` [ArrayLit () (map modify fs), expression e]
79+ in get "_N.replace" `call` [ArrayLit () (map modify fs), expression e]
7280
7381 Record fields -> ObjectLit () $ (PropId () (var "_"), hidden) : visible
7482 where
@@ -123,7 +131,7 @@ expression (L span expr) =
123131 MultiIf branches ->
124132 case last branches of
125133 (L _ (Var "otherwise"), e) -> ifs (init branches) (expression e)
126− _ -> ifs branches (dotSep ["_E","If"] `call` [ ref "$moduleName", string (show span) ])
134+ _ -> ifs branches (get "_E.If" `call` [ ref "$moduleName", string (show span) ])
127135 where
128136 ifs branches finally = foldr iff finally branches
129137 iff (if', then') else' = CondExpr () (expression if') (expression then') else'
@@ -138,18 +146,18 @@ expression (L span expr) =
138146 in (initialMatch, [VarDeclStmt () [decl]])
139147
140148 ExplicitList es ->
141− dotSep ["_J","toList"] <| ArrayLit () (map expression es)
149+ get "_J.toList" <| ArrayLit () (map expression es)
142150
143151 Data name es ->
144152 ObjectLit () (ctor : fields)
145153 where
146154 ctor = (prop "ctor", string (makeSafe name))
147155 fields = zipWith (\n e -> (prop ("_" ++ show n), expression e)) [0..] es
148−{--
149− Markdown doc -> return $ "Text.text('" ++ pad ++ md ++ pad ++ "')"
150− where pad = "<div style=\"height:0;width:0;\"> </div>"
151− md = formatMarkdown $ Pan.writeHtmlString Pan.def doc
152−--}
156+
157+ Markdown doc -> get "Text.text" <| string (pad ++ md ++ pad)
158+ where pad = "<div style=\"height:0;width:0;\"> </div>"
159+ md = Pan.writeHtmlString Pan.def doc
160+
153161
154162definition def =
155163 case def of
@@ -166,7 +174,7 @@ definition def =
166174
167175 PRecord fields -> VarDeclStmt () (assign "$" : map setField fields)
168176 where
169− setField f = VarDecl () (var f) (Just (dotSep ["$",f]))
177+ setField f = VarDecl () (var f) (Just $ dotSep ["$",f])
170178
171179 PData name patterns | vars /= Nothing ->
172180 case vars of
@@ -185,8 +193,8 @@ definition def =
185193 | otherwise = safeAssign : vars
186194
187195 safeAssign = VarDecl () (var "$") (Just $ CondExpr () if' (expression expr) exception)
188− if' = InfixExpr () OpStrictEq (dotSep ["$","ctor"]) (string name)
189− exception = dotSep ["_E","Case"] `call` [ref "$moduleName", string (show span)]
196+ if' = InfixExpr () OpStrictEq (get "$.ctor") (string name)
197+ exception = get "_E.Case" `call` [ref "$moduleName", string (show span)]
190198
191199 _ -> BlockStmt () ( VarDeclStmt () [assign "$"] : map toDef vars )
192200 where
@@ -194,7 +202,6 @@ definition def =
194202 mkVar = L span . Var
195203 toDef y = definition $
196204 Def (PVar y) (L span $ Case (mkVar "$") [(pattern, mkVar y)])
197−--}
198205
199206match span mtch =
200207 case mtch of
@@ -206,7 +213,7 @@ match span mtch =
206213 _ -> False
207214 access name = if any isLiteral clauses then ref name else dotSep [name,"ctor"]
208215
209− Fail -> [ ExprStmt () (dotSep ["_E","Case"] `call` [ref "$moduleName", string (show span)]) ]
216+ Fail -> [ ExprStmt () (get "_E.Case" `call` [ref "$moduleName", string (show span)]) ]
210217 Break -> []
211218 Other e -> [ ReturnStmt () (Just $ expression e) ]
212219 Seq ms -> concatMap (match span) (dropEnd [] ms)
@@ -292,23 +299,16 @@ jsImport (modul, method) =
292299 '.':rest -> (reverse name, rest)
293300 c:rest -> go (c:name) rest
294301 [] -> (reverse name, [])
295−
296−
297−formatMarkdown = concatMap f
298− where f '\'' = "\\'"
299− f '\n' = "\\n"
300− f '"' = "\""
301− f c = [c]
302302--}
303303binop span op e1 e2 =
304304 case op of
305305 "Basics.." -> ["$"] ==> foldr (<|) (ref "$") (map expression (e1 : collect [] e2))
306306 "Basics.<|" -> foldr (<|) (expression e2) (map expression (collect [] e1))
307307 "::" -> expression (L span (Data "::" [e1,e2]))
308− "List.++" -> dotSep ["_L","append"] `call` [js1, js2]
308+ "List.++" -> get "_L.append" `call` [js1, js2]
309309 _ -> case Map.lookup op opDict of
310310 Just f -> f js1 js2
311− Nothing -> ref "A2" `call` [ func [] op, js1, js2 ]
311+ Nothing -> ref "A2" `call` [ func, js1, js2 ]
312312 where
313313 collect es e =
314314 case e of
@@ -318,12 +318,11 @@ binop span op e1 e2 =
318318 js1 = expression e1
319319 js2 = expression e2
320320
321− func vs str =
322− case break (=='.') str of
323− (x,'.':rest) -> func (vs ++ [x]) rest
324− (op,[])
325− | isOp op -> BracketRef () (dotSep (vs ++ ["_op"])) (string op)
326− | otherwise -> dotSep (vs ++ [op])
321+ func | isOp operator = BracketRef () (dotSep (init parts ++ ["_op"])) (string op)
322+ | otherwise = dotSep parts
323+ where
324+ parts = split op
325+ operator = last parts
327326
328327 opDict = Map.fromList (infixOps ++ specialOps)
329328
@@ -340,10 +339,10 @@ binop span op e1 e2 =
340339 ]
341340
342341 specialOps =
343− [ specialOp "^" $ \a b -> dotSep ["Math","pow"] `call` [a,b]
342+ [ specialOp "^" $ \a b -> get "Math.pow" `call` [a,b]
344343 , specialOp "|>" $ flip (<|)
345− , specialOp "==" $ \a b -> dotSep ["_N","eq"] `call` [a,b]
346− , specialOp "/=" $ \a b -> PrefixExpr () PrefixLNot (dotSep ["_N","eq"] `call` [a,b])
344+ , specialOp "==" $ \a b -> get "_N.eq" `call` [a,b]
345+ , specialOp "/=" $ \a b -> PrefixExpr () PrefixLNot (get "_N.eq" `call` [a,b])
347346 , specialOp "<" $ cmp OpLT 0
348347 , specialOp ">" $ cmp OpGT 0
349348 , specialOp "<=" $ cmp OpLT 1
@@ -351,4 +350,4 @@ binop span op e1 e2 =
351350 , specialOp "div" $ \a b -> InfixExpr () OpBOr (InfixExpr () OpDiv a b) (IntLit () 0)
352351 ]
353352
354− cmp op n a b = InfixExpr () op (dotSep ["_N","cmp"] `call` [a,b]) (IntLit () n)
353+ cmp op n a b = InfixExpr () op (get "_N.cmp" `call` [a,b]) (IntLit () n)