git.iko.soy/elk
on b614df2 help sign in
elk/src/Generate/JavaScript.hs
164 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_ =
21 let
22 (ModuleName.Canonical _ name) =
23 Module.name module_
25 body =
26 concat
27 [ useStrict
28 , checkForCachedVersion name
29 , imports (Module.imports module_)
30 , definitions (Module.program (Module.body module_))
31 , exports name (Module.exports module_)
32 ]
34 make =
35 "Elm" : name ++ ["make"]
37 javascript =
38 buildIntermediateObjects make
39 ++
40 [ assign make (function [localRuntime] body)
41 ]
42 in
43 PP.displayS (PP.renderPretty 0.4 160 (ES.prettyPrint javascript)) ""
47-- INTRO
50useStrict :: [Statement ()]
51useStrict =
52 [ ExprStmt () (StringLit () "use strict")
53 ]
56checkForCachedVersion :: ModuleName.Raw -> [Statement ()]
57checkForCachedVersion name =
58 let
59 values =
60 localRuntime : name ++ ["values"]
62 valuesObject =
63 obj values
64 in
65 buildIntermediateObjects values
66 ++
67 [ IfSingleStmt () valuesObject (ReturnStmt () (Just valuesObject))
68 ]
71buildIntermediateObjects :: [String] -> [Statement ()]
72buildIntermediateObjects path =
73 let
74 create name =
75 assign name (InfixExpr () OpLOr (obj name) (ObjectLit () []))
77 paths =
78 drop 2 (init (List.inits path))
79 in
80 map create paths
83assign :: [String] -> Expression () -> Statement ()
84assign path expr =
85 case path of
86 [x] ->
87 VarDeclStmt () [ varDecl x expr ]
89 _ ->
90 ExprStmt () $
91 AssignExpr () OpAssign (LDot () (obj (init path)) (last path)) expr
95-- IMPORTS
98imports :: [ModuleName.Raw] -> [Statement ()]
99imports rawImports =
100 case rawImports of
101 [] ->
102 []
104 _ ->
105 [ VarDeclStmt () (map jsImport rawImports)
106 ]
109jsImport :: ModuleName.Raw -> VarDecl ()
110jsImport name =
111 let
112 make =
113 obj ("Elm" : name ++ ["make"])
114 in
115 varDecl (Var.modulePrefix name) (call make [ref localRuntime])
119-- DEFINITIONS
122definitions :: [Optimized.Def] -> [Statement ()]
123definitions defs =
124 let
125 setup =
126 Var.define "_op" (ObjectLit () [])
127 in
128 setup : State.evalState (mapM JS.generateDef defs) 0
132-- EXPORTS
135exports :: ModuleName.Raw -> [Variable.Value] -> [Statement ()]
136exports name exportedValues =
137 let
138 exportedFields =
139 map toField ("_op" : concatMap extract exportedValues)
141 toField x =
142 (prop x, ref x)
144 extract value =
145 case value of
146 Variable.Alias _ ->
147 []
149 Variable.Value x ->
150 if Help.isOp x then
151 []
153 else
154 [Var.safe x]
156 Variable.Union _ (Variable.Listing ctors _) ->
157 map Var.safe ctors
159 values =
160 LDot () (obj (localRuntime : name)) "values"
161 in
162 [ ReturnStmt () $ Just $
163 AssignExpr () OpAssign values (ObjectLit () exportedFields)
164 ]