git.iko.soy/elk
on d163289 help sign in
elk/src/Generate/JavaScript.hs
159 lines 3.5 kB history raw
1module Generate.JavaScript (generate) where
3import Control.Monad.State as State
4import qualified Data.List as List
5import Language.ECMAScript3.PrettyPrint as ES
6import Language.ECMAScript3.Syntax
7import qualified Text.PrettyPrint.Leijen as PP
9import qualified AST.Expression.Optimized as Optimized
10import qualified AST.Helpers as Help
11import qualified AST.Module as Module
12import qualified AST.Module.Name as ModuleName
13import qualified AST.Variable as Variable
14import qualified Generate.JavaScript.Expression as JS
15import Generate.JavaScript.Helpers (call, function, localRuntime, obj, prop, ref, varDecl)
16import qualified Generate.JavaScript.Variable as Var
19generate :: Module.Optimized -> String
20generate (Module.Module (ModuleName.Canonical _ name) _ info) =
21 let
22 body =
23 concat
24 [ useStrict
25 , checkForCachedVersion name
26 , imports (Module.imports info)
27 , definitions (Module.program info)
28 , exports name (Module.exports info)
29 ]
31 make =
32 "Elm" : name ++ ["make"]
34 javascript =
35 buildIntermediateObjects make
36 ++
37 [ assign make (function [localRuntime] body)
38 ]
39 in
40 PP.displayS (PP.renderPretty 1 160 (ES.prettyPrint javascript)) ""
44-- INTRO
47useStrict :: [Statement ()]
48useStrict =
49 [ ExprStmt () (StringLit () "use strict")
50 ]
53checkForCachedVersion :: ModuleName.Raw -> [Statement ()]
54checkForCachedVersion name =
55 let
56 values =
57 localRuntime : name ++ ["values"]
59 valuesObject =
60 obj values
61 in
62 buildIntermediateObjects values
63 ++
64 [ IfSingleStmt () valuesObject (ReturnStmt () (Just valuesObject))
65 ]
68buildIntermediateObjects :: [String] -> [Statement ()]
69buildIntermediateObjects path =
70 let
71 create name =
72 assign name (InfixExpr () OpLOr (obj name) (ObjectLit () []))
74 paths =
75 drop 2 (init (List.inits path))
76 in
77 map create paths
80assign :: [String] -> Expression () -> Statement ()
81assign path expr =
82 case path of
83 [x] ->
84 VarDeclStmt () [ varDecl x expr ]
86 _ ->
87 ExprStmt () $
88 AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr
92-- IMPORTS
95imports :: [ModuleName.Raw] -> [Statement ()]
96imports rawImports =
97 let
98 utils =
99 varDecl "_U" (call (obj ["Elm", "Native", "Utils", "make"]) [ref localRuntime])
100 in
101 [ VarDeclStmt () (utils : map jsImport rawImports) ]
104jsImport :: ModuleName.Raw -> VarDecl ()
105jsImport name =
106 let
107 make =
108 obj ("Elm" : name ++ ["make"])
109 in
110 varDecl (Var.modulePrefix name) (call make [ref localRuntime])
114-- DEFINITIONS
117definitions :: [Optimized.Def] -> [Statement ()]
118definitions defs =
119 let
120 setup =
121 Var.define "_op" (ObjectLit () [])
122 in
123 setup : State.evalState (mapM JS.generateDef defs) 0
127-- EXPORTS
130exports :: ModuleName.Raw -> [Variable.Value] -> [Statement ()]
131exports name exportedValues =
132 let
133 exportedFields =
134 map toField ("_op" : concatMap extract exportedValues)
136 toField x =
137 (prop x, ref x)
139 extract value =
140 case value of
141 Variable.Alias _ ->
142 []
144 Variable.Value x ->
145 if Help.isOp x then
146 []
148 else
149 [Var.safe x]
151 Variable.Union _ (Variable.Listing ctors _) ->
152 map Var.safe ctors
154 values =
155 LDot () (obj (localRuntime : name)) "values"
156 in
157 [ ReturnStmt () $ Just $
158 AssignExpr () OpAssign values (ObjectLit () exportedFields)
159 ]