git.iko.soy/elk
on 8a89c86 help sign in
elk/src/Generate/JavaScript/Effects.hs
69 lines 2.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Effects
4 ( generate
5 )
6 where
9import qualified Data.ByteString.Builder as BS
10import qualified Data.Map as Map
11import Data.Monoid ((<>))
13import qualified AST.Effects as Effects
14import qualified AST.Module.Name as ModuleName
15import qualified AST.Variable as Var
16import qualified Generate.JavaScript.Builder as JS
17import qualified Generate.JavaScript.BuiltIn as BuiltIn
18import qualified Generate.JavaScript.Variable as Var
22-- GENERATE
25generate :: Map.Map ModuleName.Canonical Effects.ManagerType -> Var.Generator BS.Builder
26generate managers =
27 let
28 add home mngr makeBuilder =
29 do builder <- makeBuilder
30 stmt <- generateManager home mngr
31 return (JS.stmtToBuilder stmt <> builder)
32 in
33 Map.foldrWithKey' add (return "") managers
36generateManager :: ModuleName.Canonical -> Effects.ManagerType -> Var.Generator JS.Stmt
37generateManager home manager =
38 do managers <- BuiltIn.effectManagers
39 let managerName = JS.String (ModuleName.canonicalToText home)
40 let lValue = JS.LBracket managers managerName
41 entries <- generateEntries home manager
42 return $ JS.ExprStmt (JS.Assign lValue entries)
45generateEntries :: ModuleName.Canonical -> Effects.ManagerType -> Var.Generator JS.Expr
46generateEntries home manager =
47 let
48 arg name =
49 Var.global (Var.Global home name)
51 makeArgs =
52 case manager of
53 Effects.Cmds ->
54 [ arg "init", arg "onEffects", arg "onSelfMsg", arg "cmdMap" ]
56 Effects.Subs ->
57 [ arg "init", arg "onEffects", arg "onSelfMsg", pure (JS.Int 0), arg "subMap" ]
59 Effects.Both ->
60 [ arg "init", arg "onEffects", arg "onSelfMsg", arg "cmdMap", arg "subMap" ]
61 in
62 JS.Call
63 <$> Var.global createManager
64 <*> sequence makeArgs
67createManager :: Var.Global
68createManager =
69 Var.Global (ModuleName.inCore "Elm.Kernel.Platform") "createManager"