feat(http): Add multiple routes for the http server example

examples/http.glu

@@ -1,4 +1,6 @@
 let prelude = import! "std/prelude.glu"
+let string = import! "std/string.glu"
+let { (==) } = string.eq
 let { Functor, Applicative, Alternative, Monad } = prelude
 let { (<<), id } = prelude.make_Category prelude.category_Function
 let { pure } = prelude.applicative_IO
@@ -7,8 +9,9 @@ let {
     Method,
     Failure,
     Request,
+    StatusCode,
     Response,
-    Handler } = import "examples/http_types.glu"
+    Handler } = import! "examples/http_types.glu"
 
 /// Force the value to be a Handler. Used to make the the type inference work for higher-kinded types
 let make: Handler a -> Handler a = id
@@ -64,43 +67,52 @@ let test predicate: (Request -> Bool) -> Handler () =
             failure DontProcess request
 
 /// Handles `Get` requests
-let get handler: Handler a -> Handler a =
+let get : Handler () =
     test (\request ->
         match request.method with
         | Get -> True
-        | _ -> False) *> handler
+        | _ -> False)
 
 /// Handles `Post` requests
-let post handler: Handler a -> Handler a =
+let post : Handler () =
     test (\request ->
         match request.method with
         | Post -> True
-        | _ -> False) *> handler
+        | _ -> False)
+
+let path uri: String -> Handler () =
+    test (\request -> request.uri == uri)
 
 /// Retrieves the HTTP request
 let get_request : Handler Request =
     \success _ request -> success request request
 
+let empty_response = { status = OK, body = "" }
+
 /// Takes a `Handler` and a `Request` tries to process the request
 let handle handler request : Handler Response -> Request -> IO Response =
     let not_found _ _ =
-        pure { body = "404" }
+        pure { status = NotFound, body = "Page not found" }
     handler (\response _ -> pure response) not_found request 
 
 {
     Method,
     Failure,
     Request,
+    StatusCode,
     Response,
     Handler,
 
     functor,
     applicative,
+    alternative,
     monad,
 
+    empty_response,
     get_request,
     handle,
     get,
     post,
+    path,
     listen = http_prim.listen
 }

examples/http.rs

@@ -12,14 +12,16 @@ use std::io::{stderr, Write};
 use std::marker::PhantomData;
 
 use self::hyper::method::Method;
+use self::hyper::status::StatusCode;
 
 use base::types::{Type, ArcType};
 
 use vm::{Result, Error as VmError};
 
 use vm::thread::ThreadInternal;
 use vm::thread::{Context, RootedThread, Thread};
-use vm::api::{VmType, Function, FunctionRef, OpaqueValue, Pushable, IO, WithVM};
+use vm::Variants;
+use vm::api::{VmType, Function, FunctionRef, Getable,OpaqueValue, Pushable, IO, ValueRef, WithVM};
 
 use vm::internal::Value;
 
@@ -42,15 +44,23 @@ impl<T: VmType + 'static> VmType for Handler<T> {
 // Since we want to marshal types defined in hyper we use `Wrap` to implement the traits we need
 struct Wrap<T>(T);
 
-impl VmType for Wrap<Method> {
-    type Type = Method;
-    fn make_type(vm: &Thread) -> ArcType {
-        (*vm.global_env().get_env().find_type_info("examples.http_types.Method").unwrap())
-            .clone()
-            .into_type()
+macro_rules! define_vmtype {
+    ($name: ident) => {
+        impl VmType for Wrap<$name> {
+            type Type = $name;
+            fn make_type(vm: &Thread) -> ArcType {
+                let typ = concat!("examples.http_types.", stringify!($name));
+                (*vm.global_env().get_env().find_type_info(typ).unwrap())
+                    .clone()
+                    .into_type()
+            }
+        }
+
     }
 }
 
+define_vmtype! { Method }
+
 impl<'vm> Pushable<'vm> for Wrap<Method> {
     fn push(self, _: &'vm Thread, context: &mut Context) -> Result<()> {
         use self::hyper::method::Method::*;
@@ -68,10 +78,36 @@ impl<'vm> Pushable<'vm> for Wrap<Method> {
     }
 }
 
-field_decl! { body, method }
+define_vmtype! { StatusCode }
+
+impl<'vm> Getable<'vm> for Wrap<StatusCode> {
+    fn from_value(_: &'vm Thread, value: Variants) -> Option<Self> {
+        use self::hyper::status::StatusCode::*;
+        match value.as_ref() {
+            ValueRef::Tag(tag) => {
+                Some(Wrap(match tag {
+                    0 => Ok,
+                    1 => NotFound,
+                    2 => InternalServerError,
+                    _ => panic!("Unexpected tag"),
+                }))
+            }
+            _ => panic!(),
+        }
+    }
+}
 
-type Request = record_type!( method => Wrap<Method> );
-type Response = record_type!( body => String );
+
+field_decl! { method, uri, status, body  }
+
+type Request = record_type!{
+    method => Wrap<Method>,
+    uri => String
+};
+type Response = record_type!{
+    status => Wrap<StatusCode>,
+    body => String
+};
 
 fn listen(port: i32, value: WithVM<OpaqueValue<RootedThread, Handler<Response>>>) -> IO<()> {
     let WithVM { value: handler, vm: thread } = value;
@@ -84,12 +120,14 @@ fn listen(port: i32, value: WithVM<OpaqueValue<RootedThread, Handler<Response>>>
     type ListenFn = fn(OpaqueValue<RootedThread, Handler<Response>>, Request) -> IO<Response>;
     let handle: Function<RootedThread, ListenFn> = thread.get_global("examples.http.handle")
         .unwrap_or_else(|err| panic!("{}", err));
-    let result = server.handle(move |request: HyperRequest, response: HyperResponse<_>| {
+    let result = server.handle(move |request: HyperRequest, mut response: HyperResponse<_>| {
         let gluon_request = record_no_decl! {
-            method => Wrap(request.method)
+            method => Wrap(request.method),
+            uri => request.uri.to_string()
         };
         match handle.clone().call(handler.clone(), gluon_request).unwrap() {
-            IO::Value(record_p!{ body }) => {
+            IO::Value(record_p!{ status, body }) => {
+                *response.status_mut() = status.0;
                 response.send(body.as_bytes()).unwrap();
             }
             IO::Exception(ref err) => {
@@ -122,10 +160,18 @@ fn main() {
 
         let { (*>) } = prelude.make_Applicative prelude.applicative_IO
 
-        let { handle, get, applicative, listen } = import! "examples/http.glu"
+        let {
+            StatusCode,
+            handle, empty_response, get, get_request, path, listen,
+            applicative, alternative, monad } = import! "examples/http.glu"
+
         let { (*>), pure } = prelude.make_Applicative applicative
+        let { (<|>) } = prelude.make_Alternative alternative
+        let { (>>=) } = prelude.make_Monad monad
 
-        let handler = get (pure { body = "Hello World" })
+        let handler =
+            (get *> path "/" *> (pure { status = OK, body = "Hello World" })) <|>
+                (get *> path "/error" *> (pure { status = InternalServerError, body = "Error" }))
 
         \port ->
             io.println ("Opened server on port " <> show port) *>

examples/http_types.glu

@@ -6,10 +6,18 @@ type Method = | Get | Post | Delete | Update
 type Failure = | DontProcess
 
 /// HTTP server request
-type Request = { method: Method }
+type Request = {
+    method : Method,
+    uri : String
+}
+
+type StatusCode = | OK | NotFound | InternalServerError
 
 /// HTTP server response
-type Response = { body: String }
+type Response = {
+    status : StatusCode,
+    body: String
+}
 
 /// The main type of this micro http framework. A handler takes two continuations and a `Request` and
 /// cakks one of the continuations depending on if it can successfully handle the request or not
@@ -25,6 +33,7 @@ type Handler a =
     Method,
     Failure,
     Request,
+    StatusCode,
     Response,
     Handler,
 }