git.iko.soy/elk
on 40aafc6 help sign in
elk/src/Generate/JavaScript/Effects.hs
82 lines 2.2 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 ((<>))
12import Data.Text (Text)
14import qualified AST.Effects as Effects
15import qualified AST.Module.Name as ModuleName
16import qualified AST.Variable as Var
17import qualified Elm.Package as Pkg
18import qualified Generate.JavaScript.Builder as JS
19import qualified Generate.JavaScript.BuiltIn as BuiltIn
20import qualified Generate.JavaScript.Variable as Var
24-- GENERATE
27generate :: Map.Map ModuleName.Canonical Effects.ManagerType -> Var.Generator BS.Builder
28generate managers =
29 let
30 add home mngr makeBuilder =
31 do builder <- makeBuilder
32 stmt <- generateManager home mngr
33 return (JS.stmtToBuilder stmt <> builder)
34 in
35 Map.foldrWithKey' add (return "") managers
38generateManager :: ModuleName.Canonical -> Effects.ManagerType -> Var.Generator JS.Stmt
39generateManager home manager =
40 do managers <- BuiltIn.effectManagers
41 let managerName = JS.String (ModuleName.canonicalToText home)
42 let lValue = JS.LBracket managers managerName
43 entries <- generateEntries home manager
44 return $ JS.ExprStmt (JS.Assign lValue entries)
47generateEntries :: ModuleName.Canonical -> Effects.ManagerType -> Var.Generator JS.Expr
48generateEntries home@(ModuleName.Canonical pkg _) manager =
49 let
50 entry name =
51 do let key = JS.IdProp (JS.Id name)
52 value <- Var.global (Var.Global home name)
53 return ( key, value )
54 in
55 fmap JS.Object $ sequence $
56 [ "pkg" ==> Pkg.toText pkg
57 , entry "init"
58 , entry "onEffects"
59 , entry "onSelfMsg"
60 ]
61 ++
62 case manager of
63 Effects.Cmds ->
64 [ "tag" ==> "cmd"
65 , entry "cmdMap"
66 ]
68 Effects.Subs ->
69 [ "tag" ==> "sub"
70 , entry "subMap"
71 ]
73 Effects.Both ->
74 [ "tag" ==> "fx"
75 , entry "cmdMap"
76 , entry "subMap"
77 ]
80(==>) :: Text -> Text -> Var.Generator ( JS.Prop, JS.Expr )
81(==>) key value =
82 return ( JS.IdProp (JS.Id key), JS.String value )