git.iko.soy/elk
on master help sign in
Find way to quote exported names and make code smaller
422e250Evan Czaplicki
src/Elm/Compiler/Objects.hs+1−3
compare with master
unifiedsplit
@@ -4,9 +4,7 @@ module Elm.Compiler.Objects
4 , JS.ReplBuilder(..)
4 , JS.ReplBuilder(..)
5 , JS.generateForRepl
5 , JS.generateForRepl
6 , JS.Mode(..)
6 , JS.Mode(..)
7− , JS.MainsBuilder(..)
7+ , JS.generate
8− , JS.MainTrie(..)
9− , JS.generateMains
10 , Opt.Graph
8 , Opt.Graph
11 , empty
9 , empty
12 , union
10 , union
src/Generate/JavaScript.hs+67−40
@@ -4,9 +4,7 @@ module Generate.JavaScript
4 ( ReplBuilder(..)
4 ( ReplBuilder(..)
5 , generateForRepl
5 , generateForRepl
6 , Mode(..)
6 , Mode(..)
7− , MainsBuilder(..)
7+ , generate
8− , MainTrie(..)
9− , generateMains
10 )
8 )
11 where
9 where
12
10
@@ -55,18 +53,11 @@ generateForRepl (Opt.Graph _ graph _) home name =
55-- GENERATE MAINS
53-- GENERATE MAINS
56
54
57
55
58−data MainsBuilder =
59− MainsBuilder
60− { _main_code :: B.Builder
61− , _main_trie :: MainTrie
62− }
63−
64−
65data Mode = Debug | Prod
56data Mode = Debug | Prod
66
57
67
58
68−generateMains :: Mode -> Name.Target -> Opt.Graph -> I.Interfaces -> [ModuleName.Canonical] -> Either [ModuleName.Canonical] MainsBuilder
59+generate :: Mode -> Name.Target -> Opt.Graph -> I.Interfaces -> [ModuleName.Canonical] -> Either [ModuleName.Canonical] B.Builder
69−generateMains mode target (Opt.Graph mains graph fields) interfaces roots =
60+generate mode target (Opt.Graph mains graph fields) interfaces roots =
70 let
61 let
71 rootSet = Set.fromList roots
62 rootSet = Set.fromList roots
72 rootMap = Map.restrictKeys mains rootSet
63 rootMap = Map.restrictKeys mains rootSet
@@ -76,7 +67,7 @@ generateMains mode target (Opt.Graph mains graph fields) interfaces roots =
76 realMode = toRealMode mode target fields
67 realMode = toRealMode mode target fields
77 state = Map.foldrWithKey (addMain realMode graph) emptyState rootMap
68 state = Map.foldrWithKey (addMain realMode graph) emptyState rootMap
78 in
69 in
79− Right $ MainsBuilder (stateToBuilder state) (toMainTrie realMode interfaces rootMap)
70+ Right $ stateToBuilder state <> toMainExports realMode interfaces rootMap
80
71
81 else
72 else
82 Left $ Set.toList $
73 Left $ Set.toList $
@@ -367,49 +358,85 @@ generateManagerHelp home effectsType =
367
358
368
359
369
360
370−-- MAIN TRIE
361+-- MAIN EXPORTS
371
362
372
363
373−data MainTrie =
364+toMainExports :: Name.Mode -> I.Interfaces -> Map.Map ModuleName.Canonical Opt.Main -> B.Builder
374− MainTrie
365+toMainExports mode interfaces mains =
375− { _main :: Maybe B.Builder
366+ let
376− , _subs :: Map.Map N.Name MainTrie
367+ export =
377− }
368+ Name.fromKernel N.platform "export"
378
369
370+ exports =
371+ generateExports mode interfaces $
372+ Map.foldrWithKey addToTrie emptyTrie mains
373+ in
374+ Name.toBuilder export <> "(" <> exports <> ");"
379
375
380−emptyTrie :: MainTrie
381−emptyTrie =
382− MainTrie Nothing Map.empty
383
376
377+generateExports :: Name.Mode -> I.Interfaces -> Trie -> B.Builder
378+generateExports mode interfaces (Trie maybeMain subs) =
379+ let
380+ object =
381+ case Map.toList subs of
382+ [] ->
383+ "{}"
384+
385+ (name, subTrie) : otherSubTries ->
386+ "{'" <> N.toBuilder name <> "':"
387+ <> generateExports mode interfaces subTrie
388+ <> List.foldl' (addSubTrie mode interfaces) "}" otherSubTries
389+ in
390+ case maybeMain of
391+ Nothing ->
392+ object
384
393
385−toMainTrie :: Name.Mode -> I.Interfaces -> Map.Map ModuleName.Canonical Opt.Main -> MainTrie
394+ Just (home, main) ->
386−toMainTrie mode interfaces mains =
395+ let initialize = Expr.generateMain mode interfaces home main in
387− Map.foldrWithKey (addMainTrie mode interfaces) emptyTrie mains
396+ JS.exprToBuilder initialize <> "(" <> object <> ")"
388
397
389
398
399+addSubTrie :: Name.Mode -> I.Interfaces -> B.Builder -> (N.Name, Trie) -> B.Builder
400+addSubTrie mode interfaces end (name, trie) =
401+ ",'" <> N.toBuilder name <> "':"
402+ <> generateExports mode interfaces trie
403+ <> end
404+
405+
406+
407+-- BUILD TRIES
408+
409+
410+data Trie =
411+ Trie
412+ { _main :: Maybe (ModuleName.Canonical, Opt.Main)
413+ , _subs :: Map.Map N.Name Trie
414+ }
415+
416+
417+emptyTrie :: Trie
418+emptyTrie =
419+ Trie Nothing Map.empty
420+
421+
390−addMainTrie :: Name.Mode -> I.Interfaces -> ModuleName.Canonical -> Opt.Main -> MainTrie -> MainTrie
422+addToTrie :: ModuleName.Canonical -> Opt.Main -> Trie -> Trie
391−addMainTrie mode interfaces home@(ModuleName.Canonical _ moduleName) main trie =
423+addToTrie home@(ModuleName.Canonical _ moduleName) main trie =
392− let
393− segments = Text.splitOn "." moduleName
424+ merge trie $ segmentsToTrie home (Text.splitOn "." moduleName) main
394− initMain = Expr.generateMain mode interfaces home segments main
395− newTrie = segmentsToTrie segments (JS.exprToBuilder initMain)
396− in
397− merge trie newTrie
398
425
399
426
400−segmentsToTrie :: [N.Name] -> B.Builder -> MainTrie
427+segmentsToTrie :: ModuleName.Canonical -> [N.Name] -> Opt.Main -> Trie
401−segmentsToTrie segments mainBuilder =
428+segmentsToTrie home segments main =
402 case segments of
429 case segments of
403 [] ->
430 [] ->
404− MainTrie (Just mainBuilder) Map.empty
431+ Trie (Just (home, main)) Map.empty
405
432
406 segment : otherSegments ->
433 segment : otherSegments ->
407− MainTrie Nothing (Map.singleton segment (segmentsToTrie otherSegments mainBuilder))
434+ Trie Nothing (Map.singleton segment (segmentsToTrie home otherSegments main))
408
435
409
436
410−merge :: MainTrie -> MainTrie -> MainTrie
437+merge :: Trie -> Trie -> Trie
411−merge (MainTrie main1 subs1) (MainTrie main2 subs2) =
438+merge (Trie main1 subs1) (Trie main2 subs2) =
412− MainTrie
439+ Trie
413 (checkedMerge main1 main2)
440 (checkedMerge main1 main2)
414 (Map.unionWith merge subs1 subs2)
441 (Map.unionWith merge subs1 subs2)
415
442
src/Generate/JavaScript/Expression.hs+21−28
@@ -16,6 +16,7 @@ import qualified Data.List as List
16import qualified Data.Map as Map
16import qualified Data.Map as Map
17import qualified Data.Text.Encoding as Text
17import qualified Data.Text.Encoding as Text
18
18
19+import qualified AST.Canonical as Can
19import qualified AST.Optimized as Opt
20import qualified AST.Optimized as Opt
20import qualified AST.Module.Name as ModuleName
21import qualified AST.Module.Name as ModuleName
21import qualified Data.Index as Index
22import qualified Data.Index as Index
@@ -171,6 +172,9 @@ codeToExpr code =
171 JsExpr expr ->
172 JsExpr expr ->
172 expr
173 expr
173
174
175+ JsBlock [ JS.Return (Just expr) ] ->
176+ expr
177+
174 JsBlock stmts ->
178 JsBlock stmts ->
175 JS.Call (JS.Function Nothing [] stmts) []
179 JS.Call (JS.Function Nothing [] stmts) []
176
180
@@ -861,32 +865,19 @@ pathToJsExpr mode expr path =
861-- GENERATE MAIN
865-- GENERATE MAIN
862
866
863
867
864−generateMain :: Mode -> I.Interfaces -> ModuleName.Canonical -> [N.Name] -> Opt.Main -> JS.Expr
868+generateMain :: Mode -> I.Interfaces -> ModuleName.Canonical -> Opt.Main -> JS.Expr
865−generateMain mode interfaces home segments main =
869+generateMain mode interfaces home main =
866 case main of
870 case main of
867 Opt.Static ->
871 Opt.Static ->
868 JS.Ref (Name.fromKernel N.browser "staticPage")
872 JS.Ref (Name.fromKernel N.browser "staticPage")
869 # JS.Ref (Name.fromGlobal home "main")
873 # JS.Ref (Name.fromGlobal home "main")
870− # List.foldl' addDot elm segments
874+ # JS.Int 0
875+ # JS.Int 0
871
876
872 Opt.Dynamic decoder msgType ->
877 Opt.Dynamic decoder msgType ->
873− let
874− initializer =
875− JS.Ref (Name.fromGlobal home "main")
878+ JS.Ref (Name.fromGlobal home "main")
876− # List.foldl' addDot elm segments
877− # generateJsExpr mode decoder
879+ # generateJsExpr mode decoder
878− in
880+ # toDebugMetadata mode interfaces msgType
879− JS.Call initializer $
880− case mode of
881− Name.Prod _ _ ->
882− []
883−
884− Name.Debug _ ->
885− [ JS.Json $ Encode.object $
886− [ ("versions", Encode.object [ ("elm", Pkg.encodeVersion Version.version) ])
887− , ("types", Type.encodeMetadata (Extract.fromMsg interfaces msgType))
888− ]
889− ]
890
881
891
882
892(#) :: JS.Expr -> JS.Expr -> JS.Expr
883(#) :: JS.Expr -> JS.Expr -> JS.Expr
@@ -894,12 +885,14 @@ generateMain mode interfaces home segments main =
894 JS.Call func [arg]
885 JS.Call func [arg]
895
886
896
887
897−addDot :: JS.Expr -> N.Name -> JS.Expr
888+toDebugMetadata :: Mode -> I.Interfaces -> Can.Type -> JS.Expr
898−addDot root name =
889+toDebugMetadata mode interfaces msgType =
899− JS.Index root (JS.String (N.toBuilder name))
890+ case mode of
891+ Name.Prod _ _ ->
892+ JS.Int 0
900
893
901−
894+ Name.Debug _ ->
902−{-# NOINLINE elm #-}
895+ JS.Json $ Encode.object $
903−elm :: JS.Expr
896+ [ ("versions", Encode.object [ ("elm", Pkg.encodeVersion Version.version) ])
904−elm =
897+ , ("types", Type.encodeMetadata (Extract.fromMsg interfaces msgType))
905− JS.Ref (Name.fromLocal "Elm")
898+ ]