git.iko.soy/elk
on c5b225d help sign in
elk/src/Generate/JavaScript/Foreign.hs
234 lines 5.6 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)
159field :: String -> Opt.Expr -> Opt.Expr
160field name decoder =
161 to "field" <== [ Opt.Literal (Literal.Str name), decoder ]
164index :: Int -> Opt.Expr -> Opt.Expr
165index index decoder =
166 to "index" <== [ Opt.Literal (Literal.IntNum index), decoder ]
169(<==) :: Opt.Expr -> [Opt.Expr] -> Opt.Expr
170(<==) func args =
171 Opt.Call func args
175-- COMPLEX DECODE HELPERS
178toMaybe :: T.Canonical -> Opt.Expr
179toMaybe tipe =
180 let
181 maybe tag =
182 Opt.Var (Var.inCore ["Maybe"] tag)
183 in
184 to "oneOf" <==
185 [ Opt.List
186 [ to "null" <== [ maybe "Nothing" ]
187 , to "map" <== [ maybe "Just", decode tipe ]
188 ]
189 ]
192toTuple0 :: Opt.Expr
193toTuple0 =
194 to "null" <== [ Opt.Ctor "_Tuple0" [] ]
197toTuple :: [T.Canonical] -> Opt.Expr
198toTuple types =
199 let
200 size =
201 length types
203 pairs =
204 zipWith (,) [ 0 .. size - 1] types
206 toVar i =
207 'x' : show i
209 makeTuple =
210 to "succeed" <==
211 [ Opt.Ctor
212 ("_Tuple" ++ show size)
213 (map (Opt.Var . Var.local . toVar . fst) pairs)
214 ]
216 andThen (i, tipe) decoder =
217 to "andThen" <== [ Opt.Function [toVar i] decoder, index i (decode tipe) ]
218 in
219 List.foldr andThen makeTuple pairs
222toRecord :: [(String, T.Canonical)] -> Opt.Expr
223toRecord fields =
224 let
225 toFieldExpr (key, _) =
226 (key, Opt.Var (Var.local key))
228 finalDecoder =
229 to "succeed" <== [ Opt.Record (map toFieldExpr fields) ]
231 andThen (key, tipe) decoder =
232 to "andThen" <== [ Opt.Function [key] decoder, field key (decode tipe) ]
233 in
234 List.foldr andThen finalDecoder fields