Allow Json.Value through ports

elm · Mar 28, 2014 · 32b7c18 · 32b7c18
1 parent dfd14a1
commit 32b7c18
Show file tree

Hide file tree

Showing 3 changed files with 14 additions and 5 deletions.
diff --git a/compiler/Generate/JavaScript/Ports.hs b/compiler/Generate/JavaScript/Ports.hs
@@ -35,6 +35,10 @@ inc tipe x =
     case tipe of
       Lambda _ _ -> error "functions should not be allowed through input ports"
       Var _ -> error "type variables should not be allowed through input ports"
+
+      Data "Json.Value" [] ->
+          obj "Native.Json.fromJS" <| x
+
       Data ctor []
           | ctor == "Int"       -> from JSNumber
           | ctor == "Float"     -> from JSNumber
@@ -100,8 +104,9 @@ out tipe x =
 
       Var _ -> error "type variables should not be allowed through input ports"
       Data ctor []
-          | ctor `elem` ["Int","Float","Bool","String"] ->
-              x
+          | ctor `elem` ["Int","Float","Bool","String"] -> x
+          | ctor == "Json.Value" ->
+              obj "Native.Json.toJS" <| x
 
       Data ctor [t]
           | ctor == "Maybe.Maybe" ->

diff --git a/compiler/Metadata/Prelude.hs b/compiler/Metadata/Prelude.hs
@@ -25,7 +25,9 @@ prelude = string ++ text ++ map (\n -> (n, Hiding [])) modules
     text = map ((,) "Text") [ As "Text", Hiding ["link", "color", "height"] ]
     string = map ((,) "String") [ As "String", Importing ["show"] ]
     modules = [ "Basics", "Signal", "List", "Maybe", "Time", "Color"
-              , "Graphics.Element", "Graphics.Collage", "Native.Ports" ]
+              , "Graphics.Element", "Graphics.Collage"
+              , "Native.Ports", "Native.Json"
+              ]
 
 interfaces :: Bool -> IO Interfaces
 interfaces noPrelude =

diff --git a/compiler/Type/ExtraChecks.hs b/compiler/Type/ExtraChecks.hs
@@ -59,9 +59,11 @@ portTypes rules expr =
               | ctor == "Signal.Signal" -> handleSignal ts
               | otherwise               -> err' True "an unsupported type"
               where
+                primitives =
+                    ["Int","Float","String","Bool","Maybe.Maybe","_List","Json.Value"]
+
                 validConstructor =
-                    ctor `elem` ["Int","Float","String","Bool","Maybe.Maybe","_List"]
-                    || Help.isTuple ctor
+                    ctor `elem` primitives || Help.isTuple ctor
 
           ST.Var _ -> err "free type variables"