git.iko.soy/elk
on 101709f help sign in
elk/src/Generate/JavaScript.hs
177 lines 4.8 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.ByteString.Builder as BS
13import qualified AST.Effects as Effects
14import qualified AST.Expression.Optimized as Opt
15import qualified AST.Kernel as Kernel
16import qualified AST.Module.Name as ModuleName
17import qualified AST.Variable as Var
18import qualified Elm.Package as Pkg
19import qualified Elm.Compiler.Objects.Internal as Obj
20import qualified Generate.JavaScript.Builder as JsBuilder
21import qualified Generate.JavaScript.Effects as JsEffects
22import qualified Generate.JavaScript.Expression as JsExpr
23import qualified Generate.JavaScript.Variable as JS
27-- GENERATE JAVASCRIPT
30generate :: Obj.Graph -> Obj.Roots -> BS.Builder
31generate graph roots =
32 let
33 (State builders _ _ effects table) =
34 List.foldl' (crawl graph) initialState (Obj.toGlobals roots)
36 managers =
37 fst $ JS.run table (JsEffects.generate effects)
38 in
39 List.foldl' (\rest stmt -> stmt <> rest) managers builders
43-- CRAWL STATE
46data State =
47 State
48 { _builders :: [BS.Builder]
49 , _seenDecls :: Set.Set Var.Global
50 , _seenKernels :: Set.Set ModuleName.Raw
51 , _effects :: Map.Map ModuleName.Canonical Effects.ManagerType
52 , _table :: JS.Table
53 }
56initialState :: State
57initialState =
58 State [] Set.empty Set.empty Map.empty JS.emptyTable
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 table) =
105 Set.foldl' (crawl graph) state2 direct
107 (stmt, newTable) =
108 JS.run table (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 , _table = newTable
117 }
118 in
119 Set.foldl' (crawl graph) state4 indirect
123-- CRAWL KERNEL
126crawlKernel :: Obj.Graph -> ModuleName.Raw -> Kernel.Info -> State -> State
127crawlKernel graph name (Kernel.Info imports chunks) state1 =
128 let
129 state2 =
130 state1 { _seenKernels = Set.insert name (_seenKernels state1) }
132 (State builders seenDecls seenKernels effects table) =
133 List.foldl' (crawl graph) state2 (map toCoreGlobal imports)
135 (builder, newTable) =
136 JS.run table (foldM chunkToBuilder mempty chunks)
137 in
138 State
139 { _builders = builder : builders
140 , _seenDecls = seenDecls
141 , _seenKernels = seenKernels
142 , _effects = effects
143 , _table = newTable
144 }
147toCoreGlobal :: ( ModuleName.Raw, Text.Text ) -> Var.Global
148toCoreGlobal (home, name) =
149 Var.Global (ModuleName.inCore home) name
152chunkToBuilder :: BS.Builder -> Kernel.Chunk -> JS.Generator BS.Builder
153chunkToBuilder builder chunk =
154 case chunk of
155 Kernel.JS javascript ->
156 return $ BS.byteString javascript <> builder
158 Kernel.Var home name ->
159 do expr <- JS.global (Var.Global (ModuleName.inCore home) name)
160 return $ JsBuilder.exprToBuilder expr <> builder
163-- CRAWL HELPERS
166crawlError :: Var.Global -> String
167crawlError (Var.Global (ModuleName.Canonical pkg home) name) =
168 Text.unpack $
169 "compiler bug manifesting in Generate.JavaScript\n"
170 <> "Could not find " <> Pkg.toText pkg <> " " <> ModuleName.toText home <> "." <> name <> "\n"
171 <> "Please report at <https://github.com/elm-lang/elm-compiler/issues>\n"
172 <> "Try to make an <http://sscce.org/> that demonstrates the issue!"
175virtualDomDebug :: ModuleName.Canonical
176virtualDomDebug =
177 ModuleName.inVirtualDom "VirtualDom.Debug"