@@ -1,4 +1,4 @@
1−module Generate.JavaScript.Foreign (incoming, outgoing) where
1+module Generate.JavaScript.Foreign (input, output) where
22
33import qualified Data.List as List
44import Generate.JavaScript.Helpers
@@ -57,28 +57,42 @@ check x jsType continue =
5757 JSBoolean -> [typeof "boolean"]
5858 JSString -> [typeof "string", instanceof "String"]
5959 JSArray -> [instanceof "Array"]
60− JSObject fields -> [jsFold OpLAnd (typeof "object" : map member fields)]
60+ JSObject fields ->
61+ [jsFold OpLAnd (typeof "object" : map member fields)]
6162
6263
63−incoming :: CanonicalType -> Expression ()
64−incoming tipe =
65− case tipe of
66− Aliased _ t -> incoming t
64+-- INPUT
65+
66+input :: String -> CanonicalType -> Expression ()
67+input name tipe =
68+ case T.dealias tipe of
69+ App (Type signal) [t]
70+ | Var.isStream signal ->
71+ obj ["_P","inputStream"] <| toTypeFunction t
72+
73+ | Var.isVarying signal ->
74+ obj ["_P","inputVarying"] <| toTypeFunction t
75+
76+ dealiasedType ->
77+ obj ["_P","inputValue"] <| toTypeFunction dealiasedType
6778
68− App (Type v) [t]
69− | Var.isSignal v ->
70− obj ["_P","incomingSignal"] <| incoming t
7179
72− _ -> ["v"] ==> inc tipe (ref "v")
80+toTypeFunction :: CanonicalType -> Expression ()
81+toTypeFunction tipe =
82+ ["v"] ==> toType tipe (ref "v")
7383
7484
75−inc :: CanonicalType -> Expression () -> Expression ()
76−inc tipe x =
85+toType :: CanonicalType -> Expression () -> Expression ()
86+toType tipe x =
7787 case tipe of
78− Lambda _ _ -> error "functions should not be allowed through input ports"
79− Var _ -> error "type variables should not be allowed through input ports"
88+ Lambda _ _ ->
89+ error "functions should not be allowed through input ports"
90+
91+ Var _ ->
92+ error "type variables should not be allowed through input ports"
93+
8094 Aliased _ t ->
81− inc t x
95+ toType t x
8296
8397 Type (Var.Canonical Var.BuiltIn name)
8498 | name == "Int" -> from JSNumber
@@ -93,10 +107,10 @@ inc tipe x =
93107 x
94108
95109 | Var.isTuple name ->
96− incomingTuple [] x
110+ toTuple [] x
97111
98112 | otherwise ->
99− error "bad type got to incoming port generation code"
113+ error "bad type got to foreign input conversion"
100114
101115 App f args ->
102116 case f : args of
@@ -105,7 +119,7 @@ inc tipe x =
105119 CondExpr ()
106120 (equal x (NullLit ()))
107121 (_Maybe "Nothing")
108− (_Maybe "Just" <| inc t x)
122+ (_Maybe "Just" <| toType t x)
109123
110124 | Var.isList name ->
111125 check x JSArray (_List "fromArray" <| array)
@@ -113,92 +127,95 @@ inc tipe x =
113127 | Var.isArray name ->
114128 check x JSArray (_Array "fromJSArray" <| array)
115129 where
116− array = DotRef () x (var "map") <| incoming t
130+ array = DotRef () x (var "map") <| toTypeFunction t
117131
118132 Type name : ts
119− | Var.isTuple name -> incomingTuple ts x
133+ | Var.isTuple name ->
134+ toTuple ts x
120135
121− _ -> error "bad ADT got to incoming port generation code"
136+ _ -> error "bad ADT got to foreign input conversion"
122137
123138 Record _ (Just _) ->
124− error "bad record got to incoming port generation code"
139+ error "bad record got to foreign input conversion"
125140
126141 Record fields Nothing ->
127142 check x (JSObject (map fst fields)) object
128143 where
129144 object = ObjectLit () $ (prop "_", ObjectLit () []) : keys
130145 keys = map convert fields
131− convert (f,t) = (prop f, inc t (DotRef () x (var f)))
146+ convert (f,t) = (prop f, toType t (DotRef () x (var f)))
132147
133148
134−incomingTuple :: [CanonicalType] -> Expression () -> Expression ()
135−incomingTuple types x =
149+toTuple :: [CanonicalType] -> Expression () -> Expression ()
150+toTuple types x =
136151 check x JSArray (ObjectLit () fields)
137152 where
138− fields = (prop "ctor", ctor) : zipWith convert [0..] types
153+ fields =
154+ (prop "ctor", ctor) : zipWith convert [0..] types
139155
140− ctor = string ("_Tuple" ++ show (length types))
156+ ctor =
157+ string ("_Tuple" ++ show (length types))
141158
142159 convert n t =
143160 ( prop ('_':show n)
144− , inc t (BracketRef () x (IntLit () n))
161+ , toType t (BracketRef () x (IntLit () n))
145162 )
146163
147164
148−outgoing :: CanonicalType -> Expression ()
149−outgoing tipe =
150− case T.dealias tipe of
151− App (Type signal) [ App (Type promise) [_,_] ]
152− | Var.isSignal signal && Var.isPromise promise ->
153− obj ["_P","promiseStream"]
165+-- OUTPUT
154166
155− App (Type promise) [_,_]
156− | Var.isPromise promise ->
157− obj ["_P","promise"]
167+output :: String -> CanonicalType -> Expression () -> Expression ()
168+output name tipe value =
169+ case T.dealias tipe of
170+ App (Type signal) [t]
171+ | Var.isStream signal ->
172+ obj ["_P","outputStream"] `call` [ fromTypeFunction t, value ]
158173
159− _ ->
160− outgoingFunc tipe
174+ | Var.isVarying signal ->
175+ obj ["_P","outputVarying"] `call` [ fromTypeFunction t, value ]
161176
177+ dealiasedType ->
178+ obj ["_P","outputValue"] `call` [ fromTypeFunction dealiasedType, value ]
162179
163−outgoingFunc :: CanonicalType -> Expression ()
164−outgoingFunc tipe =
165− case tipe of
166− App (Type v) [t]
167− | Var.isSignal v ->
168− obj ["_P","outgoingSignal"] <| outgoingFunc t
169180
170− _ -> ["v"] ==> out tipe (ref "v")
181+fromTypeFunction :: CanonicalType -> Expression ()
182+fromTypeFunction tipe =
183+ ["v"] ==> fromType tipe (ref "v")
171184
172185
173−out :: CanonicalType -> Expression () -> Expression ()
174−out tipe x =
186+fromType :: CanonicalType -> Expression () -> Expression ()
187+fromType tipe x =
175188 case tipe of
176− Aliased _ t -> out t x
189+ Aliased _ t ->
190+ fromType t x
177191
178192 Lambda _ _
179193 | numArgs > 1 && numArgs < 10 ->
180194 func (ref ('A':show numArgs) `call` (x:values))
181− | otherwise -> func (foldl (<|) x values)
195+ | otherwise ->
196+ func (foldl (<|) x values)
182197 where
183198 ts = T.collectLambdas tipe
184199 numArgs = length ts - 1
185200 args = map (\n -> '_' : show n) [0..]
186− values = zipWith inc (init ts) (map ref args)
201+ values = zipWith toType (init ts) (map ref args)
187202 func body =
188203 function (take numArgs args)
189204 [ VarDeclStmt () [VarDecl () (var "_r") (Just body)]
190− , ret (out (last ts) (ref "_r"))
205+ , ret (fromType (last ts) (ref "_r"))
191206 ]
192207
193− Var _ -> error "type variables should not be allowed through input ports"
208+ Var _ ->
209+ error "type variables should not be allowed through outputs"
194210
195211 Type (Var.Canonical Var.BuiltIn name)
196− | name `elem` ["Int","Float","Bool","String"] -> x
212+ | name `elem` ["Int","Float","Bool","String"] ->
213+ x
197214
198215 Type name
199216 | Var.isJson name -> x
200217 | Var.isTuple name -> ArrayLit () []
201− | otherwise -> error "bad type got to outgoing port generation code"
218+ | otherwise -> error "bad type got to an output"
202219
203220 App f args ->
204221 case f : args of
@@ -207,26 +224,27 @@ out tipe x =
207224 CondExpr ()
208225 (equal (DotRef () x (var "ctor")) (string "Nothing"))
209226 (NullLit ())
210− (out t (DotRef () x (var "_0")))
227+ (fromType t (DotRef () x (var "_0")))
211228
212229 | Var.isArray name ->
213− DotRef () (_Array "toJSArray" <| x) (var "map") <| outgoingFunc t
230+ DotRef () (_Array "toJSArray" <| x) (var "map") <| fromTypeFunction t
214231
215232 | Var.isList name ->
216− DotRef () (_List "toArray" <| x) (var "map") <| outgoingFunc t
233+ DotRef () (_List "toArray" <| x) (var "map") <| fromTypeFunction t
217234
218235 Type name : ts
219236 | Var.isTuple name ->
220− let convert n t = out t $ DotRef () x $ var ('_':show n)
237+ let convert n t = fromType t $ DotRef () x $ var ('_':show n)
221238 in ArrayLit () $ zipWith convert [0..] ts
222239
223− _ -> error "bad ADT got to outgoing port generation code"
240+ _ -> error "bad ADT got to an output"
224241
225242 Record _ (Just _) ->
226− error "bad record got to outgoing port generation code"
243+ error "bad record got to an output"
227244
228245 Record fields Nothing ->
229246 ObjectLit () keys
230− where
231− keys = map convert fields
232− convert (f,t) = (PropId () (var f), out t (DotRef () x (var f)))
247+ where
248+ keys = map convert fields
249+ convert (f,t) =
250+ (PropId () (var f), fromType t (DotRef () x (var f)))