git.iko.soy/elk
on c5da7c0 help sign in
elk/src/Generate/JavaScript/Foreign.hs
240 lines 5.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Generate.JavaScript.Foreign (encode, decode) where
5import Prelude hiding (maybe)
6import qualified Data.List as List
7import qualified Data.Text as Text
8import Data.Text (Text)
10import qualified AST.Expression.Optimized as Opt
11import qualified AST.Literal as Literal
12import qualified AST.Type as T
13import qualified AST.Variable as Var
14import qualified Generate.JavaScript.Builder as JS
15import qualified Generate.JavaScript.Helpers as JS (function, ref)
16import qualified Generate.JavaScript.Variable as Var
17import Generate.JavaScript.Helpers ((<|), (==>))
21-- ENCODE
24encode :: T.Canonical -> JS.Expr
25encode tipe =
26 JS.function ["v"] [ JS.Return (Just (encodeHelp tipe (JS.ref "v"))) ]
29encodeHelp :: T.Canonical -> JS.Expr -> JS.Expr
30encodeHelp tipe expr =
31 case tipe of
32 T.Aliased _ args t ->
33 encodeHelp (T.dealias args t) expr
35 T.Lambda _ _ ->
36 error "encodeHelp: function"
38 T.Var _ ->
39 error "encodeHelp: type variable"
41 T.Type name
42 | Var.isPrim "Float" name -> expr
43 | Var.isPrim "Int" name -> expr
44 | Var.isPrim "Bool" name -> expr
45 | Var.isPrim "String" name -> expr
46 | Var.isJson name -> expr
47 | Var.isTuple name -> JS.Null
48 | otherwise -> error "encodeHelp: bad type"
50 T.App (T.Type name) [arg]
51 | Var.isMaybe name -> fromMaybe arg expr
52 | Var.isList name -> fromList arg expr
53 | Var.isArray name -> fromArray arg expr
54 | otherwise -> error "encodeHelp: bad union type"
56 T.App (T.Type name) args
57 | Var.isTuple name -> fromTuple args expr
59 T.App _ _ ->
60 error "encodeHelp: bad union type"
62 T.Record _ (Just _) ->
63 error "encodeHelp: bad record"
65 T.Record fields Nothing ->
66 let
67 convert (k, t) =
68 k ==> encodeHelp t (JS.DotRef expr (JS.Id k))
69 in
70 JS.Object (map convert fields)
73fromMaybe :: T.Canonical -> JS.Expr -> JS.Expr
74fromMaybe tipe expr =
75 JS.If
76 (JS.Infix JS.OpStrictEq (JS.DotRef expr (JS.Id "ctor")) (JS.String "Nothing"))
77 (JS.Null)
78 (encodeHelp tipe (JS.DotRef expr (JS.Id "_0")))
81fromList :: T.Canonical -> JS.Expr -> JS.Expr
82fromList tipe expr =
83 let
84 array =
85 Var.coreNative "List" "toArray" <| expr
86 in
87 JS.DotRef array (JS.Id "map") <| encode tipe
90fromArray :: T.Canonical -> JS.Expr -> JS.Expr
91fromArray tipe expr =
92 let
93 array =
94 Var.coreNative "Array" "toJSArray" <| expr
95 in
96 JS.DotRef array (JS.Id "map") <| encode tipe
99fromTuple :: [T.Canonical] -> JS.Expr -> JS.Expr
100fromTuple types expr =
101 let
102 convert subType n =
103 encodeHelp subType $ JS.DotRef expr (JS.Id (Text.pack ('_':show n)))
104 in
105 JS.Array (zipWith convert types [ 0 .. length types ])
109-- SUBSCRIPTIONS
112decode :: T.Canonical -> Opt.Expr
113decode tipe =
114 case tipe of
115 T.Lambda _ _ ->
116 error "functions should not be allowed through input ports"
118 T.Var _ ->
119 error "type variables should not be allowed through input ports"
121 T.Aliased _ args t ->
122 decode (T.dealias args t)
124 T.Type name
125 | Var.isPrim "Float" name -> to "float"
126 | Var.isPrim "Int" name -> to "int"
127 | Var.isPrim "Bool" name -> to "bool"
128 | Var.isPrim "String" name -> to "string"
129 | Var.isJson name -> to "value"
130 | Var.isTuple name -> toTuple0
131 | otherwise -> error "decode: bad type"
133 T.App (T.Type name) [arg]
134 | Var.isMaybe name -> toMaybe arg
135 | Var.isList name -> to "list" <== [decode arg]
136 | Var.isArray name -> to "array" <== [decode arg]
137 | otherwise -> error "decode: bad union type"
139 T.App (T.Type name) args
140 | Var.isTuple name -> toTuple args
142 T.App _ _ ->
143 error "decode: bad union type"
145 T.Record _ (Just _) ->
146 error "decode: bad record"
148 T.Record fields Nothing ->
149 toRecord fields
152-- DECODE HELPERS
155inJsonDecode :: Text -> Var.Canonical
156inJsonDecode name =
157 Var.inCore "Json.Decode" name
160to :: Text -> Opt.Expr
161to name =
162 Opt.Var (inJsonDecode name)
165field :: Text -> Opt.Expr -> Opt.Expr
166field name decoder =
167 to "field" <== [ Opt.Literal (Literal.Str name), decoder ]
170index :: Int -> Opt.Expr -> Opt.Expr
171index i decoder =
172 to "index" <== [ Opt.Literal (Literal.IntNum i), decoder ]
175(<==) :: Opt.Expr -> [Opt.Expr] -> Opt.Expr
176(<==) func args =
177 Opt.Call func args
181-- COMPLEX DECODE HELPERS
184toMaybe :: T.Canonical -> Opt.Expr
185toMaybe tipe =
186 let
187 maybe tag =
188 Opt.Var (Var.inCore "Maybe" tag)
189 in
190 to "oneOf" <==
191 [ Opt.List
192 [ to "null" <== [ maybe "Nothing" ]
193 , to "map" <== [ maybe "Just", decode tipe ]
194 ]
195 ]
198toTuple0 :: Opt.Expr
199toTuple0 =
200 to "null" <== [ Opt.Ctor "_Tuple0" [] ]
203toTuple :: [T.Canonical] -> Opt.Expr
204toTuple types =
205 let
206 size =
207 length types
209 pairs =
210 zipWith (,) [ 0 .. size - 1] types
212 toVar i =
213 Text.pack ('x' : show i)
215 makeTuple =
216 to "succeed" <==
217 [ Opt.Ctor
218 (Text.pack ("_Tuple" ++ show size))
219 (map (Opt.Var . Var.local . toVar . fst) pairs)
220 ]
222 andThen (i, tipe) decoder =
223 to "andThen" <== [ Opt.Function [toVar i] decoder, index i (decode tipe) ]
224 in
225 List.foldr andThen makeTuple pairs
228toRecord :: [(Text, T.Canonical)] -> Opt.Expr
229toRecord fields =
230 let
231 toFieldExpr (key, _) =
232 (key, Opt.Var (Var.local key))
234 finalDecoder =
235 to "succeed" <== [ Opt.Record (map toFieldExpr fields) ]
237 andThen (key, tipe) decoder =
238 to "andThen" <== [ Opt.Function [key] decoder, field key (decode tipe) ]
239 in
240 List.foldr andThen finalDecoder fields