@@ -6,14 +6,29 @@ import qualified SourceSyntax.Helpers as Help
66import SourceSyntax.Type
77import Language.ECMAScript3.Syntax
88
9−check :: a -> [a -> Expression ()] -> Expression () -> Expression ()
10−check x checks continue =
11− CondExpr () (foldl1 (InfixExpr () OpLOr) (map ($x) checks)) continue throw
9+data JSType = JSNumber | JSBoolean | JSString | JSArray | JSObject [String]
10+ deriving Show
11+
12+check :: Expression () -> JSType -> Expression () -> Expression ()
13+check x jsType continue =
14+ CondExpr () (jsFold OpLOr checks x) continue throw
1215 where
13− throw = obj "_E.raise" <| string "invalid input to port"
16+ jsFold op checks value = foldl1 (InfixExpr () op) (map ($value) checks)
17+ throw = obj "_E.raise" <| InfixExpr () OpAdd msg x
18+ msg = string ("invalid input, expecting " ++ show jsType ++ " but got ")
19+ checks = case jsType of
20+ JSNumber -> [typeof "number"]
21+ JSBoolean -> [typeof "boolean"]
22+ JSString -> [typeof "string", instanceof "String"]
23+ JSArray -> [instanceof "Array"]
24+ JSObject fields -> [jsFold OpLAnd (typeof "object" : map member fields)]
1425
1526incoming :: Type -> Expression ()
16−incoming t = ["v"] ==> go t (ref "v")
27+incoming tipe =
28+ case tipe of
29+ Data "Signal.Signal" [t] ->
30+ obj "Native.Ports.incomingSignal" <| incoming t
31+ _ -> ["v"] ==> go tipe (ref "v")
1732 where
1833 go :: Type -> Expression () -> Expression ()
1934 go tipe x =
@@ -21,15 +36,15 @@ incoming t = ["v"] ==> go t (ref "v")
2136 Lambda _ _ -> error "functions should not be allowed through input ports"
2237 Var _ -> error "type variables should not be allowed through input ports"
2338 Data ctor []
24− | ctor == "Int" -> elm "Int" [typeof "number"]
25− | ctor == "Float" -> elm "Float" [typeof "number"]
26− | ctor == "Bool" -> elm "Bool" [typeof "boolean"]
27− | ctor == "String" -> elm "String" [typeof "string", instanceof "String"]
28− | ctor == "JavaScript.JSNumber" -> js [typeof "number"]
29− | ctor == "JavaScript.JSBool" -> js [typeof "boolean"]
30− | ctor == "JavaScript.JSString" -> js [typeof "string", instanceof "String"]
39+ | ctor == "Int" -> elm JSNumber
40+ | ctor == "Float" -> elm JSNumber
41+ | ctor == "Bool" -> elm JSBoolean
42+ | ctor == "String" -> elm JSString
43+ | ctor == "JavaScript.JSNumber" -> js JSNumber
44+ | ctor == "JavaScript.JSBool" -> js JSBoolean
45+ | ctor == "JavaScript.JSString" -> js JSString
3146 where
32− elm out checks = check x checks (obj ("_J.to" ++ out) <| x)
47+ elm checks = check x checks (obj ("_J.to" ++ ctor) <| x)
3348 js checks = check x checks x
3449
3550 Data ctor [t]
@@ -38,15 +53,12 @@ incoming t = ["v"] ==> go t (ref "v")
3853 (obj "Maybe.Nothing")
3954 (obj "Maybe.Just" <| go t x)
4055
41− | ctor == "Signal.Signal" ->
42− obj "Native.Ports.incomingSignal" <| incoming t
43−
4456 | ctor == "_List" ->
45− check x [instanceof "Array"] (obj "_J.toList" <| array)
57+ check x JSArray (obj "_J.toList" <| array)
4658 where
4759 array = DotRef () x (var "map") <| incoming t
4860
49− Data ctor ts | Help.isTuple ctor -> check x [instanceof "Array"] tuple
61+ Data ctor ts | Help.isTuple ctor -> check x JSArray tuple
5062 where
5163 tuple = ObjectLit () $ (PropId () (var "ctor"), string ctor) : values
5264 values = zipWith convert [0..] ts
@@ -57,14 +69,17 @@ incoming t = ["v"] ==> go t (ref "v")
5769
5870 Record _ (Just _) -> error "bad record got to port generation code"
5971
60− Record fields Nothing ->
61− check x (typeof "object" : map (member . fst) fields) object
72+ Record fields Nothing -> check x (JSObject (map fst fields)) object
6273 where
6374 object = ObjectLit () $ (PropId () (var "_"), ObjectLit () []) : keys
6475 keys = map convert fields
6576 convert (f,t) = (PropId () (var f), go t (DotRef () x (var f)))
6677
67−outgoing t = ["v"] ==> go t (ref "v")
78+outgoing tipe =
79+ case tipe of
80+ Data "Signal.Signal" [t] ->
81+ obj "Native.Ports.outgoingSignal" <| outgoing t
82+ _ -> ["v"] ==> go tipe (ref "v")
6883 where
6984 go :: Type -> Expression () -> Expression ()
7085 go tipe x =
@@ -83,11 +98,8 @@ outgoing t = ["v"] ==> go t (ref "v")
8398 (NullLit ())
8499 (DotRef () x (var "_0"))
85100
86− | ctor == "Signal.Signal" ->
87− obj "Native.Ports.outgoingSignal" <| incoming t
88−
89101 | ctor == "_List" ->
90− DotRef () (obj "_J.fromList" <| x) (var "map") <| incoming t
102+ DotRef () (obj "_J.fromList" <| x) (var "map") <| outgoing t
91103
92104 Data ctor ts | Help.isTuple ctor ->
93105 ArrayLit () $ zipWith convert [0..] ts