git.iko.soy/elk
on 700055c help sign in
elk/src/Generate/JavaScript.hs
93 lines 2.4 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript (generate) where
5import qualified Control.Monad.State as State
6import Data.Text (Text)
7import qualified Data.Text.Lazy as LazyText
9import qualified AST.Effects as Effects
10import qualified AST.Module as Module
11import qualified AST.Module.Name as ModuleName
12import qualified Elm.Package as Pkg
13import qualified Generate.JavaScript.Builder as JS
14import qualified Generate.JavaScript.Expression as JS
15import qualified Generate.JavaScript.Helpers as JS
16import qualified Generate.JavaScript.Variable as Var
20-- GENERATE JAVASCRIPT
23generate :: Module.Optimized -> LazyText.Text
24generate (Module.Module moduleName info) =
25 let
26 genBody =
27 do defsList <- mapM JS.generateDef (Module.program info)
28 let managerStmts = generateEffectManager moduleName (Module.effects info)
29 return (concat (defsList ++ [managerStmts]))
31 body =
32 State.evalState genBody 0
33 in
34 JS.stmtsToText body
38-- GENERATE EFFECT MANAGER
41generateEffectManager :: ModuleName.Canonical -> Effects.Canonical -> [JS.Stmt]
42generateEffectManager moduleName effects =
43 case effects of
44 Effects.None ->
45 []
47 Effects.Port _ ->
48 []
50 Effects.Manager pkgName (Effects.Info _ _ _ _ managerType) ->
51 let
52 managers =
53 Var.coreNative "Platform" "effectManagers"
55 managerName =
56 JS.String (ModuleName.canonicalToText moduleName)
58 entry name =
59 ( JS.IdProp (JS.Id name)
60 , JS.ref (Var.qualified moduleName name)
61 )
63 managerEntries =
64 [ "pkg" ==> Pkg.toText pkgName
65 , entry "init"
66 , entry "onEffects"
67 , entry "onSelfMsg"
68 ]
70 otherEntries =
71 case managerType of
72 Effects.CmdManager _ ->
73 [ "tag" ==> "cmd", entry "cmdMap" ]
75 Effects.SubManager _ ->
76 [ "tag" ==> "sub", entry "subMap" ]
78 Effects.FxManager _ _ ->
79 [ "tag" ==> "fx", entry "cmdMap", entry "subMap" ]
81 addManager =
82 JS.Assign JS.OpAssign
83 (JS.LBracket managers managerName)
84 (JS.Object (managerEntries ++ otherEntries))
85 in
86 [ JS.ExprStmt addManager ]
89(==>) :: Text -> Text -> ( JS.Prop, JS.Expr )
90(==>) key value =
91 ( JS.IdProp (JS.Id key)
92 , JS.String value
93 )