git.iko.soy/elk
on 59bd3fe help sign in
elk/src/Generate/JavaScript.hs
187 lines 4.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript (generate) where
5import Control.Monad (foldM)
6import Data.Monoid ((<>))
7import qualified Data.List as List
8import qualified Data.Map as Map
9import qualified Data.Set as Set
10import qualified Data.Text as Text
11import qualified Data.Text.Encoding as Text
12import qualified Data.ByteString.Builder as BS
14import qualified AST.Effects as Effects
15import qualified AST.Expression.Optimized as Opt
16import qualified AST.Kernel as Kernel
17import qualified AST.Module.Name as ModuleName
18import qualified AST.Variable as Var
19import qualified Elm.Package as Pkg
20import qualified Elm.Compiler.Objects.Internal as Obj
21import qualified Generate.JavaScript.Builder as JsBuilder
22import qualified Generate.JavaScript.Effects as JsEffects
23import qualified Generate.JavaScript.Expression as JsExpr
24import qualified Generate.JavaScript.Variable as JS
28-- GENERATE JAVASCRIPT
31generate :: Obj.Graph -> Obj.Roots -> BS.Builder
32generate graph roots =
33 let
34 (State builders _ _ effects) =
35 List.foldl' (crawl graph) initialState (Obj.toGlobals roots)
37 managers =
38 JS.run (JsEffects.generate effects)
39 in
40 List.foldl' (\rest stmt -> stmt <> rest) managers builders
44-- CRAWL STATE
47data State =
48 State
49 { _builders :: [BS.Builder]
50 , _seenDecls :: Set.Set Var.Global
51 , _seenKernels :: Set.Set ModuleName.Raw
52 , _effects :: Map.Map ModuleName.Canonical Effects.ManagerType
53 }
56initialState :: State
57initialState =
58 State [] Set.empty Set.empty Map.empty
62-- CRAWL
65crawl :: Obj.Graph -> State -> Var.Global -> State
66crawl graph@(Obj.Graph decls kernels) state@(State _ seenDecls seenKernels _) name@(Var.Global home _) =
67 if Set.member name seenDecls then
68 state
70 else if home == virtualDomDebug then
71 state
73 else
74 case Map.lookup name decls of
75 Just decl ->
76 crawlDecl graph name decl state
78 Nothing ->
79 let
80 kernelModule =
81 ModuleName._module home
82 in
83 if Set.member kernelModule seenKernels then
84 state
85 else
86 case Map.lookup kernelModule kernels of
87 Just info ->
88 crawlKernel graph kernelModule info state
90 Nothing ->
91 error (crawlError name)
95-- CRAWL DECL
98crawlDecl :: Obj.Graph -> Var.Global -> Opt.Decl -> State -> State
99crawlDecl graph var@(Var.Global home name) (Opt.Decl direct indirect fx body) state1 =
100 let
101 state2 =
102 state1 { _seenDecls = Set.insert var (_seenDecls state1) }
104 (State builders seenDecls seenKernels effects) =
105 Set.foldl' (crawl graph) state2 direct
107 stmt =
108 JS.run (JsExpr.generateDecl home name body)
110 state4 =
111 State
112 { _builders = JsBuilder.stmtToBuilder stmt : builders
113 , _seenDecls = seenDecls
114 , _seenKernels = seenKernels
115 , _effects = maybe id (Map.insert home) fx effects
116 }
117 in
118 Set.foldl' (crawl graph) state4 indirect
122-- CRAWL KERNEL
125crawlKernel :: Obj.Graph -> ModuleName.Raw -> Kernel.Info -> State -> State
126crawlKernel graph name (Kernel.Info imports chunks) state1 =
127 let
128 state2 =
129 state1 { _seenKernels = Set.insert name (_seenKernels state1) }
131 (State builders seenDecls seenKernels effects) =
132 List.foldl' (crawl graph) state2 (map toCoreGlobal imports)
134 builder =
135 JS.run (foldM chunkToBuilder mempty chunks)
136 in
137 State
138 { _builders = builder : builders
139 , _seenDecls = seenDecls
140 , _seenKernels = seenKernels
141 , _effects = effects
142 }
145toCoreGlobal :: ( ModuleName.Raw, Text.Text ) -> Var.Global
146toCoreGlobal (home, name) =
147 Var.Global (ModuleName.inCore home) name
150chunkToBuilder :: BS.Builder -> Kernel.Chunk -> JS.Generator BS.Builder
151chunkToBuilder builder chunk =
152 case chunk of
153 Kernel.JS javascript ->
154 return $ BS.byteString javascript <> builder
156 Kernel.Var home name ->
157 do expr <- JS.global (Var.Global (ModuleName.inCore home) name)
158 return $ JsBuilder.exprToBuilder expr <> builder
160 Kernel.Field name ->
161 -- TODO generate a smaller field
162 return $ Text.encodeUtf8Builder name <> builder
164 Kernel.Prod isProd ->
165 -- TODO pick based on what compile mode we are in
166 if isProd then
167 return builder
168 else
169 return $ "_UNUSED" <> builder
173-- CRAWL HELPERS
176crawlError :: Var.Global -> String
177crawlError (Var.Global (ModuleName.Canonical pkg home) name) =
178 Text.unpack $
179 "compiler bug manifesting in Generate.JavaScript\n"
180 <> "Could not find " <> Pkg.toText pkg <> " " <> ModuleName.toText home <> "." <> name <> "\n"
181 <> "Please report at <https://github.com/elm-lang/elm-compiler/issues>\n"
182 <> "Try to make an <http://sscce.org/> that demonstrates the issue!"
185virtualDomDebug :: ModuleName.Canonical
186virtualDomDebug =
187 ModuleName.inVirtualDom "VirtualDom.Debug"