git.iko.soy/elk
on master help sign in
Allow promises through ports
commit6775458ebc06425ba70c486abaacbc2920c45708 authorEvan Czaplicki <info@elm-lang.org> dateTue 17 Feb 2015, 21:10 (12 years ago) parent68fdeff
4 files changed+64−12
compare with master
unifiedsplit
src/AST/Type.hs+27−1 src/AST/Variable.hs+5 src/Generate/JavaScript/Ports.hs+25−10 src/Type/ExtraChecks.hs+7−1
src/AST/Type.hs+27−1
@@ -1,6 +1,7 @@
11module AST.Type where
22
33import Control.Applicative ((<$>), (<*>))
4+import Control.Arrow (second)
45import Data.Binary
56import qualified Data.Map as Map
67
@@ -30,7 +31,10 @@ type CanonicalType =
3031
3132fieldMap :: [(String,a)] -> Map.Map String [a]
3233fieldMap fields =
33− foldl (\r (field,tipe) -> Map.insertWith (++) field [tipe] r) Map.empty fields
34+ let add r (field,tipe) =
35+ Map.insertWith (++) field [tipe] r
36+ in
37+ foldl add Map.empty fields
3438
3539
3640recordOf :: [(String, Type var)] -> Type var
@@ -50,6 +54,28 @@ tupleOf types =
5054 App (Type name) types
5155
5256
57+dealias :: Type v -> Type v
58+dealias tipe =
59+ case tipe of
60+ Lambda arg body ->
61+ Lambda (dealias arg) (dealias body)
62+
63+ Var _ ->
64+ tipe
65+
66+ Type _ ->
67+ tipe
68+
69+ App f args ->
70+ App (dealias f) (map dealias args)
71+
72+ Record fields ext ->
73+ Record (map (second dealias) fields) (fmap dealias ext)
74+
75+ Aliased _ t ->
76+ dealias t
77+
78+
5379instance (Var.ToString var, Pretty var) => Pretty (Type var) where
5480 pretty tipe =
5581 case tipe of
src/AST/Variable.hs+5
@@ -63,6 +63,11 @@ isSignal =
6363 is ["Signal"] "Signal"
6464
6565
66+isPromise :: Canonical -> Bool
67+isPromise =
68+ is ["Promise"] "Promise"
69+
70+
6671isList :: Canonical -> Bool
6772isList v =
6873 v == Canonical BuiltIn "List"
src/Generate/JavaScript/Ports.hs+25−10
@@ -66,7 +66,8 @@ incoming tipe =
6666 Aliased _ t -> incoming t
6767
6868 App (Type v) [t]
69− | Var.isSignal v -> obj ["_P","incomingSignal"] <| incoming t
69+ | Var.isSignal v ->
70+ obj ["_P","incomingSignal"] <| incoming t
7071
7172 _ -> ["v"] ==> inc tipe (ref "v")
7273
@@ -124,10 +125,10 @@ inc tipe x =
124125
125126 Record fields Nothing ->
126127 check x (JSObject (map fst fields)) object
127− where
128− object = ObjectLit () $ (prop "_", ObjectLit () []) : keys
129− keys = map convert fields
130− convert (f,t) = (prop f, inc t (DotRef () x (var f)))
128+ where
129+ object = ObjectLit () $ (prop "_", ObjectLit () []) : keys
130+ keys = map convert fields
131+ convert (f,t) = (prop f, inc t (DotRef () x (var f)))
131132
132133
133134incomingTuple :: [CanonicalType] -> Expression () -> Expression ()
@@ -146,11 +147,25 @@ incomingTuple types x =
146147
147148outgoing :: CanonicalType -> Expression ()
148149outgoing tipe =
149− case tipe of
150− Aliased _ t -> outgoing t
150+ case T.dealias tipe of
151+ App (Type signal) [ App (Type promise) [_,_] ]
152+ | Var.isSignal signal && Var.isPromise promise ->
153+ obj ["_P","promiseStream"]
154+
155+ App (Type promise) [_,_]
156+ | Var.isPromise promise ->
157+ obj ["_P","promise"]
151158
159+ _ ->
160+ outgoingFunc tipe
161+
162+
163+outgoingFunc :: CanonicalType -> Expression ()
164+outgoingFunc tipe =
165+ case tipe of
152166 App (Type v) [t]
153− | Var.isSignal v -> obj ["_P","outgoingSignal"] <| outgoing t
167+ | Var.isSignal v ->
168+ obj ["_P","outgoingSignal"] <| outgoingFunc t
154169
155170 _ -> ["v"] ==> out tipe (ref "v")
156171
@@ -195,10 +210,10 @@ out tipe x =
195210 (out t (DotRef () x (var "_0")))
196211
197212 | Var.isArray name ->
198− DotRef () (_Array "toJSArray" <| x) (var "map") <| outgoing t
213+ DotRef () (_Array "toJSArray" <| x) (var "map") <| outgoingFunc t
199214
200215 | Var.isList name ->
201− DotRef () (_List "toArray" <| x) (var "map") <| outgoing t
216+ DotRef () (_List "toArray" <| x) (var "map") <| outgoingFunc t
202217
203218 Type name : ts
204219 | Var.isTuple name ->
src/Type/ExtraChecks.hs+7−1
@@ -93,6 +93,12 @@ portTypes expr =
9393 | V.isArray v -> valid t
9494 | V.isList v -> valid t
9595
96+ ST.App (ST.Type v) [_, _]
97+ | V.isPromise v ->
98+ case direction of
99+ In -> err "promises"
100+ Out -> return ()
101+
96102 ST.App (ST.Type v) ts
97103 | V.isTuple v -> mapM_ valid ts
98104
@@ -135,7 +141,7 @@ portTypes expr =
135141 , P.nest 4 (PP.pretty tipe) <> P.text "\n"
136142 , txt [ "Acceptable values for ", dir "incoming" "outgoing", " ports include:" ]
137143 , txt [ " Ints, Floats, Bools, Strings, Maybes, Lists, Arrays, Tuples, unit values," ]
138− , txt [ " Json.Values, ", dir "" "first-order functions, ", "and concrete records." ]
144+ , txt [ " Json.Values, ", dir "" "first-order functions, promises, ", "and concrete records." ]
139145 ]
140146
141147