git.iko.soy/elk
on 5b5230c help sign in
elk/src/Generate/JavaScript/Foreign.hs
219 lines 5.3 kB history raw
1module Generate.JavaScript.Foreign (encode, decode) where
3import qualified Data.List as List
4import Language.ECMAScript3.Syntax
6import qualified AST.Expression.Optimized as Opt
7import qualified AST.Literal as Literal
8import qualified AST.Type as T
9import qualified AST.Variable as Var
10import Generate.JavaScript.Helpers ((<|), (==>), function, ref, var)
11import qualified Generate.JavaScript.Variable as Var
15-- ENCODE
18encode :: T.Canonical -> Expression ()
19encode tipe =
20 function ["v"] [ ReturnStmt () (Just (encodeHelp tipe (ref "v"))) ]
23encodeHelp :: T.Canonical -> Expression () -> Expression ()
24encodeHelp tipe expr =
25 case tipe of
26 T.Aliased _ args t ->
27 encodeHelp (T.dealias args t) expr
29 T.Lambda _ _ ->
30 error "encodeHelp: function"
32 T.Var _ ->
33 error "encodeHelp: type variable"
35 T.Type name
36 | Var.isPrim "Float" name -> expr
37 | Var.isPrim "Int" name -> expr
38 | Var.isPrim "Bool" name -> expr
39 | Var.isPrim "String" name -> expr
40 | Var.isJson name -> expr
41 | Var.isTuple name -> NullLit ()
42 | otherwise -> error "encodeHelp: bad type"
44 T.App (T.Type name) [arg]
45 | Var.isMaybe name -> fromMaybe arg expr
46 | Var.isList name -> fromList arg expr
47 | Var.isArray name -> fromArray arg expr
48 | otherwise -> error "encodeHelp: bad union type"
50 T.App (T.Type name) args
51 | Var.isTuple name -> fromTuple args expr
53 T.App _ _ ->
54 error "encodeHelp: bad union type"
56 T.Record _ (Just _) ->
57 error "encodeHelp: bad record"
59 T.Record fields Nothing ->
60 let
61 convert (name, tipe) =
62 name ==> encodeHelp tipe (DotRef () expr (var name))
63 in
64 ObjectLit () (map convert fields)
67fromMaybe :: T.Canonical -> Expression () -> Expression ()
68fromMaybe tipe expr =
69 CondExpr ()
70 (InfixExpr () OpStrictEq (DotRef () expr (var "ctor")) (StringLit () "Nothing"))
71 (NullLit ())
72 (encodeHelp tipe (DotRef () expr (var "_0")))
75fromList :: T.Canonical -> Expression () -> Expression ()
76fromList tipe expr =
77 let
78 array =
79 Var.coreNative "List" "toArray" <| expr
80 in
81 DotRef () array (var "map") <| encode tipe
84fromArray :: T.Canonical -> Expression () -> Expression ()
85fromArray tipe expr =
86 let
87 array =
88 Var.coreNative "Array" "toJSArray" <| expr
89 in
90 DotRef () array (var "map") <| encode tipe
93fromTuple :: [T.Canonical] -> Expression () -> Expression ()
94fromTuple types expr =
95 let
96 convert subType n =
97 encodeHelp subType $ DotRef () expr (var ('_':show n))
98 in
99 ArrayLit () (zipWith convert types [0..])
103-- SUBSCRIPTIONS
106decode :: T.Canonical -> Opt.Expr
107decode tipe =
108 case tipe of
109 T.Lambda _ _ ->
110 error "functions should not be allowed through input ports"
112 T.Var _ ->
113 error "type variables should not be allowed through input ports"
115 T.Aliased _ args t ->
116 decode (T.dealias args t)
118 T.Type name
119 | Var.isPrim "Float" name -> to "float"
120 | Var.isPrim "Int" name -> to "int"
121 | Var.isPrim "Bool" name -> to "bool"
122 | Var.isPrim "String" name -> to "string"
123 | Var.isJson name -> to "value"
124 | Var.isTuple name -> toTuple0
125 | otherwise -> error "decode: bad type"
127 T.App (T.Type name) [arg]
128 | Var.isMaybe name -> toMaybe arg
129 | Var.isList name -> to "list" <== [decode arg]
130 | Var.isArray name -> to "array" <== [decode arg]
131 | otherwise -> error "decode: bad union type"
133 T.App (T.Type name) args
134 | Var.isTuple name -> toTuple args
136 T.App _ _ ->
137 error "decode: bad union type"
139 T.Record _ (Just _) ->
140 error "decode: bad record"
142 T.Record fields Nothing ->
143 toRecord fields
146-- DECODE HELPERS
149inJsonDecode :: String -> Var.Canonical
150inJsonDecode name =
151 Var.inCore ["Json","Decode"] name
154to :: String -> Opt.Expr
155to name =
156 Opt.Var (inJsonDecode name)
159(=:) :: String -> Opt.Expr -> Opt.Expr
160(=:) name decoder =
161 Opt.Binop (inJsonDecode ":=") (Opt.Literal (Literal.Str name)) decoder
164(<==) :: Opt.Expr -> [Opt.Expr] -> Opt.Expr
165(<==) func args =
166 Opt.Call func args
170-- COMPLEX DECODE HELPERS
173toMaybe :: T.Canonical -> Opt.Expr
174toMaybe tipe =
175 let
176 maybe tag =
177 Opt.Var (Var.inCore ["Maybe"] tag)
178 in
179 to "oneOf" <==
180 [ Opt.ExplicitList
181 [ to "null" <== [ maybe "Nothing" ]
182 , to "map" <== [ maybe "Just", decode tipe ]
183 ]
184 ]
187toTuple0 :: Opt.Expr
188toTuple0 =
189 to "null" <== [ Opt.Data "_Tuple0" [] ]
192toTuple :: [T.Canonical] -> Opt.Expr
193toTuple types =
194 let
195 size =
196 length types
198 args =
199 map (\n -> 'x' : show n) [ 1 .. size ]
201 makeTuple =
202 Opt.Function args (Opt.Data ("_Tuple" ++ show size) (map (Opt.Var . Var.local) args))
203 in
204 to ("tuple" ++ show size) <== (makeTuple : map decode types)
207toRecord :: [(String, T.Canonical)] -> Opt.Expr
208toRecord fields =
209 let
210 toFieldExpr (key, _) =
211 (key, Opt.Var (Var.local key))
213 finalDecoder =
214 to "succeed" <== [ Opt.Record (map toFieldExpr fields) ]
216 andThen (key, tipe) decoder =
217 to "andThen" <== [ key =: decode tipe, Opt.Function [key] decoder ]
218 in
219 List.foldr andThen finalDecoder fields