From: jsimomaa <jani.simomaa@gmail.com>
Date: Wed, 13 Dec 2017 08:23:38 +0000 (+0200)
Subject: HTTP/Client SCL module for HTTP requests
X-Git-Tag: v1.43.0~136^2~660
X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=commitdiff_plain;h=refs%2Fchanges%2F18%2F1318%2F2;p=simantics%2Fplatform.git

HTTP/Client SCL module for HTTP requests

Also adding builtin type for Class in SCL

refs #7681

Change-Id: Id794bfce7ff5deb3e13127dfa9107bc31aceef30
---

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/ClassConstant.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/ClassConstant.java
new file mode 100644
index 000000000..c61ef1aeb
--- /dev/null
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/constants/singletons/ClassConstant.java
@@ -0,0 +1,26 @@
+package org.simantics.scl.compiler.constants.singletons;
+
+import org.simantics.scl.compiler.constants.FunctionValue;
+import org.simantics.scl.compiler.internal.codegen.references.Val;
+import org.simantics.scl.compiler.internal.codegen.utils.MethodBuilder;
+import org.simantics.scl.compiler.types.TVar;
+import org.simantics.scl.compiler.types.Type;
+import org.simantics.scl.compiler.types.Types;
+import org.simantics.scl.compiler.types.kinds.Kinds;
+
+public class ClassConstant extends FunctionValue {
+    
+    private static final TVar A = Types.var(Kinds.STAR);
+    public static final ClassConstant INSTANCE = new ClassConstant();
+    
+    private ClassConstant() {
+        super(new TVar[] {A}, Types.NO_EFFECTS, Types.apply(Types.CLASS, A), 
+                Types.pred(Types.VEC_COMP, A));
+    }
+    
+    @Override
+    public Type applyExact(MethodBuilder mb, Val[] parameters) {
+        mb.push(parameters[0], Types.CLASS);
+        return getReturnType();
+    }
+}
\ No newline at end of file
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/Builtins.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/Builtins.java
index e3b429133..5004bc055 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/Builtins.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/java/Builtins.java
@@ -15,6 +15,7 @@ import org.simantics.scl.compiler.constants.NoRepConstant;
 import org.simantics.scl.compiler.constants.SCLConstant;
 import org.simantics.scl.compiler.constants.SCLConstructor;
 import org.simantics.scl.compiler.constants.singletons.BindingConstant;
+import org.simantics.scl.compiler.constants.singletons.ClassConstant;
 import org.simantics.scl.compiler.constants.singletons.FailFunction;
 import org.simantics.scl.compiler.constants.singletons.JustConstant;
 import org.simantics.scl.compiler.constants.singletons.NothingConstant;
@@ -209,6 +210,12 @@ public class Builtins extends ConcreteModule {
         addValue("freezeMVector", new FreezeMVector());
         addValue("setMVector", SetMVector.INSTANCE);       
         
+        StandardTypeConstructor ClassC = new StandardTypeConstructor(Types.CLASS, Kinds.STAR_TO_STAR, 
+                TypeDesc.forClass("java/lang/Class"));
+        ClassC.setType(Types.CLASS, A);
+        addTypeDescriptor("Class", ClassC);
+        addValue("classObject", ClassConstant.INSTANCE);
+        
         // *** fail ***
         
         addValue("fail", FailFunction.INSTANCE).documentation =
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java
index 00e60a636..5512f5e6e 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java
@@ -84,6 +84,7 @@ public class Types {
     public static final TCon TYPEABLE = con(BUILTIN, "Typeable");
     public static final TCon SERIALIZABLE = con(BUILTIN, "Serializable");
     public static final TCon VEC_COMP = con(BUILTIN, "VecComp");
+    public static final TCon CLASS = con(BUILTIN, "Class");
     public static final TCon BINDING = con(BUILTIN, "Binding");
 
     public static final TCon TYPE = con(BUILTIN, "Type");
diff --git a/bundles/org.simantics.scl.rest/scl/HTTP/Client.scl b/bundles/org.simantics.scl.rest/scl/HTTP/Client.scl
new file mode 100644
index 000000000..76b0b63c4
--- /dev/null
+++ b/bundles/org.simantics.scl.rest/scl/HTTP/Client.scl
@@ -0,0 +1,53 @@
+import "Map" as Map
+import "Vector"
+import "Logging" as LOGGER
+
+importJava "javax.ws.rs.client.Invocation" where
+    data Invocation
+
+    @JavaName invoke
+    invoke_ :: Invocation -> Class a -> <Proc, Exception> a
+
+invoke :: VecComp a => Invocation -> <Proc, Exception> a
+invoke invocation = invoke_ invocation classObject
+
+importJava "javax.ws.rs.client.Invocation$Builder" where
+    data Builder
+    
+    header :: Builder -> String -> String -> <Proc> Builder
+    accept :: Builder -> Vector String -> <Proc> Builder
+    cookie :: Builder -> String -> String -> <Proc> Builder
+    build :: Builder -> String -> <Proc> Invocation
+
+importJava "javax.ws.rs.client.WebTarget" where
+    data WebTarget
+
+    path :: WebTarget -> String -> <Proc> WebTarget
+    queryParam :: WebTarget -> String -> Vector String -> <Proc> WebTarget
+    request :: WebTarget -> Vector String -> <Proc> Builder
+
+importJava "javax.ws.rs.client.ClientBuilder" where
+    data ClientBuilder
+    
+    @JavaName newBuilder
+    clientBuilder :: <Proc> ClientBuilder
+    
+    @JavaName build
+    buildClient :: ClientBuilder -> Client
+
+importJava "javax.ws.rs.client.Client" where
+    data Client
+
+    target :: Client -> String -> <Proc> WebTarget
+    close :: Client -> <Proc> ()
+
+getTextHtmlExample :: String -> Map.T String a -> <Proc, Exception> String
+getTextHtmlExample uri queryParams = do
+    httpClient = buildClient clientBuilder
+    webTarget = target httpClient uri
+    req = request webTarget (vector ["text/html"])
+    invocation = build req "GET"
+    res = invoke invocation
+    close httpClient
+    res
+